-- |
--
-- Copyright:
--   This file is part of the package themoviedb.  It is subject to
--   the license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/themoviedb
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the terms
--   contained in the LICENSE file.
--
-- License: MIT
--
-- Simple interface for fetching JSON files from the API via HTTP.
module Network.API.TheMovieDB.Internal.HTTP
  ( apiBaseURL,
    defaultImagePrefix,
    apiGET,
  )
where

import Control.Exception
import Network.API.TheMovieDB.Internal.Settings
import Network.API.TheMovieDB.Internal.Types
import qualified Network.HTTP.Client as HC
import Network.HTTP.Types

-- | The base URL for the version of the API we're using.
apiBaseURL :: String
apiBaseURL :: String
apiBaseURL = String
"https://api.themoviedb.org/3/"

-- | The default image URL prefix.
defaultImagePrefix :: Text
defaultImagePrefix :: Text
defaultImagePrefix = Text
"http://image.tmdb.org/t/p/"

-- | Build a HTTP request that can be used to access the API.
mkAPIRequest :: Settings -> Path -> QueryText -> IO HC.Request
mkAPIRequest :: Settings -> String -> QueryText -> IO Request
mkAPIRequest Settings {Maybe Text
Text
tmdbLanguage :: Settings -> Maybe Text
tmdbKey :: Settings -> Text
tmdbLanguage :: Maybe Text
tmdbKey :: Text
..} String
path QueryText
params = do
  Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HC.parseRequest (String
apiBaseURL String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)

  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$
    Request
req
      { queryString :: ByteString
HC.queryString = ByteString
query,
        requestHeaders :: RequestHeaders
HC.requestHeaders = RequestHeaders
headers
      }
  where
    query :: ByteString
query = Bool -> Query -> ByteString
renderQuery Bool
False (Query -> ByteString)
-> (QueryText -> Query) -> QueryText -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryText -> Query
queryTextToQuery (QueryText -> ByteString) -> QueryText -> ByteString
forall a b. (a -> b) -> a -> b
$ QueryText
allParams
    headers :: RequestHeaders
headers = [(HeaderName
"Accept", ByteString
"application/json")]
    allParams :: QueryText
allParams =
      QueryText
params
        QueryText -> QueryText -> QueryText
forall a. [a] -> [a] -> [a]
++ ( (Text -> Maybe Text) -> (Text, Text) -> (Text, Maybe Text)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> Maybe Text
forall a. a -> Maybe a
Just
               ((Text, Text) -> (Text, Maybe Text)) -> [(Text, Text)] -> QueryText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes
                 [ (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
"api_key", Text
tmdbKey),
                   (Text
"language",) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
tmdbLanguage
                 ]
           )

-- | Build a URL and do an HTTP GET to TheMovieDB.
apiGET :: HC.Manager -> Settings -> Path -> QueryText -> IO (Either Error Body)
apiGET :: Manager
-> Settings -> String -> QueryText -> IO (Either Error Body)
apiGET Manager
manager Settings
settings String
path QueryText
params = do
  Request
request <- Settings -> String -> QueryText -> IO Request
mkAPIRequest Settings
settings String
path QueryText
params
  Either Error (Response Body)
response <- IO (Either Error (Response Body))
-> (HttpException -> IO (Either Error (Response Body)))
-> IO (Either Error (Response Body))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Response Body -> Either Error (Response Body)
forall a b. b -> Either a b
Right (Response Body -> Either Error (Response Body))
-> IO (Response Body) -> IO (Either Error (Response Body))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response Body)
HC.httpLbs Request
request Manager
manager) HttpException -> IO (Either Error (Response Body))
httpError

  Either Error Body -> IO (Either Error Body)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Body -> IO (Either Error Body))
-> Either Error Body -> IO (Either Error Body)
forall a b. (a -> b) -> a -> b
$ case Either Error (Response Body)
response of
    Left Error
e -> Error -> Either Error Body
forall a b. a -> Either a b
Left Error
e
    Right Response Body
r
      | Status -> Bool
statusIsSuccessful (Response Body -> Status
forall body. Response body -> Status
HC.responseStatus Response Body
r) -> Body -> Either Error Body
forall a b. b -> Either a b
Right (Response Body -> Body
forall body. Response body -> body
HC.responseBody Response Body
r)
      | Bool
otherwise -> Error -> Either Error Body
forall a b. a -> Either a b
Left (String -> Error
ServiceError (String -> Error) -> (Status -> String) -> Status -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> String
forall b a. (Show a, IsString b) => a -> b
show (Status -> Error) -> Status -> Error
forall a b. (a -> b) -> a -> b
$ Response Body -> Status
forall body. Response body -> Status
HC.responseStatus Response Body
r)
  where
    -- This should only be called for non-200 codes now.
    httpError :: HC.HttpException -> IO (Either Error (HC.Response Body))
    httpError :: HttpException -> IO (Either Error (Response Body))
httpError HttpException
_ = Either Error (Response Body) -> IO (Either Error (Response Body))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (Response Body) -> IO (Either Error (Response Body)))
-> Either Error (Response Body)
-> IO (Either Error (Response Body))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (Response Body)
forall a b. a -> Either a b
Left Error
InvalidKeyError