api-maker 0.1.0.0 → 0.1.0.6

raw patch · 5 files changed

+94/−18 lines, 5 filesdep +easy-loggerdep +http-api-dataPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: easy-logger, http-api-data

API changes (from Hackage documentation)

Files

• api-maker.cabal +9/−5
• src/ApiMaker.hs +1/−0
• src/Network/HTTP/ApiMaker/Class.hs +43/−5
• src/Network/HTTP/ApiMaker/Logging.hs +15/−0
• src/Network/HTTP/ApiMaker/Ops.hs +26/−8

@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 6a6fa3f0f379eade6020b6c856c601ee0501ed76dedb9ef47f70a2a62406e38c  name:           api-maker-version:        0.1.0.0+version:        0.1.0.6 synopsis:       Package to make APIs description:    Please see the README on GitHub at <https://github.com/schnecki/api-maker#readme> category:       Web@@ -32,6 +30,7 @@       ApiMaker       Network.HTTP.ApiMaker.Class       Network.HTTP.ApiMaker.HeaderContent+      Network.HTTP.ApiMaker.Logging       Network.HTTP.ApiMaker.Ops       Network.HTTP.ApiMaker.SessionState   other-modules:@@ -44,6 +43,8 @@     , base >=4.7 && <5     , bytestring     , containers+    , easy-logger >=0.1.0.6+    , http-api-data     , http-client     , http-client-tls     , http-types@@ -58,7 +59,8 @@     ghc-options: -fno-warn-incomplete-patterns     cpp-options: -DType=*   if impl(ghc >= 8.6)-    default-extensions: NoStarIsType+    default-extensions:+        NoStarIsType   default-language: Haskell2010  test-suite api-maker-test@@ -75,6 +77,8 @@     , base >=4.7 && <5     , bytestring     , containers+    , easy-logger >=0.1.0.6+    , http-api-data     , http-client     , http-client-tls     , http-types

@@ -3,6 +3,7 @@     ) where  import           Network.HTTP.ApiMaker.Class         as R+import           Network.HTTP.ApiMaker.Logging       as R import           Network.HTTP.ApiMaker.Ops           as R  import           Network.HTTP.ApiMaker.HeaderContent as R

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                        #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE ExistentialQuantification  #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -22,14 +23,19 @@   , SafeReqSt   , SafeReq   , SafeReqM (..)+  , SafeException (..)+  , throwUserException   ) where +import           Control.Exception import           Control.Monad.Base import           Control.Monad.Except import           Control.Monad.Trans.Reader import           Control.Monad.Trans.State+import           Data.Dynamic import           Data.Kind                          (Type) import           Data.Proxy+import qualified Network.HTTP.Client                as C import           Network.HTTP.Req  import           Network.HTTP.ApiMaker.SessionState@@ -50,8 +56,10 @@   url      :: cfg -> r -> Url 'Https -- (Protocol r)   body     :: cfg -> r -> Body r   response :: cfg -> r -> Proxy (Response r)-  option   :: cfg -> r -> Option 'Https -- (Protocol r)-  process  :: (MonadHttp m, SessionState st) => cfg -> r -> Response r -> StateT st m (Output r)+  option   :: cfg -> r -> IO (Option 'Https) -- (Protocol r)+  requestModifier :: cfg -> r -> C.Request -> IO C.Request+  requestModifier _ _ = return+  process  :: (MonadHttp m, MonadError SafeException m, SessionState st) => cfg -> r -> Response r -> StateT st m (Output r)   -- Type safe request@@ -63,12 +71,27 @@   , apiConfig            :: cfg   } +-- | Safe request monad with customized session state `sessionState`, Config `cfg` and result `a`. type SafeReqSt sessionState cfg a = StateT sessionState (SafeReqM cfg) a++-- | Safe request monad with predetermined @Session@, config `cfg` and result `a`. type SafeReq cfg a = SafeReqSt Session cfg a ++data SafeException+  = ReqException HttpException+  | forall e. (Typeable e, Exception e) =>+              SafeUserException e++instance Exception SafeException+instance Show SafeException where+  show (ReqException e)      = show e+  show (SafeUserException e) = show e++ -- | Safe request, e.g. all errors are caught and tured into exceptions. newtype SafeReqM cfg a =-  SafeReqM (ExceptT HttpException (ReaderT (Config cfg) IO) a)+  SafeReqM (ExceptT SafeException (ReaderT (Config cfg) IO) a)   deriving (Functor, Applicative, Monad, MonadIO)  askConfig :: SafeReqM cfg (Config cfg)@@ -81,15 +104,30 @@   liftBase = liftIO  instance MonadHttp (SafeReqM cfg) where-  handleHttpException = SafeReqM . throwError+  handleHttpException = SafeReqM . throwError . ReqException   getHttpConfig = httpConfig <$> SafeReqM (lift ask) +instance MonadError SafeException (SafeReqM cfg) where+  throwError = SafeReqM . throwError . SafeUserException+  catchError c h = do+    cfg <- askConfig+    res <- runSafeReqM cfg c+    case res of+      Left ex -> h ex+      Right{} -> SafeReqM $ ExceptT $ return res+++-- | Throw an Exception to the `SafeReqM` Monad.+throwUserException :: (MonadError SafeException m, Exception e) => e -> m a+throwUserException = throwError . SafeUserException++ -- | Safely run the request monad. runSafeReqM ::      MonadIO m   => Config cfg                 -- ^ Config including 'HttpConfig' to use   -> SafeReqM cfg a             -- ^ Computation to run-  -> m (Either HttpException a)+  -> m (Either SafeException a) runSafeReqM config (SafeReqM m) = liftIO (runReaderT (runExceptT m) config)  

@@ -0,0 +1,15 @@+{-# LANGUAGE TemplateHaskell #-}+module Network.HTTP.ApiMaker.Logging+    ( enableRequestLogging+    , disableRequestLogging+    ) where++import           EasyLogger++enableRequestLogging :: LogDestination -> IO ()+enableRequestLogging = $(initLogger)++disableRequestLogging :: IO ()+disableRequestLogging = $(finalizeLogger)++

@@ -1,7 +1,9 @@ {-# LANGUAGE DataKinds         #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures    #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-} module Network.HTTP.ApiMaker.Ops   ( mkReq   , runRequests@@ -10,6 +12,7 @@   , runReqWithParamsM   , runSessReqM   , runSessReqWithParamsM+  , maybeQueryParam   ) where  import           Control.Lens@@ -17,26 +20,29 @@ import           Control.Monad.Trans.State import qualified Data.ByteString.Char8       as B import           Data.List                   (find)+import qualified Data.Text                   as T+import           EasyLogger import qualified Network.HTTP.Client         as C import           Network.HTTP.Req+import           Web.HttpApiData  import           Network.HTTP.ApiMaker.Class   -- | Prepare to run requests.-runReqM :: (MonadIO m) => SafeReqM () a -> m (Either HttpException a)+runReqM :: (MonadIO m) => SafeReqM () a -> m (Either SafeException a) runReqM = runSafeReqM (Config defaultHttpConfig [] ())  -- | Prepare to run requests with addional header options.-runReqWithParamsM :: (MonadIO m) => [Option 'Https] -> SafeReqM () a -> m (Either HttpException a)+runReqWithParamsM :: (MonadIO m) => [Option 'Https] -> SafeReqM () a -> m (Either SafeException a) runReqWithParamsM params = runSafeReqM (Config defaultHttpConfig params ())  -- | Prepare to run request with config.-runSessReqM :: (MonadIO m) => cfg -> SafeReqM cfg a -> m (Either HttpException a)+runSessReqM :: (MonadIO m) => cfg -> SafeReqM cfg a -> m (Either SafeException a) runSessReqM cfg = runSafeReqM (Config defaultHttpConfig [] cfg)  -- | Prepare to run request with config and additional header options.-runSessReqWithParamsM :: (MonadIO m) => [Option 'Https] -> cfg -> SafeReqM cfg a -> m (Either HttpException a)+runSessReqWithParamsM :: (MonadIO m) => [Option 'Https] -> cfg -> SafeReqM cfg a -> m (Either SafeException a) runSessReqWithParamsM params cfg = runSafeReqM (Config defaultHttpConfig params cfg)  @@ -57,16 +63,20 @@   session <- get   cfg <- lift askConfig   apiCfg <- lift askApiConfig--  let ops = option apiCfg r <> mkSessionOps session <> mconcat (apiDefaultParameters cfg)-  -- liftIO $ putStrLn $ "Running a request to " <> show (url r)-  resp <- lift $ req (method apiCfg r) (url apiCfg r) (body apiCfg r) (response apiCfg r) ops+  opsReq <- liftIO $ option apiCfg r+  let ops = opsReq <> mkSessionOps session <> mconcat (apiDefaultParameters cfg)+  let logging request' = do+        request <- liftIO $ requestModifier apiCfg r request'+        liftIO $ $(logInfo) $ "API Request: " <> T.pack (show request)+        return request+  resp <- lift $ reqCb (method apiCfg r) (url apiCfg r) (body apiCfg r) (response apiCfg r) ops logging   updateSession r resp   process apiCfg r resp   where     mkSessionOps session =       maybe mempty cookieJar (session ^. cookieJarData) <> header "Cookie" (B.intercalate ";" (mkSessionCookie session ++ mkCsrfCookie session)) <> mkCsrfHeader session + updateSession :: (Request cfg request, SessionState st) => request -> Response request -> SafeReqSt st cfg () updateSession _ resp =   let cookies = C.destroyCookieJar $ responseCookieJar resp@@ -92,3 +102,11 @@   case st ^. csrfToken of     Nothing   -> mempty     Just csrf -> header "X-XSRF-TOKEN" csrf+++-- | Create a request parameter only if the value is @Just@. For @Nothing@ the parameter is not present at all in the request.+maybeQueryParam :: (Monoid param, QueryParam param, ToHttpApiData a) => T.Text -> Maybe a -> param+maybeQueryParam _ Nothing  = mempty+maybeQueryParam n (Just x) = n =: x++