{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Mollie.API.Internal where
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as ByteString hiding (pack)
import qualified Data.ByteString.Char8 as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import Data.Monoid
import qualified Data.Text as Text
import Data.Typeable (Typeable)
import Mollie.API.Types
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as HTTP
import Network.HTTP.Media ((//))
import qualified Network.HTTP.Types as HTTP
import Network.HTTP.Types.Header
import Servant.API
import Servant.API.ContentTypes (eitherDecodeLenient)
import Servant.Client
data HalJSON deriving Typeable
instance Accept HalJSON where
contentType _ = "application" // "hal+json"
instance Aeson.ToJSON a => MimeRender HalJSON a where
mimeRender _ = Aeson.encode
instance Aeson.FromJSON a => MimeUnrender HalJSON a where
mimeUnrender _ = eitherDecodeLenient
instance ToHttpApiData PaymentMethod where
toUrlPiece a = toText a
handleError :: ServantError -> ResponseError
handleError failure =
case failure of
FailureResponse response ->
servantResponseToError (HTTP.statusCode $ responseStatusCode response) (responseBody response)
DecodeFailure expectedType response ->
UnexpectedResponse expectedType
UnsupportedContentType mediaType response ->
UnexpectedResponse (Text.pack $ "Unsupported media type " ++ show mediaType)
InvalidContentTypeHeader response ->
UnexpectedResponse (Text.pack "Invalid content type header")
ConnectionError explanation ->
UnexpectedResponse explanation
servantResponseToError :: Int
-> LazyByteString.ByteString
-> ResponseError
servantResponseToError _status _body
| elem _status [400, 401, 403, 404, 405, 415, 422, 429] =
case Aeson.eitherDecode _body of
Right err -> ClientError _status err
Left decodeFailure -> UnexpectedResponse (Text.pack decodeFailure)
| elem _status [500, 502, 503, 504] =
ServerError _status
| otherwise = UnexpectedResponse (Text.pack "Unhandled status code")
createEnv :: String
-> IO ClientEnv
createEnv mollieApiKey = do
let _settings = HTTP.tlsManagerSettings { HTTP.managerModifyRequest = applyMollieHeaders mollieApiKey }
_manager <- HTTP.newManager _settings
_baseUrl <- parseBaseUrl "https://api.mollie.com"
return $ mkClientEnv _manager _baseUrl
applyMollieHeaders :: String -> HTTP.Request -> IO HTTP.Request
applyMollieHeaders key req = return $ setHeader HTTP.hAuthorization (ByteString.pack $ "Bearer " ++ key) req
setHeaders :: RequestHeaders -> HTTP.Request -> HTTP.Request
setHeaders hs req = req { HTTP.requestHeaders = hs }
setHeader :: HeaderName -> ByteString.ByteString -> HTTP.Request -> HTTP.Request
setHeader n v req =
setHeaders (filter ((/= n) . fst) (HTTP.requestHeaders req) ++ [(n, v)]) req
addHeaders :: RequestHeaders -> HTTP.Request -> HTTP.Request
addHeaders hs req = setHeaders (HTTP.requestHeaders req ++ hs) req
addHeader :: HeaderName -> ByteString.ByteString -> HTTP.Request -> HTTP.Request
addHeader n v = addHeaders [(n, v)]