{-# LANGUAGE OverloadedStrings #-} module Network.API.Mandrill.HTTP where import Control.Applicative import Data.Aeson import Data.Monoid import qualified Data.Text as T import Network.API.Mandrill.Settings import Network.API.Mandrill.Types import Network.HTTP.Client import Network.HTTP.Client.TLS import Network.HTTP.Types toMandrillResponse :: (MandrillEndpoint ep, FromJSON a, ToJSON rq) => ep -> rq -> Maybe Manager -> IO (MandrillResponse a) toMandrillResponse :: forall ep a rq. (MandrillEndpoint ep, FromJSON a, ToJSON rq) => ep -> rq -> Maybe Manager -> IO (MandrillResponse a) toMandrillResponse ep ep rq rq Maybe Manager mbMgr = do let fullUrl :: Text fullUrl = Text mandrillUrl forall a. Semigroup a => a -> a -> a <> forall ep. MandrillEndpoint ep => ep -> Text toUrl ep ep Request rq' <- forall (m :: * -> *). MonadThrow m => String -> m Request parseRequest (Text -> String T.unpack Text fullUrl) let headers :: [(HeaderName, ByteString)] headers = [(HeaderName hContentType, ByteString "application/json")] let jsonBody :: ByteString jsonBody = forall a. ToJSON a => a -> ByteString encode rq rq let req :: Request req = Request rq' { method :: ByteString method = ByteString "POST" , requestHeaders :: [(HeaderName, ByteString)] requestHeaders = [(HeaderName, ByteString)] headers , requestBody :: RequestBody requestBody = ByteString -> RequestBody RequestBodyLBS ByteString jsonBody } Manager mgr <- forall b a. b -> (a -> b) -> Maybe a -> b maybe (ManagerSettings -> IO Manager newManager ManagerSettings tlsManagerSettings) forall (m :: * -> *) a. Monad m => a -> m a return Maybe Manager mbMgr ByteString res <- forall body. Response body -> body responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Request -> Manager -> IO (Response ByteString) httpLbs Request req Manager mgr case forall a. FromJSON a => ByteString -> Either String a eitherDecode ByteString res of Left String e -> forall (m :: * -> *) a. MonadFail m => String -> m a fail String e Right MandrillResponse a v -> forall (m :: * -> *) a. Monad m => a -> m a return MandrillResponse a v