Command line frontend for video metadata tagging tools
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

HTTP.hs 2.7KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970
  1. {-# LANGUAGE OverloadedStrings #-}
  2. {-
  3. This file is part of the Haskell package themoviedb. It is subject to
  4. the license terms in the LICENSE file found in the top-level directory
  5. of this distribution and at git://pmade.com/themoviedb/LICENSE. No
  6. part of themoviedb package, including this file, may be copied,
  7. modified, propagated, or distributed except according to the terms
  8. contained in the LICENSE file.
  9. -}
  10. --------------------------------------------------------------------------------
  11. -- | Simple interface for fetching JSON files from the API via HTTP.
  12. module Network.API.TheMovieDB.Internal.HTTP
  13. ( apiGET
  14. ) where
  15. --------------------------------------------------------------------------------
  16. import Control.Applicative
  17. import Control.Exception
  18. import Network.API.TheMovieDB.Internal.Types
  19. import qualified Network.HTTP.Client as HC
  20. import Network.HTTP.Types
  21. --------------------------------------------------------------------------------
  22. -- The following is a kludge to avoid the "redundant import" warning
  23. -- when using GHC >= 7.10.x. This should be removed after we decide
  24. -- to stop supporting GHC < 7.10.x.
  25. import Prelude
  26. --------------------------------------------------------------------------------
  27. -- | The base URL for the version of the API we're using.
  28. apiBaseURL :: String
  29. apiBaseURL = "https://api.themoviedb.org/3/"
  30. --------------------------------------------------------------------------------
  31. -- | Build a HTTP request that can be used to access the API.
  32. mkAPIRequest :: Key -> Path -> QueryText -> IO HC.Request
  33. mkAPIRequest key path params = do
  34. req <- HC.parseRequest (apiBaseURL ++ path)
  35. return $ req { HC.queryString = query
  36. , HC.requestHeaders = headers
  37. }
  38. where
  39. query = renderQuery False . queryTextToQuery $ allParams
  40. allParams = params ++ [("api_key", Just key)]
  41. headers = [("Accept", "application/json")]
  42. --------------------------------------------------------------------------------
  43. -- | Build a URL and do an HTTP GET to TheMovieDB.
  44. apiGET :: HC.Manager -> Key -> Path -> QueryText -> IO (Either Error Body)
  45. apiGET manager key path params = do
  46. request <- mkAPIRequest key path params
  47. response <- catch (Right <$> HC.httpLbs request manager) httpError
  48. return $ case response of
  49. Left e -> Left e
  50. Right r
  51. | statusIsSuccessful (HC.responseStatus r) -> Right (HC.responseBody r)
  52. | otherwise -> Left (ServiceError . show $ HC.responseStatus r)
  53. where
  54. httpError :: HC.HttpException -> IO (Either Error (HC.Response Body))
  55. httpError e = return $ case e of
  56. HC.StatusCodeException (Status 401 _) _ _ -> Left InvalidKeyError
  57. _ -> Left (HttpExceptionError e)