dormouse-client 0.2.1.0 → 0.3.0.0

raw patch · 8 files changed

+60/−60 lines, 8 filesdep +streamly-coredep ~bytestringdep ~dormouse-uridep ~hedgehogPVP ok

version bump matches the API change (PVP)

Dependencies added: streamly-core

Dependency ranges changed: bytestring, dormouse-uri, hedgehog, hspec-hedgehog, http-api-data, streamly, streamly-bytestring, text, vector

API changes (from Hackage documentation)

Files

• dormouse-client.cabal +18/−18
• src/Dormouse/Client/Class.hs +2/−2
• src/Dormouse/Client/MonadIOImpl.hs +9/−11
• src/Dormouse/Client/Payload.hs +14/−14
• src/Dormouse/Client/Test/Class.hs +4/−5
• test/Dormouse/Client/Generators/Json.hs +6/−2
• test/Dormouse/Client/PayloadSpec.hs +4/−6
• test/Dormouse/ClientSpec.hs +3/−2

@@ -1,13 +1,11 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack------ hash: 0bc74a501091f246473fee31ae5056f9e5c7f721a44e98ffd0a1126dce07304d  name:           dormouse-client-version:        0.2.1.0+version:        0.3.0.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!                 .@@ -67,20 +65,21 @@       aeson >=2.0 && <3.0     , attoparsec >=0.13.2.4 && <0.15     , base >=4.7 && <5-    , bytestring >=0.10.8 && <0.11.0+    , bytestring >=0.10.8 && <0.12.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+    , dormouse-uri ==0.3.*+    , http-api-data >=0.4.1.1 && <0.6     , 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.8.0 && <0.9-    , streamly-bytestring >=0.1.2 && <0.2+    , streamly ==0.10.*+    , streamly-bytestring ==0.2.*+    , streamly-core ==0.2.*     , template-haskell >=2.15.0 && <3.0.0-    , text >=1.2.4 && <2.0.0+    , text >=2.0.0 && <3.0.0   default-language: Haskell2010  test-suite dormouse-client-test@@ -120,24 +119,25 @@       aeson >=2.0 && <3.0     , attoparsec >=0.13.2.4 && <0.15     , base >=4.7 && <5-    , bytestring >=0.10.8 && <0.11.0+    , bytestring >=0.10.8 && <0.12.0     , case-insensitive >=1.2.1.0 && <2.0.0     , containers >=0.6.2.1 && <0.7     , dormouse-uri-    , hedgehog >=1.0.1 && <2+    , hedgehog     , hspec >=2.0.0 && <3     , hspec-discover >=2.0.0 && <3-    , hspec-hedgehog >=0.0.1.2 && <0.1-    , http-api-data >=0.4.1.1 && <0.5+    , hspec-hedgehog+    , http-api-data >=0.4.1.1 && <0.6     , 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.8.0 && <0.9-    , streamly-bytestring >=0.1.2 && <0.2+    , streamly ==0.10.*+    , streamly-bytestring ==0.2.*+    , streamly-core ==0.2.*     , template-haskell >=2.15.0 && <3.0.0-    , text >=1.2.4 && <2.0.0-    , vector >=0.12.0.3 && <0.13+    , text >=2.0.0 && <3.0.0+    , vector   default-language: Haskell2010

@@ -9,7 +9,7 @@ import Dormouse.Client.Types ( HttpRequest(..), HttpResponse(..) ) import Dormouse.Url ( IsUrl ) import Network.HTTP.Client ( Manager )-import Streamly ( SerialT )+import qualified Streamly.Data.Stream as Stream  -- | The configuration options required to run Dormouse newtype DormouseClientConfig = DormouseClientConfig { clientManager :: Manager }@@ -24,4 +24,4 @@ -- | MonadDormouseClient describes the capability to send HTTP requests and receive an HTTP response class Monad m => MonadDormouseClient m where   -- | Sends a supplied HTTP request and retrieves a response within the supplied monad @m@-  send :: IsUrl url => HttpRequest url method RawRequestPayload contentTag acceptTag -> (HttpResponse (SerialT IO Word8) -> IO (HttpResponse b)) -> m (HttpResponse b)+  send :: IsUrl url => HttpRequest url method RawRequestPayload contentTag acceptTag -> (HttpResponse (Stream.Stream IO Word8) -> IO (HttpResponse b)) -> m (HttpResponse b)

@@ -26,18 +26,16 @@ import qualified Network.HTTP.Client as C import qualified Network.HTTP.Types as T import qualified Network.HTTP.Types.Status as NC-import Streamly-import qualified Streamly.Prelude as S import qualified Streamly.External.ByteString as SEB-import qualified Streamly.Internal.Data.Array.Stream.Foreign as SIMA+import qualified Streamly.Data.Stream as Stream -givesPopper :: SerialT IO Word8 -> C.GivesPopper ()+givesPopper :: Stream.Stream IO Word8 -> C.GivesPopper () givesPopper rawStream k = do-  let initialStream = SIMA.arraysOf 32768 rawStream+  let initialStream = Stream.chunksOf 32768 rawStream   streamState <- newIORef initialStream   let popper = do         stream <- readIORef streamState-        test <- S.uncons stream+        test <- Stream.uncons stream         case test of           Just (elems, stream') -> writeIORef streamState stream' $> SEB.fromArray elems           Nothing               -> return B.empty@@ -68,13 +66,13 @@     , C.queryString = encodeQuery queryText     } -responseStream :: C.Response C.BodyReader -> SerialT IO Word8+responseStream :: C.Response C.BodyReader -> Stream.Stream IO Word8 responseStream resp = -    S.repeatM (C.brRead $ C.responseBody resp)-  & S.takeWhile (not . B.null)-  & S.concatMap (S.unfold SEB.read)+    Stream.repeatM (C.brRead $ C.responseBody resp)+  & Stream.takeWhile (not . B.null)+  & Stream.concatMap (Stream.unfold SEB.reader) -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 :: (HasDormouseClientConfig env, MonadReader env m, MonadIO m, IsUrl url) => HttpRequest url method RawRequestPayload contentTag acceptTag -> (HttpResponse (Stream.Stream 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

@@ -32,10 +32,10 @@ import qualified Data.ByteString.Lazy as LB import qualified Data.Map.Strict as Map import qualified Web.FormUrlEncoded as W-import Streamly-import qualified Streamly.Prelude as S+import qualified Streamly.Data.Fold as Fold import qualified Streamly.External.ByteString as SEB import qualified Streamly.External.ByteString.Lazy as SEBL+import qualified Streamly.Data.Stream as Stream  -- | Describes an association between a type @tag@ and a specific Media Type class HasMediaType tag where@@ -44,9 +44,9 @@ -- | A raw HTTP Request payload consisting of a stream of bytes with either a defined Content Length or using Chunked Transfer Encoding data RawRequestPayload   -- | DefinedContentLength represents a payload where the size of the message is known in advance and the content length header can be computed-  = DefinedContentLength Word64 (SerialT IO Word8)+  = DefinedContentLength Word64 (Stream.Stream IO Word8)   -- | ChunkedTransfer represents a payload with indertiminate length, to be sent using chunked transfer encoding-  | ChunkedTransfer (SerialT IO Word8)+  | ChunkedTransfer (Stream.Stream IO Word8)  -- | RequestPayload relates a type of content and a payload tag used to describe that type to its byte stream representation and the constraints required to encode it class HasMediaType contentTag => RequestPayload body contentTag where@@ -56,7 +56,7 @@ -- | ResponsePayload relates a type of content and a payload tag used to describe that type  to its byte stream representation and the constraints required to decode it class HasMediaType tag => ResponsePayload body tag where   -- | Decodes the high level representation from the supplied byte stream-  deserialiseRequest :: Proxy tag -> HttpResponse (SerialT IO Word8) -> IO (HttpResponse body)+  deserialiseRequest :: Proxy tag -> HttpResponse (Stream.Stream IO Word8) -> IO (HttpResponse body)  data JsonPayload = JsonPayload @@ -67,12 +67,12 @@   serialiseRequest _ r =      let b = requestBody r         lbs = encode b-    in r { requestBody = DefinedContentLength (fromIntegral . LB.length $ lbs) (S.unfold SEBL.read lbs) }+    in r { requestBody = DefinedContentLength (fromIntegral . LB.length $ lbs) (Stream.unfold SEBL.reader lbs) }  instance (FromJSON body) => ResponsePayload body JsonPayload where   deserialiseRequest _ resp = do     let stream = responseBody resp-    bs <- S.fold SEB.write stream+    bs <- Stream.fold SEB.write stream     body <- either (throw . DecodingException . T.pack) return . eitherDecodeStrict $ bs     return $ resp { responseBody = body } @@ -89,12 +89,12 @@   serialiseRequest _ r =     let b = requestBody r         lbs = W.urlEncodeAsForm b-    in r { requestBody = DefinedContentLength (fromIntegral . LB.length $ lbs) (S.unfold SEBL.read lbs) }+    in r { requestBody = DefinedContentLength (fromIntegral . LB.length $ lbs) (Stream.unfold SEBL.reader lbs) }  instance (W.FromForm body) => ResponsePayload body UrlFormPayload where   deserialiseRequest _ resp = do     let stream = responseBody resp-    bs <- S.fold SEB.write $ stream+    bs <- Stream.fold SEB.write $ stream     body <- either (throw . DecodingException) return . W.urlDecodeAsForm $ LB.fromStrict bs     return $ resp { responseBody = body } @@ -108,25 +108,25 @@   mediaType _ = Nothing  instance RequestPayload Empty EmptyPayload where-  serialiseRequest _ r = r { requestBody = DefinedContentLength 0 S.nil }+  serialiseRequest _ r = r { requestBody = DefinedContentLength 0 Stream.nil }  instance ResponsePayload Empty EmptyPayload where   deserialiseRequest _ resp = do     let stream = responseBody resp-    body <- Empty <$ S.drain stream+    body <- Empty <$ Stream.fold Fold.drain stream     return $ resp { responseBody = body }  -- | A type tag used to indicate that a request\/response has no payload noPayload :: Proxy EmptyPayload noPayload = Proxy :: Proxy EmptyPayload -decodeTextContent :: (MonadThrow m, MonadIO m) => HttpResponse (SerialT m Word8) -> m (HttpResponse T.Text)+decodeTextContent :: (MonadThrow m, MonadIO m) => HttpResponse (Stream.Stream m Word8) -> m (HttpResponse T.Text) decodeTextContent resp = do   let contentTypeHV = getHeaderValue "Content-Type" resp   mediaType' <- traverse MTH.parseMediaType contentTypeHV   let maybeCharset = mediaType' >>= Map.lookup "charset" . MTH.parameters   let stream = responseBody resp-  bs <- S.fold SEB.write $ stream+  bs <- Stream.fold SEB.write $ stream   return $ resp { responseBody = decodeContent maybeCharset bs }     where       decodeContent maybeCharset bs' = @@ -144,7 +144,7 @@   serialiseRequest _ r =     let b = requestBody r         lbs = LB.fromStrict $ TE.encodeUtf8 b -    in r { requestBody = DefinedContentLength (fromIntegral . LB.length $ lbs) (S.unfold SEBL.read lbs) }+    in r { requestBody = DefinedContentLength (fromIntegral . LB.length $ lbs) (Stream.unfold SEBL.reader lbs) }  instance ResponsePayload T.Text HtmlPayload where   deserialiseRequest _ resp = decodeTextContent resp

@@ -26,10 +26,9 @@ import Dormouse.Client.Payload ( RawRequestPayload(..) ) import Dormouse.Client.Types ( HttpRequest(..), HttpResponse(..) ) import Dormouse.Url ( IsUrl )-import Streamly ( SerialT )-import qualified Streamly.Prelude as S import qualified Streamly.External.ByteString as SEB import qualified Streamly.External.ByteString.Lazy as SEBL+import qualified Streamly.Data.Stream as Stream  -- | MonadDormouseTestClient describes the capability to send and receive specifically ByteString typed HTTP Requests and Responses class Monad m => MonadDormouseTestClient m where@@ -47,13 +46,13 @@  instance (Monad m, MonadIO m, MonadDormouseTestClient m) => MonadDormouseClient m where   send req deserialiseResp = do-    reqBody <- liftIO . S.fold SEB.write . extricateRequestStream . requestBody $ req+    reqBody <- liftIO . Stream.fold SEB.write . extricateRequestStream . requestBody $ req     let reqBs = req {requestBody = reqBody}     respBs <- expectBs reqBs-    let respStream = S.unfold SEBL.read . LB.fromStrict $ responseBody respBs+    let respStream = Stream.unfold SEBL.reader . LB.fromStrict $ responseBody respBs     liftIO $ deserialiseResp $ respBs { responseBody = respStream }     where -      extricateRequestStream :: RawRequestPayload -> SerialT IO Word8+      extricateRequestStream :: RawRequestPayload -> Stream.Stream IO Word8       extricateRequestStream (DefinedContentLength _ s) = s       extricateRequestStream (ChunkedTransfer s) = s 

@@ -10,6 +10,7 @@ import qualified Data.Aeson.Key as AK import qualified Data.Scientific as S import qualified Data.Vector as V+import qualified Data.Char as C import Hedgehog import qualified Hedgehog.Gen as Gen @@ -23,8 +24,11 @@ genJsonNull = pure A.Null  genJsonString :: Range Int -> Gen A.Value-genJsonString sr = fmap A.String $ Gen.text sr Gen.unicode+genJsonString sr = fmap A.String $ Gen.text sr jsonChar +jsonChar :: Gen Char+jsonChar = Gen.filter (\c -> c /= '\"' && c /= '\\' && (not $ C.isControl c) && c /= '\r' && c /= '\n') Gen.unicode+ genJsonBool :: Gen A.Value genJsonBool = fmap A.Bool Gen.bool @@ -43,7 +47,7 @@ genJsonObject ranges = fmap A.object $ Gen.list ar genNameValue   where     genNameValue = do-      name <- Gen.text sr Gen.unicode+      name <- Gen.text sr jsonChar       value <- genJsonValue ranges       return (AK.fromText name, value)     sr = stringRanges ranges

@@ -9,15 +9,13 @@ import Dormouse.Client.Generators.Text import Dormouse.Client.Payload -import Streamly-import qualified Streamly.Prelude as S- import Data.Proxy  import Test.Hspec import Test.Hspec.Hedgehog import qualified Hedgehog.Range as Range import qualified Streamly.External.ByteString as SEB+import qualified Streamly.Data.Stream as Stream  spec :: Spec spec = before setup $ do@@ -29,7 +27,7 @@           resp = HttpResponse              { responseStatusCode = 200             , responseHeaders = Map.fromList [("Content-Type", "text/plain; charset=iso-8859-1")]-            , responseBody = S.unfold SEB.read txt+            , responseBody = Stream.unfold SEB.read txt             }           expectedLatin1Text = decodeLatin1 txt         resp' <- liftIO . deserialiseRequest html $ resp@@ -41,7 +39,7 @@           resp = HttpResponse              { responseStatusCode = 200             , responseHeaders = Map.fromList [("Content-Type", "text/plain; charset=utf8")]-            , responseBody = S.unfold SEB.read txt+            , responseBody = Stream.unfold SEB.read txt             }           expectedUtf8Text = decodeUtf8 txt         resp' <- liftIO . deserialiseRequest html $ resp@@ -53,7 +51,7 @@           resp = HttpResponse              { responseStatusCode = 200             , responseHeaders = Map.empty-            , responseBody = S.unfold SEB.read txt+            , responseBody = Stream.unfold SEB.read txt             }           expectedUtf8Text = decodeUtf8 txt         resp' <- liftIO . deserialiseRequest html $ resp

@@ -10,10 +10,10 @@   ) where  import Control.Concurrent.MVar-import Control.Exception.Safe (MonadThrow)+import Control.Exception.Safe (MonadThrow, catch, Exception, SomeException (SomeException)) import Control.Monad.IO.Class import Control.Monad.Reader-import Data.Aeson (encode, Value)+import Data.Aeson (encode, Value, ToJSON (toJSON)) import qualified Data.Map.Strict as Map import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB@@ -21,6 +21,7 @@ import Dormouse.Client.Test.Class import Dormouse.Url.QQ import Dormouse.Client.Generators.Json+ import Test.Hspec import Test.Hspec.Hedgehog