packages feed

polysemy-http 0.7.0.0 → 0.8.0.0

raw patch · 21 files changed

+215/−145 lines, 21 filesdep +prelatedep −ansi-terminaldep −data-defaultdep −incipitdep ~basedep ~polysemydep ~polysemy-pluginPVP ok

version bump matches the API change (PVP)

Dependencies added: prelate

Dependencies removed: ansi-terminal, data-default, incipit, lens, polysemy-log, template-haskell

Dependency ranges changed: base, polysemy, polysemy-plugin, polysemy-time

API changes (from Hackage documentation)

- Polysemy.Http: [name] :: Header -> HeaderName
- Polysemy.Http: [unBody] :: Body -> LByteString
- Polysemy.Http: [unHeaderName] :: HeaderName -> Text
- Polysemy.Http: [unHeaderValue] :: HeaderValue -> Text
- Polysemy.Http: [unHost] :: Host -> Text
- Polysemy.Http: [unPath] :: Path -> Text
- Polysemy.Http: [unPort] :: Port -> Int
- Polysemy.Http: [unQueryKey] :: QueryKey -> Text
- Polysemy.Http: [unQueryValue] :: QueryValue -> Text
- Polysemy.Http: [unTls] :: Tls -> Bool
- Polysemy.Http: [value] :: Header -> HeaderValue
- Polysemy.Http: stream :: forall c r a. Member (Http c) r => Request -> (Response c -> Sem r a) -> Sem r (Either HttpError a)
- Polysemy.Http.Data.Header: [name] :: Header -> HeaderName
- Polysemy.Http.Data.Header: [unHeaderName] :: HeaderName -> Text
- Polysemy.Http.Data.Header: [unHeaderValue] :: HeaderValue -> Text
- Polysemy.Http.Data.Header: [value] :: Header -> HeaderValue
- Polysemy.Http.Data.Request: [_body] :: Request -> Body
- Polysemy.Http.Data.Request: [_cookies] :: Request -> CookieJar
- Polysemy.Http.Data.Request: [_headers] :: Request -> [(HeaderName, HeaderValue)]
- Polysemy.Http.Data.Request: [_host] :: Request -> Host
- Polysemy.Http.Data.Request: [_method] :: Request -> Method
- Polysemy.Http.Data.Request: [_path] :: Request -> Path
- Polysemy.Http.Data.Request: [_port] :: Request -> Maybe Port
- Polysemy.Http.Data.Request: [_query] :: Request -> [(QueryKey, Maybe QueryValue)]
- Polysemy.Http.Data.Request: [_tls] :: Request -> Tls
- Polysemy.Http.Data.Request: [unBody] :: Body -> LByteString
- Polysemy.Http.Data.Request: [unHost] :: Host -> Text
- Polysemy.Http.Data.Request: [unPath] :: Path -> Text
- Polysemy.Http.Data.Request: [unPort] :: Port -> Int
- Polysemy.Http.Data.Request: [unQueryKey] :: QueryKey -> Text
- Polysemy.Http.Data.Request: [unQueryValue] :: QueryValue -> Text
- Polysemy.Http.Data.Request: [unTls] :: Tls -> Bool
- Polysemy.Http.Data.Request: instance Polysemy.Http.Data.Request.HasRequest Polysemy.Http.Data.Request.Request
- Polysemy.Http.Data.Response: [_body] :: Response b -> b
- Polysemy.Http.Data.Response: [_cookies] :: Response b -> CookieJar
- Polysemy.Http.Data.Response: [_headers] :: Response b -> [Header]
- Polysemy.Http.Data.Response: [_status] :: Response b -> Status
- Polysemy.Http.Effect.Entity: [Decode] :: LByteString -> EntityDecode d m (Either EntityError d)
- Polysemy.Http.Effect.Entity: [Encode] :: d -> EntityEncode d m LByteString
- Polysemy.Http.Effect.Entity: [body] :: EntityError -> Text
- Polysemy.Http.Effect.Entity: [message] :: EntityError -> Text
- Polysemy.Http.Effect.Http: [Stream] :: Request -> (Response c -> m a) -> Http c m (Either HttpError a)
- Polysemy.Http.Effect.Http: stream :: forall c r a. Member (Http c) r => Request -> (Response c -> Sem r a) -> Sem r (Either HttpError a)
+ Polysemy.Http: [$sel:name:Header] :: Header -> HeaderName
+ Polysemy.Http: [$sel:unBody:Body] :: Body -> ByteString
+ Polysemy.Http: [$sel:unHeaderName:HeaderName] :: HeaderName -> Text
+ Polysemy.Http: [$sel:unHeaderValue:HeaderValue] :: HeaderValue -> Text
+ Polysemy.Http: [$sel:unHost:Host] :: Host -> Text
+ Polysemy.Http: [$sel:unPath:Path] :: Path -> Text
+ Polysemy.Http: [$sel:unPort:Port] :: Port -> Int
+ Polysemy.Http: [$sel:unQueryKey:QueryKey] :: QueryKey -> Text
+ Polysemy.Http: [$sel:unQueryValue:QueryValue] :: QueryValue -> Text
+ Polysemy.Http: [$sel:unTls:Tls] :: Tls -> Bool
+ Polysemy.Http: [$sel:value:Header] :: Header -> HeaderValue
+ Polysemy.Http: decodeLazy :: forall d r. Member (EntityDecode d) r => LByteString -> Sem r (Either EntityError d)
+ Polysemy.Http: interpretEntityDecodeAesonWith :: FromJSON j => (j -> Sem r (Either Text d)) -> Sem (EntityDecode d : r) a -> Sem r a
+ Polysemy.Http.Data.Header: [$sel:name:Header] :: Header -> HeaderName
+ Polysemy.Http.Data.Header: [$sel:unHeaderName:HeaderName] :: HeaderName -> Text
+ Polysemy.Http.Data.Header: [$sel:unHeaderValue:HeaderValue] :: HeaderValue -> Text
+ Polysemy.Http.Data.Header: [$sel:value:Header] :: Header -> HeaderValue
+ Polysemy.Http.Data.Request: [$sel:body:Request] :: Request -> Body
+ Polysemy.Http.Data.Request: [$sel:cookies:Request] :: Request -> CookieJar
+ Polysemy.Http.Data.Request: [$sel:headers:Request] :: Request -> [(HeaderName, HeaderValue)]
+ Polysemy.Http.Data.Request: [$sel:host:Request] :: Request -> Host
+ Polysemy.Http.Data.Request: [$sel:method:Request] :: Request -> Method
+ Polysemy.Http.Data.Request: [$sel:path:Request] :: Request -> Path
+ Polysemy.Http.Data.Request: [$sel:port:Request] :: Request -> Maybe Port
+ Polysemy.Http.Data.Request: [$sel:query:Request] :: Request -> [(QueryKey, Maybe QueryValue)]
+ Polysemy.Http.Data.Request: [$sel:tls:Request] :: Request -> Tls
+ Polysemy.Http.Data.Request: [$sel:unBody:Body] :: Body -> ByteString
+ Polysemy.Http.Data.Request: [$sel:unHost:Host] :: Host -> Text
+ Polysemy.Http.Data.Request: [$sel:unPath:Path] :: Path -> Text
+ Polysemy.Http.Data.Request: [$sel:unPort:Port] :: Port -> Int
+ Polysemy.Http.Data.Request: [$sel:unQueryKey:QueryKey] :: QueryKey -> Text
+ Polysemy.Http.Data.Request: [$sel:unQueryValue:QueryValue] :: QueryValue -> Text
+ Polysemy.Http.Data.Request: [$sel:unTls:Tls] :: Tls -> Bool
+ Polysemy.Http.Data.Response: [$sel:body:Response] :: Response b -> b
+ Polysemy.Http.Data.Response: [$sel:cookies:Response] :: Response b -> CookieJar
+ Polysemy.Http.Data.Response: [$sel:headers:Response] :: Response b -> [Header]
+ Polysemy.Http.Data.Response: [$sel:status:Response] :: Response b -> Status
+ Polysemy.Http.Data.Response: instance GHC.Generics.Generic (Polysemy.Http.Data.Response.Response b)
+ Polysemy.Http.Effect.Entity: [$sel:body:EntityError] :: EntityError -> Text
+ Polysemy.Http.Effect.Entity: [$sel:message:EntityError] :: EntityError -> Text
+ Polysemy.Http.Effect.Entity: [DecodeLazy] :: LByteString -> EntityDecode d m (Either EntityError d)
+ Polysemy.Http.Effect.Entity: [EncodeLazy] :: d -> EntityEncode d m LByteString
+ Polysemy.Http.Effect.Entity: decodeLazy :: forall d r. Member (EntityDecode d) r => LByteString -> Sem r (Either EntityError d)
+ Polysemy.Http.Effect.Entity: encodeLazy :: forall d r. Member (EntityEncode d) r => d -> Sem r LByteString
+ Polysemy.Http.Effect.Http: consumeChunk :: forall c r. Member (Http c) r => Maybe Int -> c -> Sem r (Either HttpError ByteString)
+ Polysemy.Http.Interpreter.AesonEntity: interpretEntityDecodeAesonWith :: FromJSON j => (j -> Sem r (Either Text d)) -> Sem (EntityDecode d : r) a -> Sem r a
- Polysemy.Http: Body :: LByteString -> Body
+ Polysemy.Http: Body :: ByteString -> Body
- Polysemy.Http: decode :: forall d r. Member (EntityDecode d) r => LByteString -> Sem r (Either EntityError d)
+ Polysemy.Http: decode :: forall d r. Member (EntityDecode d) r => ByteString -> Sem r (Either EntityError d)
- Polysemy.Http: encode :: forall d r. Member (EntityEncode d) r => d -> Sem r LByteString
+ Polysemy.Http: encode :: forall d r. Member (EntityEncode d) r => d -> Sem r ByteString
- Polysemy.Http: streamResponse :: Members [Http c, Error HttpError, Resource] r => Request -> (forall x. StreamEvent o c h x -> Sem r x) -> Sem r o
+ Polysemy.Http: streamResponse :: Members [Http c, Error HttpError, Resource] r => Request -> Maybe Int -> (forall x. StreamEvent o c h x -> Sem r x) -> Sem r o
- Polysemy.Http.Data.Request: Body :: LByteString -> Body
+ Polysemy.Http.Data.Request: Body :: ByteString -> Body
- Polysemy.Http.Effect.Entity: decode :: forall d r. Member (EntityDecode d) r => LByteString -> Sem r (Either EntityError d)
+ Polysemy.Http.Effect.Entity: decode :: forall d r. Member (EntityDecode d) r => ByteString -> Sem r (Either EntityError d)
- Polysemy.Http.Effect.Entity: encode :: forall d r. Member (EntityEncode d) r => d -> Sem r LByteString
+ Polysemy.Http.Effect.Entity: encode :: forall d r. Member (EntityEncode d) r => d -> Sem r ByteString
- Polysemy.Http.Effect.Http: [ConsumeChunk] :: c -> Http c m (Either HttpError ByteString)
+ Polysemy.Http.Effect.Http: [ConsumeChunk] :: Maybe Int -> c -> Http c m (Either HttpError ByteString)
- Polysemy.Http.Http: streamResponse :: Members [Http c, Error HttpError, Resource] r => Request -> (forall x. StreamEvent o c h x -> Sem r x) -> Sem r o
+ Polysemy.Http.Http: streamResponse :: Members [Http c, Error HttpError, Resource] r => Request -> Maybe Int -> (forall x. StreamEvent o c h x -> Sem r x) -> Sem r o

Files

changelog.md view
@@ -1,5 +1,14 @@ # Unreleased +# 0.8.0.0++* Add `EncodeLazy` to `EntityEncode` and `DecodeLazy` to `EntityDecode`, and make `encode`/`decode` default to the+  strict versions.+* Add `interpretEntityDecodeAesonWith`, using an effectful callback for decoding.+* Use strict `ByteString` for the request body.+* Add an optional chunk size parameter to `streamResponse`.+* Unify `Http.response` and `Http.stream`.+ # 0.5.0.0 * Add `Num Port`. * Add json interpreters that transform payloads.
integration/Polysemy/Http/CookieTest.hs view
@@ -1,14 +1,11 @@ module Polysemy.Http.CookieTest where -import Control.Lens ((.~)) import Exon (exon) import Hedgehog (evalEither, (===))-import Polysemy.Log (interpretLogNull)+import Log (interpretLogNull)  import Polysemy.Http.Data.HttpError (HttpError)-import qualified Polysemy.Http.Data.Request as Request import Polysemy.Http.Data.Request (Port (Port), Tls (Tls))-import qualified Polysemy.Http.Data.Response as Response import Polysemy.Http.Data.Response (Response) import qualified Polysemy.Http.Effect.Http as Http import Polysemy.Http.Interpreter.Native (interpretHttpNative)@@ -31,8 +28,8 @@   where   request =     Request.get "localhost" "cookie"-    & Request.tls .~ Tls False-    & Request.port .~ Just (Port port)+    & #tls .~ Tls False+    & #port .~ Just (Port port)     & addCookie "localhost" c2 c2v     & addCookie "localhost" c1 c1v @@ -40,4 +37,4 @@ test_cookies = do   result <- liftIO (withServer runRequest)   response <- evalEither result-  [exon|#{c1}=#{c1v};#{c2}=#{c2v}|] === decodeUtf8 (Response._body response)+  [exon|#{c1}=#{c1v};#{c2}=#{c2v}|] === decodeUtf8 (response ^. #body)
integration/Polysemy/Http/RequestTest.hs view
@@ -1,14 +1,11 @@ module Polysemy.Http.RequestTest where -import Control.Lens ((.~)) import qualified Data.Aeson as Aeson import Hedgehog (evalEither, (===))-import Polysemy.Log (interpretLogNull)+import Log (interpretLogNull)  import Polysemy.Http.Data.HttpError (HttpError)-import qualified Polysemy.Http.Data.Request as Request import Polysemy.Http.Data.Request (Body (Body), Port (Port), Tls (Tls))-import qualified Polysemy.Http.Data.Response as Response import Polysemy.Http.Data.Response (Response) import qualified Polysemy.Http.Effect.Http as Http import Polysemy.Http.Interpreter.Native (interpretHttpNative)@@ -24,13 +21,13 @@   runFinal $ resourceToIOFinal $ embedToFinal $ interpretLogNull $ interpretHttpNative (Http.request request)   where   request =-    Request.post "localhost" "add" (Body (Aeson.encode (Payload 2 3)))-    & Request.tls .~ Tls False-    & Request.port .~ Just (Port port)-    & Request.headers .~ [jsonContentType]+    Request.post "localhost" "add" (Body (toStrict (Aeson.encode (Payload 2 3))))+    & #tls .~ Tls False+    & #port .~ Just (Port port)+    & #headers .~ [jsonContentType]  test_request :: UnitTest test_request = do   result <- liftIO (withServer runRequest)   response <- evalEither result-  "5" === Response._body response+  "5" === response ^. #body
integration/Polysemy/Http/Server.hs view
@@ -19,7 +19,6 @@   withSocketsDo,   ) import qualified Network.Wai.Handler.Warp as Warp-import Polysemy.Time.Json (json) import Prelude hiding (bracket) import Servant (Get, Handler, Header, JSON, PlainText, Post, ReqBody, ServerT, serve, (:<|>) ((:<|>)), (:>)) import Servant.Client (BaseUrl (BaseUrl), Client, ClientEnv, ClientM, Scheme (Http), client, mkClientEnv, runClientM)@@ -40,7 +39,7 @@     one :: Int,     two :: Int   }-  deriving (Eq, Show)+  deriving stock (Eq, Show)  json ''Payload 
integration/Polysemy/Http/StreamTest.hs view
@@ -1,12 +1,10 @@ module Polysemy.Http.StreamTest where -import Control.Lens ((.~)) import qualified Data.ByteString as ByteString import Hedgehog (assert, evalEither, (===))-import Polysemy.Log (interpretLogNull)+import Log (interpretLogNull)  import Polysemy.Http.Data.HttpError (HttpError)-import qualified Polysemy.Http.Data.Request as Request import Polysemy.Http.Data.Request (Port (Port), Request, Tls (Tls)) import Polysemy.Http.Data.StreamChunk (StreamChunk (StreamChunk)) import qualified Polysemy.Http.Data.StreamEvent as StreamEvent@@ -20,8 +18,8 @@ req :: Int -> Request req port =   Request.get "localhost" "stream"-  & Request.port .~ Just (Port port)-  & Request.tls .~ Tls False+  & #port .~ Just (Port port)+  & #tls .~ Tls False  handle ::   Members [Embed IO, State [Int]] r =>@@ -48,11 +46,11 @@   runState empty $   interpretLogNull $   interpretHttpNative $-  Http.streamResponse (req port) handle+  Http.streamResponse (req port) (Just 8192) handle  test_httpStream :: UnitTest test_httpStream = do   result <- liftIO (withServer runRequest)   (chunkSizes, ()) <- evalEither result-  assert (length chunkSizes >= 10)+  assert (all (>= 8192) chunkSizes)   sum chunkSizes === 10 * 8192
lib/Polysemy/Http.hs view
@@ -35,6 +35,7 @@   -- * Entity   EntityDecode,   decode,+  decodeLazy,   decodeStrict,   EntityEncode,   encode,@@ -88,16 +89,18 @@   EntityEncode,   EntityError (EntityError),   decode,+  decodeLazy,   decodeStrict,   encode,   encodeStrict,   )-import Polysemy.Http.Effect.Http (Http, request, response, stream)+import Polysemy.Http.Effect.Http (Http, request, response) import Polysemy.Http.Effect.Manager (Manager) import Polysemy.Http.Http (streamResponse) import Polysemy.Http.Interpreter.AesonEntity (   interpretEntityDecodeAeson,   interpretEntityDecodeAesonAs,+  interpretEntityDecodeAesonWith,   interpretEntityEncodeAeson,   interpretEntityEncodeAesonAs,   )@@ -128,7 +131,7 @@ -- -- @ -- import Polysemy (resourceToIO, runM)--- import Polysemy.Log (interpretLogStdout)+-- import Log (interpretLogStdout) -- import qualified Polysemy.Http as Http -- import Polysemy.Http (interpretHttpNative, interpretLogStdout) --
lib/Polysemy/Http/Data/Header.hs view
@@ -3,12 +3,10 @@ -- |Description: Header Data Types, Internal module Polysemy.Http.Data.Header where -import Polysemy.Time.Json (json)- -- |The name of a header. newtype HeaderName =   HeaderName { unHeaderName :: Text }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString)  json ''HeaderName@@ -16,7 +14,7 @@ -- |The value of a header. newtype HeaderValue =   HeaderValue { unHeaderValue :: Text }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString)  json ''HeaderValue@@ -27,6 +25,6 @@     name :: HeaderName,     value :: HeaderValue   }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)  json ''Header
lib/Polysemy/Http/Data/HttpError.hs view
@@ -7,4 +7,4 @@   ChunkFailed Text   |   Internal Text-  deriving (Eq, Show)+  deriving stock (Eq, Show)
lib/Polysemy/Http/Data/Request.hs view
@@ -3,10 +3,8 @@ -- |Description: Request Data Types, Internal module Polysemy.Http.Data.Request where -import Control.Lens (makeClassy) import qualified Data.Text as Text import Network.HTTP.Client.Internal (CookieJar)-import Polysemy.Time.Json (json)  import Polysemy.Http.Data.Header (HeaderName, HeaderValue) @@ -31,7 +29,7 @@   Patch   |   Custom Text-  deriving (Eq, Show)+  deriving stock (Eq, Show)  json ''Method @@ -66,7 +64,7 @@ -- |Request host name. newtype Host =   Host { unHost :: Text }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString)  json ''Host@@ -74,7 +72,7 @@ -- |Request port. newtype Port =   Port { unPort :: Int }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving newtype (Num, Ord, Enum, Real, Integral, Read)  json ''Port@@ -82,14 +80,14 @@ -- |A flag that indicates whether a request should use TLS. newtype Tls =   Tls { unTls :: Bool }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)  json ''Tls  -- |Rrequest path. newtype Path =   Path { unPath :: Text }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString, Monoid)  instance Semigroup Path where@@ -101,7 +99,7 @@ -- |The key of a query parameter. newtype QueryKey =   QueryKey { unQueryKey :: Text }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString)  json ''QueryKey@@ -109,33 +107,31 @@ -- |The value of a query parameter. newtype QueryValue =   QueryValue { unQueryValue :: Text }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString)  json ''QueryValue --- |Request body, using 'LByteString' because it is what 'Aeson.encode' produces.+-- |Request body. newtype Body =-  Body { unBody :: LByteString }-  deriving (Eq, Show, Generic)+  Body { unBody :: ByteString }+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString)  -- |HTTP request parameters, used by 'Polysemy.Http.Effect.Http'. data Request =   Request {-    _method :: Method,-    _host :: Host,-    _port :: Maybe Port,-    _tls :: Tls,-    _path :: Path,-    _headers :: [(HeaderName, HeaderValue)],-    _cookies :: CookieJar,-    _query :: [(QueryKey, Maybe QueryValue)],-    _body :: Body+    method :: Method,+    host :: Host,+    port :: Maybe Port,+    tls :: Tls,+    path :: Path,+    headers :: [(HeaderName, HeaderValue)],+    cookies :: CookieJar,+    query :: [(QueryKey, Maybe QueryValue)],+    body :: Body   }-  deriving (Show, Generic)--makeClassy ''Request+  deriving stock (Show, Generic)  instance Eq Request where   Request lm lh lp lt lpa lhe _ lq lb == Request rm rh rp rt rpa rhe _ rq rb =
lib/Polysemy/Http/Data/Response.hs view
@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |Description: Response Data Types, Internal module Polysemy.Http.Data.Response (   module Polysemy.Http.Data.Response,@@ -15,7 +16,7 @@   statusIsServerError,   statusIsSuccessful,   )-import qualified Text.Show as Text (Show (show))+import qualified Text.Show as Text  import Polysemy.Http.Data.Header (Header) @@ -23,19 +24,19 @@ data Response b =   Response {     -- |Uses the type from 'Network.HTTP' for convenience.-    _status :: Status,+    status :: Status,     -- |The body might be evaluated or an 'IO' action.-    _body :: b,+    body :: b,     -- |Does not use the type from 'Network.HTTP' because it is an alias.-    _headers :: [Header],+    headers :: [Header],     -- |The native cookie jar.-    _cookies :: CookieJar+    cookies :: CookieJar   }-  deriving (Show)+  deriving stock (Show, Generic)  instance {-# overlapping #-} Show (Response BodyReader) where   show (Response s _ hs _) =-    [exon|StreamingResponse { status :: #{show s}, headers :: #{show hs} }|]+    [exon|Response { status :: #{show s}, headers :: #{show hs} }|]  instance Eq b => Eq (Response b) where   Response ls lb lh _ == Response rs rb rh _ =
lib/Polysemy/Http/Data/StreamChunk.hs view
@@ -5,4 +5,4 @@ -- |A single chunk produced by 'Network.HTTP.Client.BodyReader'. newtype StreamChunk =   StreamChunk ByteString-  deriving (Eq, Show)+  deriving stock (Eq, Show)
lib/Polysemy/Http/Effect/Entity.hs view
@@ -9,17 +9,17 @@     body :: Text,     message :: Text   }-  deriving (Eq, Show)+  deriving stock (Eq, Show)  -- |Abstraction of json encoding, potentially usable for other content types like xml. data EntityEncode d :: Effect where-  Encode :: d -> EntityEncode d m LByteString+  EncodeLazy :: d -> EntityEncode d m LByteString   EncodeStrict :: d -> EntityEncode d m ByteString  makeSem_ ''EntityEncode  -- |Lazily encode a value of type @d@ to a 'LByteString'-encode ::+encodeLazy ::   ∀ d r .   Member (EntityEncode d) r =>   d ->@@ -32,15 +32,24 @@   d ->   Sem r ByteString +-- |Strictly encode a value of type @d@ to a 'ByteString'+encode ::+  ∀ d r .+  Member (EntityEncode d) r =>+  d ->+  Sem r ByteString+encode =+  encodeStrict+ -- |Abstraction of json decoding, potentially usable for other content types like xml. data EntityDecode d :: Effect where-  Decode :: LByteString -> EntityDecode d m (Either EntityError d)+  DecodeLazy :: LByteString -> EntityDecode d m (Either EntityError d)   DecodeStrict :: ByteString -> EntityDecode d m (Either EntityError d)  makeSem_ ''EntityDecode  -- |Lazily decode a 'LByteString' to a value of type @d@-decode ::+decodeLazy ::   ∀ d r .   Member (EntityDecode d) r =>   LByteString ->@@ -52,6 +61,15 @@   Member (EntityDecode d) r =>   ByteString ->   Sem r (Either EntityError d)++-- |Strictly decode a 'ByteString' to a value of type @d@+decode ::+  ∀ d r .+  Member (EntityDecode d) r =>+  ByteString ->+  Sem r (Either EntityError d)+decode =+  decodeStrict  -- |Marker type to be used with 'Entities' data Encode a
lib/Polysemy/Http/Effect/Http.hs view
@@ -12,9 +12,8 @@ data Http c :: Effect where   Response :: Request -> (Response c -> m a) -> Http c m (Either HttpError a)   Request :: Request -> Http c m (Either HttpError (Response LByteString))-  Stream :: Request -> (Response c -> m a) -> Http c m (Either HttpError a)   -- |Internal action for streaming transfers.-  ConsumeChunk :: c -> Http c m (Either HttpError ByteString)+  ConsumeChunk :: Maybe Int -> c -> Http c m (Either HttpError ByteString)  makeSem_ ''Http @@ -34,17 +33,10 @@   Request ->   Sem r (Either HttpError (Response LByteString)) --- |Open a connection without consuming data and pass the response to a handler for custom transmission.--- The intended purpose is to allow streaming transfers.-stream ::-  ∀ c r a .-  Member (Http c) r =>-  Request ->-  (Response c -> Sem r a) ->-  Sem r (Either HttpError a)-+-- |Consumes a chunk while streaming, with an optional chunk size. consumeChunk ::   ∀ c r .   Member (Http c) r =>+  Maybe Int ->   c ->   Sem r (Either HttpError ByteString)
lib/Polysemy/Http/Http.hs view
@@ -16,15 +16,16 @@  streamLoop ::   Members [Http c, Error HttpError] r =>+  Maybe Int ->   (∀ x . StreamEvent o c h x -> Sem r x) ->   Response c ->   h ->   Sem r o-streamLoop process response@(Response _ body _ _) handle =+streamLoop chunkSize process response@(Response _ body _ _) handle =   spin   where     spin =-      handleChunk =<< fromEither =<< Http.consumeChunk body+      handleChunk =<< fromEither =<< Http.consumeChunk chunkSize body     handleChunk (ByteString.null -> True) =       process (StreamEvent.Result response handle)     handleChunk !chunk = do@@ -34,11 +35,12 @@ streamHandler ::   ∀ o r c h .   Members [Http c, Error HttpError, Resource] r =>+  Maybe Int ->   (∀ x . StreamEvent o c h x -> Sem r x) ->   Response c ->   Sem r o-streamHandler process response = do-  bracket acquire release (streamLoop process response)+streamHandler chunkSize process response = do+  bracket acquire release (streamLoop chunkSize process response)   where     acquire =       process (StreamEvent.Acquire response)@@ -48,6 +50,8 @@ -- |Initiate a request and stream the response, calling @process@ after connecting, for every chunk, after closing the -- connection, and for the return value. -- 'StreamEvent' is used to indicate the stage of the request cycle.+-- The optional 'Int' argument defines the minimal chunk size that is read for each callback. If it is 'Nothing', the+-- stream reads what is available. -- -- @ -- handle ::@@ -68,7 +72,8 @@ streamResponse ::   Members [Http c, Error HttpError, Resource] r =>   Request ->+  Maybe Int ->   (∀ x . StreamEvent o c h x -> Sem r x) ->   Sem r o-streamResponse request process =-  fromEither . join =<< Http.stream request (runError . streamHandler (raise . process))+streamResponse request chunkSize process =+  fromEither . join =<< Http.response request (runError . streamHandler chunkSize (raise . process))
lib/Polysemy/Http/Interpreter/AesonEntity.hs view
@@ -1,8 +1,9 @@ {-# options_haddock prune #-}+ -- |Description: Entity Aeson Interpreters, Internal module Polysemy.Http.Interpreter.AesonEntity where -import Data.Aeson (FromJSON, ToJSON, eitherDecode', eitherDecodeStrict', encode)+import Data.Aeson (eitherDecode', eitherDecodeStrict', encode)  import Polysemy.Http.Effect.Entity (EntityDecode, EntityEncode, EntityError (EntityError)) import qualified Polysemy.Http.Effect.Entity as Entity (EntityDecode (..), EntityEncode (..))@@ -16,7 +17,7 @@   Sem r a interpretEntityEncodeAesonAs convert =   interpret \case-    Entity.Encode a ->+    Entity.EncodeLazy a ->       pure (encode (convert a))     Entity.EncodeStrict a ->       pure (toStrict (encode (convert a)))@@ -40,7 +41,33 @@   pure . first (EntityError (decodeUtf8 body) . toText) $ dec body {-# inline decodeWith #-} +convertWith ::+  ConvertUtf8 Text s =>+  (s -> Either String j) ->+  (j -> Sem r (Either Text d)) ->+  s ->+  Sem r (Either EntityError d)+convertWith dec convert body =+  runError do+    raw <- fromEither =<< decodeWith dec body+    fromEither . first (EntityError (decodeUtf8 body)) =<< raise (convert raw)+ -- |Interpreter for 'EntityDecode' that uses Aeson and a different codec type.+-- The first parameter is the effectful conversion function.+interpretEntityDecodeAesonWith ::+  FromJSON j =>+  (j -> Sem r (Either Text d)) ->+  Sem (EntityDecode d : r) a ->+  Sem r a+interpretEntityDecodeAesonWith convert =+  interpret \case+    Entity.DecodeLazy body ->+      convertWith eitherDecode' convert body+    Entity.DecodeStrict body ->+      convertWith eitherDecodeStrict' convert body+{-# inline interpretEntityDecodeAesonWith #-}++-- |Interpreter for 'EntityDecode' that uses Aeson and a different codec type. -- The first parameter is the conversion function. interpretEntityDecodeAesonAs ::   FromJSON j =>@@ -49,7 +76,7 @@   Sem r a interpretEntityDecodeAesonAs convert =   interpret \case-    Entity.Decode body ->+    Entity.DecodeLazy body ->       fmap convert <$> decodeWith eitherDecode' body     Entity.DecodeStrict body ->       fmap convert <$> decodeWith eitherDecodeStrict' body
lib/Polysemy/Http/Interpreter/Native.hs view
@@ -7,10 +7,10 @@ import Data.CaseInsensitive (foldedCase) import Exon (exon) import qualified Network.HTTP.Client as HTTP-import Network.HTTP.Client (BodyReader, httpLbs, responseClose, responseOpen)+import Network.HTTP.Client (BodyReader, brRead, brReadSome, httpLbs, responseClose, responseOpen) import Network.HTTP.Client.Internal (CookieJar (CJ)) import Polysemy.Internal.Tactics (liftT)-import qualified Polysemy.Log as Log+import qualified Log as Log  import Polysemy.Http.Data.Header (Header (Header), unHeaderName, unHeaderValue) import qualified Polysemy.Http.Data.HttpError as HttpError@@ -43,7 +43,7 @@     HTTP.method = encodeUtf8 (methodUpper method),     HTTP.requestHeaders = encodedHeaders,     HTTP.path = encodeUtf8 path,-    HTTP.requestBody = HTTP.RequestBodyLBS body,+    HTTP.requestBody = HTTP.RequestBodyBS body,     HTTP.cookieJar = CJ . toList <$> nonEmpty cookies   }   where@@ -113,13 +113,18 @@     pure (Left err <$ s) {-# inline distribEither #-} +readChunk :: Int -> BodyReader -> IO ByteString+readChunk chunkSize body =+  toStrict <$> brReadSome body chunkSize+ -- |Same as 'interpretHttpNative', but the interpretation of 'Manager' is left to the user. interpretHttpNativeWith ::   Members [Embed IO, Log, Resource, Manager] r =>   InterpreterFor (Http BodyReader) r interpretHttpNativeWith =   interpretH \case-    Http.Response request f ->+    Http.Response request f -> do+      Log.debug [exon|http request: #{show request}|]       distribEither =<< withResponse request ((\ x -> runTSimple x) . f)     Http.Request request -> do       Log.debug [exon|http request: #{show request}|]@@ -127,11 +132,8 @@       liftT do         response <- executeRequest manager request         response <$ Log.debug [exon|http response: #{show response}|]-    Http.Stream request handler -> do-      Log.debug [exon|http stream request: #{show request}|]-      distribEither =<< withResponse request ((\ x -> runTSimple x) . handler)-    Http.ConsumeChunk body ->-      pureT . first HttpError.ChunkFailed =<< tryAny body+    Http.ConsumeChunk chunkSize body ->+      pureT . first HttpError.ChunkFailed =<< tryAny (maybe brRead readChunk chunkSize body) {-# inline interpretHttpNativeWith #-}  -- |Interpret @'Http' 'BodyReader'@ using the native "Network.HTTP.Client" implementation.
lib/Polysemy/Http/Interpreter/Pure.hs view
@@ -38,11 +38,7 @@       fmap Right <$> bindTSimple f res     Http.Request _ ->       liftT . fmap Right . takeResponse =<< raise get-    Http.Stream _ handler -> do-      handle <- bindT handler-      res <- liftT . takeResponse =<< raise get-      fmap Right <$> raise (interpretHttpPureWithState (handle res))-    Http.ConsumeChunk _ ->+    Http.ConsumeChunk _ _ ->       liftT . fmap Right . takeChunk =<< raise get {-# inline interpretHttpPureWithState #-} 
lib/Polysemy/Http/Json.hs view
@@ -1,12 +1,10 @@ {-# options_haddock prune #-}+ -- |Description: Json Request Combinator, Internal module Polysemy.Http.Json where -import Control.Lens ((%~))- import Polysemy.Http.Data.Header (HeaderName, HeaderValue) import Polysemy.Http.Data.HttpError (HttpError)-import qualified Polysemy.Http.Data.Request as Request import Polysemy.Http.Data.Request (Request) import Polysemy.Http.Data.Response (Response) import qualified Polysemy.Http.Effect.Http as Http@@ -22,4 +20,4 @@   Request ->   Sem r (Either HttpError (Response LByteString)) jsonRequest =-  Http.request . (Request.headers %~ (jsonContentType :))+  Http.request . (#headers %~ (jsonContentType :))
lib/Polysemy/Http/Request.hs view
@@ -3,7 +3,6 @@ -- |Description: Request Combinators, Internal module Polysemy.Http.Request where -import Control.Lens ((%~)) import qualified Data.Text as Text import Data.Time (UTCTime (UTCTime)) import Data.Time.Calendar (fromGregorian)@@ -13,8 +12,15 @@ import Network.HTTP.Client.Internal (CookieJar (CJ, expose)) import Prelude hiding (get, put) -import qualified Polysemy.Http.Data.Request as Request-import Polysemy.Http.Data.Request (Body, Host (Host), Method (..), Path (Path), Port (Port), Request (Request), Tls (Tls))+import Polysemy.Http.Data.Request (+  Body,+  Host (Host),+  Method (..),+  Path (Path),+  Port (Port),+  Request (Request),+  Tls (Tls),+  )  invalidScheme ::   Text ->@@ -189,7 +195,7 @@   Request ->   Request addCookies cookies =-  Request.cookies %~ update+  #cookies %~ update   where     update =       CJ . (cookies <>) . expose
polysemy-http.cabal view
@@ -1,29 +1,29 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.6.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack  name:           polysemy-http-version:        0.7.0.0-synopsis:       Polysemy Effects for HTTP clients-description:    See <https://hackage.haskell.org/package/polysemy-http/docs/Polysemy-Http.html>+version:        0.8.0.0+synopsis:       Polysemy effects for HTTP clients+description:    See https://hackage.haskell.org/package/polysemy-http/docs/Polysemy-Http.html category:       Network-homepage:       https://github.com/tek/polysemy-http#readme-bug-reports:    https://github.com/tek/polysemy-http/issues+homepage:       https://git.tryp.io/tek/polysemy-http+bug-reports:    https://git.tryp.io/tek/polysemy-http/issues author:         Torsten Schmits-maintainer:     haskell@tryp.io-copyright:      2020 Torsten Schmits+maintainer:     hackage@tryp.io+copyright:      2022 Torsten Schmits license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple extra-source-files:-    readme.md     changelog.md+    readme.md  source-repository head   type: git-  location: https://github.com/tek/polysemy-http+  location: https://git.tryp.io/tek/polysemy-http  library   exposed-modules:@@ -60,9 +60,14 @@       DeriveFoldable       DeriveFunctor       DeriveGeneric+      DeriveLift       DeriveTraversable+      DerivingStrategies       DerivingVia+      DisambiguateRecordFields       DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase       EmptyDataDecls       ExistentialQuantification       FlexibleContexts@@ -73,9 +78,12 @@       InstanceSigs       KindSignatures       LambdaCase+      LiberalTypeSynonyms       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns+      OverloadedLabels+      OverloadedLists       OverloadedStrings       PackageImports       PartialTypeSignatures@@ -87,38 +95,36 @@       RankNTypes       RecordWildCards       RecursiveDo+      RoleAnnotations       ScopedTypeVariables       StandaloneDeriving       TemplateHaskell       TupleSections       TypeApplications       TypeFamilies+      TypeFamilyDependencies       TypeOperators       TypeSynonymInstances       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin   build-depends:       aeson >=1.4-    , ansi-terminal >=0.10.3-    , base ==4.*+    , base >=4.12 && <5     , case-insensitive >=1.2-    , data-default >=0.2     , exon >=0.3     , http-client >=0.5.14     , http-client-tls >=0.3.1     , http-types >=0.12.3-    , incipit >=0.2-    , lens >=4     , polysemy >=1.6-    , polysemy-log >=0.6.0.1     , polysemy-plugin >=0.4-    , polysemy-time >=0.4-    , template-haskell+    , prelate ==0.1.*     , time   mixins:       base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)   default-language: Haskell2010  test-suite polysemy-http-integration@@ -146,9 +152,14 @@       DeriveFoldable       DeriveFunctor       DeriveGeneric+      DeriveLift       DeriveTraversable+      DerivingStrategies       DerivingVia+      DisambiguateRecordFields       DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase       EmptyDataDecls       ExistentialQuantification       FlexibleContexts@@ -159,9 +170,12 @@       InstanceSigs       KindSignatures       LambdaCase+      LiberalTypeSynonyms       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns+      OverloadedLabels+      OverloadedLists       OverloadedStrings       PackageImports       PartialTypeSignatures@@ -173,31 +187,32 @@       RankNTypes       RecordWildCards       RecursiveDo+      RoleAnnotations       ScopedTypeVariables       StandaloneDeriving       TemplateHaskell       TupleSections       TypeApplications       TypeFamilies+      TypeFamilyDependencies       TypeOperators       TypeSynonymInstances       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N   build-depends:       aeson-    , base ==4.*+    , base >=4.12 && <5     , exon     , hedgehog     , http-client-    , incipit-    , lens     , network-    , polysemy+    , polysemy >=1.6     , polysemy-http-    , polysemy-plugin+    , polysemy-plugin >=0.4     , polysemy-time+    , prelate ==0.1.*     , servant     , servant-client     , servant-server@@ -206,6 +221,8 @@     , warp   mixins:       base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)   default-language: Haskell2010  test-suite polysemy-http-unit@@ -231,9 +248,14 @@       DeriveFoldable       DeriveFunctor       DeriveGeneric+      DeriveLift       DeriveTraversable+      DerivingStrategies       DerivingVia+      DisambiguateRecordFields       DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase       EmptyDataDecls       ExistentialQuantification       FlexibleContexts@@ -244,9 +266,12 @@       InstanceSigs       KindSignatures       LambdaCase+      LiberalTypeSynonyms       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns+      OverloadedLabels+      OverloadedLists       OverloadedStrings       PackageImports       PartialTypeSignatures@@ -258,29 +283,33 @@       RankNTypes       RecordWildCards       RecursiveDo+      RoleAnnotations       ScopedTypeVariables       StandaloneDeriving       TemplateHaskell       TupleSections       TypeApplications       TypeFamilies+      TypeFamilyDependencies       TypeOperators       TypeSynonymInstances       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base ==4.*+      base >=4.12 && <5     , exon     , hedgehog     , http-client-    , incipit-    , polysemy+    , polysemy >=1.6     , polysemy-http-    , polysemy-plugin+    , polysemy-plugin >=0.4+    , prelate ==0.1.*     , tasty     , tasty-hedgehog   mixins:       base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)   default-language: Haskell2010
test/Main.hs view
@@ -1,10 +1,9 @@ module Main where -import Polysemy.Http.Test (unitTest)-import Test.Tasty (TestTree, defaultMain, testGroup)- import Polysemy.Http.ResponseTest (test_statusPattern)+import Polysemy.Http.Test (unitTest) import Polysemy.Http.UrlTest (test_url)+import Test.Tasty (TestTree, defaultMain, testGroup)  tests :: TestTree tests =