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 +9/−0
- integration/Polysemy/Http/CookieTest.hs +4/−7
- integration/Polysemy/Http/RequestTest.hs +6/−9
- integration/Polysemy/Http/Server.hs +1/−2
- integration/Polysemy/Http/StreamTest.hs +5/−7
- lib/Polysemy/Http.hs +5/−2
- lib/Polysemy/Http/Data/Header.hs +3/−5
- lib/Polysemy/Http/Data/HttpError.hs +1/−1
- lib/Polysemy/Http/Data/Request.hs +20/−24
- lib/Polysemy/Http/Data/Response.hs +8/−7
- lib/Polysemy/Http/Data/StreamChunk.hs +1/−1
- lib/Polysemy/Http/Effect/Entity.hs +23/−5
- lib/Polysemy/Http/Effect/Http.hs +3/−11
- lib/Polysemy/Http/Http.hs +11/−6
- lib/Polysemy/Http/Interpreter/AesonEntity.hs +30/−3
- lib/Polysemy/Http/Interpreter/Native.hs +11/−9
- lib/Polysemy/Http/Interpreter/Pure.hs +1/−5
- lib/Polysemy/Http/Json.hs +2/−4
- lib/Polysemy/Http/Request.hs +10/−4
- polysemy-http.cabal +59/−30
- test/Main.hs +2/−3
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 =