module RFC.HTTP.Client
( withAPISession
, HasAPIClient(..)
, HasHttpManager(..)
, BadStatusException
, apiGet
, module Network.Wreq.Session
, module Network.HTTP.Types.Status
) where
import Control.Lens
import Network.HTTP.Client (Manager, ManagerSettings,
newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types.Status hiding (statusCode, statusMessage)
import Network.URI
import Network.Wreq.Lens
import Network.Wreq.Session hiding (withAPISession)
import RFC.JSON (FromJSON, decodeOrDie)
import RFC.Prelude
import RFC.String ()
rfcManagerSettings :: ManagerSettings
rfcManagerSettings = tlsManagerSettings
createRfcManager :: (MonadIO m) => m Manager
createRfcManager = liftIO $ newManager rfcManagerSettings
withAPISession :: (MonadIO m) => (Session -> m a) -> m a
withAPISession = (>>=) $ (liftIO $ newSessionControl Nothing rfcManagerSettings)
newtype BadStatusException = BadStatusException (Status,URI)
deriving (Show,Eq,Ord,Generic,Typeable)
instance Exception BadStatusException
apiExecute :: (HasAPIClient m, MonadUnliftIO m, ConvertibleString LazyByteString s) =>
URI -> (Session -> String -> IO (Response LazyByteString)) -> (s -> m a) -> m a
apiExecute rawUrl action converter = do
session <- getAPIClient
response <- liftIO $ action session url
let status = response ^. responseStatus
case status ^. statusCode of
200 -> converter . cs $ response ^. responseBody
_ -> throwIO $ badResponseStatus status
where
url = show rawUrl
badResponseStatus status = BadStatusException (status, rawUrl)
apiGet :: (HasAPIClient m, FromJSON a, MonadUnliftIO m, Exception e) => URI -> (e -> m a) -> m a
apiGet url onError =
handle onError $ apiExecute url get decodeOrDie
class HasAPIClient m where
getAPIClient :: m Session
class HasHttpManager m where
getHttpManager :: m Manager
instance (MonadIO m) => HasHttpManager m where
getHttpManager = liftIO createRfcManager