dormouse-client 0.2.0.0 → 0.2.1.0

raw patch · 6 files changed

+62/−35 lines, 6 filesdep ~aesondep ~attoparsecdep ~http-clientPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, attoparsec, http-client, streamly

API changes (from Hackage documentation)

Files

• README.md +2/−2
• dormouse-client.cabal +21/−13
• src/Dormouse/Client.hs +32/−8
• src/Dormouse/Client/MonadIOImpl.hs +3/−9
• test/Dormouse/Client/Generators/Json.hs +3/−2
• test/Dormouse/ClientSpec.hs +1/−1

@@ -71,7 +71,7 @@ It is often useful to tell Dormouse about the expected `Content-Type` of the response in advance so that the correct `Accept` headers can be sent:  ```haskell-postmanEchoGetReq' :: HttpRequest (Url "http") "GET" Empty EmptyPayload acceptTag+postmanEchoGetReq' :: HttpRequest (Url "http") "GET" Empty EmptyPayload JsonPayload postmanEchoGetReq' = accept json $ get postmanEchoGetUrl ``` @@ -110,7 +110,7 @@ Once the request has been built, you can send it and expect a response of a particular type in any `MonadDormouseClient m`.  ```haskell-sendPostmanEchoGetReq :: MonadDormouseClient m => m PostmanEchoResponse+sendPostmanEchoGetReq :: (MonadDormouseClient m, MonadThrow m) => m PostmanEchoResponse sendPostmanEchoGetReq = do   (resp :: HttpResponse PostmanEchoResponse) <- expect postmanEchoGetReq'   return $ responseBody resp

@@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 196468c6e841b939083b6f97fca2642a4a3be8d5b8e7cf475711a583af3f470a+-- hash: 0bc74a501091f246473fee31ae5056f9e5c7f721a44e98ffd0a1126dce07304d  name:           dormouse-client-version:        0.2.0.0+version:        0.2.1.0 synopsis:       Simple, type-safe and testable HTTP client description:    An HTTP client designed to be productive, easy to use, easy to test, flexible and safe!                 .@@ -57,23 +57,27 @@       Paths_dormouse_client   hs-source-dirs:       src-  default-extensions: OverloadedStrings MultiParamTypeClasses ScopedTypeVariables FlexibleContexts+  default-extensions:+      OverloadedStrings+      MultiParamTypeClasses+      ScopedTypeVariables+      FlexibleContexts   ghc-options: -Wall   build-depends:-      aeson >=1.4.2 && <2.0.0-    , attoparsec >=0.13.2.4 && <0.14+      aeson >=2.0 && <3.0+    , attoparsec >=0.13.2.4 && <0.15     , base >=4.7 && <5     , bytestring >=0.10.8 && <0.11.0     , case-insensitive >=1.2.1.0 && <2.0.0     , containers >=0.6.2.1 && <0.7     , dormouse-uri     , http-api-data >=0.4.1.1 && <0.5-    , http-client >=0.6.4.1 && <0.7.0+    , http-client >=0.6.4.1 && <0.8.0     , http-client-tls >=0.3.5.3 && <0.4     , http-types >=0.12.3 && <0.13     , mtl >=2.2.2 && <3     , safe-exceptions >=0.1.7 && <0.2.0-    , streamly >=0.7.2 && <0.8+    , streamly >=0.8.0 && <0.9     , streamly-bytestring >=0.1.2 && <0.2     , template-haskell >=2.15.0 && <3.0.0     , text >=1.2.4 && <2.0.0@@ -106,11 +110,15 @@   hs-source-dirs:       src       test-  default-extensions: OverloadedStrings MultiParamTypeClasses ScopedTypeVariables FlexibleContexts+  default-extensions:+      OverloadedStrings+      MultiParamTypeClasses+      ScopedTypeVariables+      FlexibleContexts   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fdicts-strict   build-depends:-      aeson >=1.4.2 && <2.0.0-    , attoparsec >=0.13.2.4 && <0.14+      aeson >=2.0 && <3.0+    , attoparsec >=0.13.2.4 && <0.15     , base >=4.7 && <5     , bytestring >=0.10.8 && <0.11.0     , case-insensitive >=1.2.1.0 && <2.0.0@@ -121,13 +129,13 @@     , hspec-discover >=2.0.0 && <3     , hspec-hedgehog >=0.0.1.2 && <0.1     , http-api-data >=0.4.1.1 && <0.5-    , http-client >=0.6.4.1 && <0.7.0+    , http-client >=0.6.4.1 && <0.8.0     , http-client-tls >=0.3.5.3 && <0.4     , http-types >=0.12.3 && <0.13     , mtl >=2.2.2 && <3     , safe-exceptions >=0.1.7 && <0.2.0     , scientific >=0.3.6.2 && <0.4-    , streamly >=0.7.2 && <0.8+    , streamly >=0.8.0 && <0.9     , streamly-bytestring >=0.1.2 && <0.2     , template-haskell >=2.15.0 && <3.0.0     , text >=1.2.4 && <2.0.0

@@ -20,6 +20,8 @@   , accept   , expectAs   , expect+  , fetchAs+  , fetch   -- * Dormouse Client Monad and Transformer   , DormouseClientT   , DormouseClient@@ -74,7 +76,7 @@   , parseHttpsUrl   ) where -import Control.Exception.Safe (MonadThrow)+import Control.Exception.Safe (MonadThrow, throw) import Control.Monad.IO.Class import Control.Monad.Reader import qualified Data.Map.Strict as Map@@ -87,6 +89,7 @@ import Dormouse.Client.Headers.MediaType import Dormouse.Client.Payload import Dormouse.Client.Methods+import Dormouse.Client.Status import Dormouse.Client.Types import Dormouse.Uri import Dormouse.Url@@ -144,21 +147,42 @@ accept :: HasMediaType acceptTag => Proxy acceptTag -> HttpRequest url method b contentTag acceptTag -> HttpRequest url method b contentTag acceptTag accept prox r = maybe r (\v -> supplyHeader ("Accept", v) r) . fmap encodeMediaType $ mediaType prox --- | Make the supplied HTTP request, expecting an HTTP response with body type `b' to be delivered in some 'MonadDormouseClient m'-expect :: (MonadDormouseClient m, RequestPayload b contentTag, ResponsePayload b' acceptTag, IsUrl url) => HttpRequest url method b contentTag acceptTag -> m (HttpResponse b')+-- | Make the supplied HTTP request, expecting a Successful (2xx) HTTP response with body type `b' to be delivered in some 'MonadDormouseClient m'+expect :: (MonadDormouseClient m, MonadThrow m, RequestPayload b contentTag, ResponsePayload b' acceptTag, IsUrl url) +       => HttpRequest url method b contentTag acceptTag -> m (HttpResponse b') expect r = expectAs (proxyOfReq r) r   where      proxyOfReq :: HttpRequest url method b contentTag acceptTag -> Proxy acceptTag     proxyOfReq _ = Proxy --- | Make the supplied HTTP request, expecting an HTTP response in the supplied format with body type `b' to be delivered in some 'MonadDormouseClient m'-expectAs :: (MonadDormouseClient m, RequestPayload b contentTag, ResponsePayload b' acceptTag, IsUrl url) => Proxy acceptTag -> HttpRequest url method b contentTag acceptTag -> m (HttpResponse b')-expectAs tag r = do+-- | Make the supplied HTTP request, expecting a Successful (2xx) HTTP response in the supplied format with body type `b' to be delivered in some 'MonadDormouseClient m'+expectAs :: (MonadDormouseClient m, MonadThrow m, RequestPayload b contentTag, ResponsePayload b' acceptTag, IsUrl url) +         => Proxy acceptTag -> HttpRequest url method b contentTag acceptTag -> m (HttpResponse b')+expectAs tag r = fetchAs tag r rejectNon2xx++-- | Make the supplied HTTP request and transform the response into a result in some 'MonadDormouseClient m'+fetch :: (MonadDormouseClient m, RequestPayload b contentTag, ResponsePayload b' acceptTag, IsUrl url) +        => HttpRequest url method b contentTag acceptTag -> (HttpResponse b' -> m b'') -> m b''+fetch r = fetchAs (proxyOfReq r) r+  where  +    proxyOfReq :: HttpRequest url method b contentTag acceptTag -> Proxy acceptTag+    proxyOfReq _ = Proxy++-- | Make the supplied HTTP request and transform the response in the supplied format into a result in some 'MonadDormouseClient m'+fetchAs :: (MonadDormouseClient m, RequestPayload b contentTag, ResponsePayload b' acceptTag, IsUrl url) +        => Proxy acceptTag -> HttpRequest url method b contentTag acceptTag -> (HttpResponse b' -> m b'') -> m b''+fetchAs tag r f = do   let r' = serialiseRequest (contentTypeProx r) r-  send r' $ deserialiseRequest tag-  where +  resp <- send r' $ deserialiseRequest tag+  f resp+  where       contentTypeProx :: HttpRequest url method b contentTag acceptTag -> Proxy contentTag     contentTypeProx _ = Proxy++rejectNon2xx :: MonadThrow m => HttpResponse body -> m (HttpResponse body)+rejectNon2xx r = case responseStatusCode r of+  Successful -> pure r+  _          -> throw $ UnexpectedStatusCodeException (responseStatusCode r)  -- | The DormouseClientT Monad Transformer newtype DormouseClientT m a = DormouseClientT 

@@ -6,7 +6,6 @@   , genClientRequestFromUrlComponents   ) where -import Control.Exception.Safe (MonadThrow, throw) import Control.Monad.IO.Class import Control.Monad.Reader import Data.Function ((&))@@ -18,10 +17,8 @@ import Data.Word (Word8) import Data.ByteString as B import Dormouse.Client.Class-import Dormouse.Client.Exception (UnexpectedStatusCodeException(..)) import Dormouse.Client.Methods import Dormouse.Client.Payload-import Dormouse.Client.Status import Dormouse.Client.Types import Dormouse.Uri import Dormouse.Uri.Encode@@ -32,7 +29,7 @@ import Streamly import qualified Streamly.Prelude as S import qualified Streamly.External.ByteString as SEB-import qualified Streamly.Internal.Memory.ArrayStream as SIMA+import qualified Streamly.Internal.Data.Array.Stream.Foreign as SIMA  givesPopper :: SerialT IO Word8 -> C.GivesPopper () givesPopper rawStream k = do@@ -77,12 +74,12 @@   & S.takeWhile (not . B.null)   & S.concatMap (S.unfold SEB.read) -sendHttp :: (HasDormouseClientConfig env, MonadReader env m, MonadIO m, MonadThrow m, IsUrl url) => HttpRequest url method RawRequestPayload contentTag acceptTag -> (HttpResponse (SerialT IO Word8) -> IO (HttpResponse b)) -> m (HttpResponse b)+sendHttp :: (HasDormouseClientConfig env, MonadReader env m, MonadIO m, IsUrl url) => HttpRequest url method RawRequestPayload contentTag acceptTag -> (HttpResponse (SerialT IO Word8) -> IO (HttpResponse b)) -> m (HttpResponse b) sendHttp HttpRequest { requestMethod = method, requestUrl = url, requestBody = reqBody, requestHeaders = reqHeaders} deserialiseResp = do   manager <- clientManager <$> reader getDormouseClientConfig   let initialRequest = genClientRequestFromUrlComponents $ asAnyUrl url   let request = initialRequest { C.method = methodAsByteString method, C.requestBody = translateRequestBody reqBody, C.requestHeaders = Map.toList reqHeaders }-  response <- liftIO $ C.withResponse request manager (\resp -> do+  liftIO $ C.withResponse request manager (\resp -> do       let respHeaders = Map.fromList $ C.responseHeaders resp       let statusCode = NC.statusCode . C.responseStatus $ resp       deserialiseResp $ HttpResponse @@ -91,6 +88,3 @@         , responseBody = responseStream resp         }       ) -  case responseStatusCode response of-    Successful -> return response-    _          -> throw $ UnexpectedStatusCodeException (responseStatusCode response)

@@ -7,6 +7,7 @@   where  import qualified Data.Aeson as A+import qualified Data.Aeson.Key as AK import qualified Data.Scientific as S import qualified Data.Vector as V import Hedgehog@@ -39,12 +40,12 @@     ar = arrayLenRanges ranges  genJsonObject :: JsonGenRanges -> Gen A.Value-genJsonObject ranges =  fmap A.object $ Gen.list ar genNameValue+genJsonObject ranges = fmap A.object $ Gen.list ar genNameValue   where     genNameValue = do       name <- Gen.text sr Gen.unicode       value <- genJsonValue ranges-      return (name, value)+      return (AK.fromText name, value)     sr = stringRanges ranges     ar = arrayLenRanges ranges 

@@ -40,7 +40,7 @@ runTestM deps app = flip runReaderT deps $ unTestM app  instance MonadDormouseTestClient TestM where-  expectLbs (req @ HttpRequest { requestUrl = u, requestMethod = method, requestBody = body, requestHeaders = headers }) = do+  expectLbs req@HttpRequest { requestUrl = u, requestMethod = method, requestBody = body, requestHeaders = headers } = do     let reqUrl = asAnyUrl u     case (reqUrl, method) of       ([url|https://starfleet.com/captains|], GET) -> do