polysemy-http 0.3.0.0 → 0.3.1.0

raw patch · 9 files changed

+68/−45 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Changelog.md +3/−0
• README.md +1/−0
• lib/Polysemy/Http.hs +1/−1
• lib/Polysemy/Http/Data/Http.hs +12/−3
• lib/Polysemy/Http/Data/Response.hs +3/−3
• lib/Polysemy/Http/Http.hs +1/−1
• lib/Polysemy/Http/Native.hs +27/−15
• lib/Polysemy/Http/Strict.hs +16/−12
• polysemy-http.cabal +4/−10

@@ -1,3 +1,6 @@+# 0.3.0.0+* Add support for cookies+ # 0.2.0.3 * removed the base-noprelude dependency in favor of using a `hiding` mixin 

@@ -36,6 +36,7 @@     _tls :: Tls,     _path :: Path,     _headers :: [(HeaderName, HeaderValue)],+    _cookies :: CookieJar,     _query :: [(QueryKey, Maybe QueryValue)],     _body :: Body   }

@@ -65,7 +65,7 @@   encodeStrict,   ) import Polysemy.Http.Data.Header (Header(..), HeaderName(..), HeaderValue(..))-import Polysemy.Http.Data.Http (Http, request, stream)+import Polysemy.Http.Data.Http (Http, request, response, stream) import Polysemy.Http.Data.HttpError (HttpError(..)) import Polysemy.Http.Data.Log (Log) import Polysemy.Http.Data.Manager (Manager)

@@ -9,13 +9,22 @@ -- |The main effect for HTTP requests. -- The parameter @c@ determines the representation of raw chunks. 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 (Either HttpError a)) -> Http c m (Either HttpError a)-  -- |Internal effect for streaming transfers.+  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)  makeSem_ ''Http +-- |Bracket a higher-order action with a 'Response' that has been opened while its body hasn't been fetched.+response ::+  ∀ c r a .+  Member (Http c) r =>+  Request ->+  (Response c -> Sem r a) ->+  Sem r (Either HttpError a)+ -- |Synchronously run an HTTP request and return the response. request ::   ∀ c r .@@ -29,7 +38,7 @@   ∀ c r a .   Member (Http c) r =>   Request ->-  (Response c -> Sem r (Either HttpError a)) ->+  (Response c -> Sem r a) ->   Sem r (Either HttpError a)  consumeChunk ::

@@ -19,16 +19,16 @@ -- |The response produced by 'Polysemy.Http.Data.Http'. data Response b =   Response {-    -- |Uses the type from 'Network.HTTP' for convenience+    -- |Uses the type from 'Network.HTTP' for convenience.     status :: Status,-    -- |parameterized in the body to allow different interpreters to use other representations.+    -- |The body might be evaluated or an 'IO' action.     body :: b,     -- |Does not use the type from 'Network.HTTP' because it is an alias.     headers :: [Header]   }   deriving (Eq, Show) -instance {-# OVERLAPPING #-} Show (Response BodyReader) where+instance {-# overlapping #-} Show (Response BodyReader) where   show (Response s _ hs) =     [qt|StreamingResponse { status :: #{s}, headers :: #{hs} }|] 

@@ -69,4 +69,4 @@   (∀ x . StreamEvent o c h x -> Sem r x) ->   Sem r o streamResponse request process =-  fromEither =<< Http.stream request (runError . streamHandler (raise . process))+  fromEither . join =<< Http.stream request (runError . streamHandler (raise . process))

@@ -5,7 +5,7 @@ import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client (BodyReader, httpLbs, responseClose, responseOpen) import Network.HTTP.Client.Internal (CookieJar(CJ))-import Polysemy (Tactical, interpretH, runT)+import Polysemy (getInitialStateT, interpretH, runTSimple) import qualified Polysemy.Http.Data.Log as Log import Polysemy.Http.Data.Log (Log) import Polysemy.Resource (Resource, bracket)@@ -76,15 +76,12 @@ executeRequest manager request =   fmap convertResponse <$> internalError (httpLbs (nativeRequest request) manager) --- |Default handler for 'Http.Stream'.--- Uses 'bracket' to acquire and close the connection, calling 'StreamEvent.Acquire' and 'StreamEvent.Release' in the--- corresponding phases.-httpStream ::+withResponse ::   Members [Embed IO, Log, Resource, Manager] r =>   Request ->-  (Response BodyReader -> m (Either HttpError a)) ->-  Tactical (Http BodyReader) m r (Either HttpError a)-httpStream request handler =+  (Response BodyReader -> Sem r a) ->+  Sem r (Either HttpError a)+withResponse request f =   bracket acquire release use   where     acquire = do@@ -95,29 +92,44 @@     release (Left _) =       unit     use (Right response) = do-      raise . interpretHttpNativeWith =<< runT (handler (convertResponse response))+      Right <$> f (convertResponse response)     use (Left err) =-      pureT (Left err)+      pure (Left err)     closeFailed err =       Log.error [qt|closing response failed: #{err}|]-{-# INLINE httpStream #-}+{-# INLINE withResponse #-} +distribEither ::+  Functor f =>+  Either err (f a) ->+  Sem (WithTactics e f m r) (f (Either err a))+distribEither = \case+  Right fa ->+    pure (Right <$> fa)+  Left err -> do+    s <- getInitialStateT+    pure (Left err <$ s)+{-# INLINE distribEither #-}+ -- |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 -> do+      distribEither =<< withResponse request (runTSimple . f)     Http.Request request -> do-      Log.debug $ [qt|http request: #{request}|]+      Log.debug [qt|http request: #{request}|]       manager <- Manager.get       liftT do         response <- executeRequest manager request         response <$ Log.debug [qt|http response: #{response}|]-    Http.Stream request handler ->-      httpStream request handler+    Http.Stream request handler -> do+      Log.debug [qt|http stream request: #{request}|]+      distribEither =<< withResponse request (runTSimple . handler)     Http.ConsumeChunk body ->-      pureT =<< mapLeft HttpError.ChunkFailed <$> tryAny body+      pureT . first HttpError.ChunkFailed =<< tryAny body {-# INLINE interpretHttpNativeWith #-}  -- |Interpret @'Http' 'BodyReader'@ using the native 'Network.HTTP.Client' implementation.

@@ -1,7 +1,7 @@ module Polysemy.Http.Strict where  import Polysemy (interpretH)-import Polysemy.Internal.Tactics hiding (liftT)+import Polysemy.Internal.Tactics (bindT, bindTSimple)  import Polysemy.Http.Data.Header (Header(Header)) import qualified Polysemy.Http.Data.Http as Http@@ -11,11 +11,11 @@ takeResponse ::   Member (State [Response LByteString]) r =>   [Response LByteString] ->-  Sem r (Either a (Response LByteString))+  Sem r (Response LByteString) takeResponse (response : rest) =-  Right response <$ put rest+  response <$ put rest takeResponse [] =-  pure (Right (Response (toEnum 502) "test responses exhausted" []))+  pure (Response (toEnum 502) "test responses exhausted" [])  takeChunk ::   Member (State [ByteString]) r =>@@ -26,36 +26,40 @@ takeChunk [] =   pure "" -streamResponse :: Response Int+streamResponse :: Response LByteString streamResponse =-  Response (toEnum 200) 1 [+  Response (toEnum 200) "stream response" [     Header "content-disposition" [qt|filename="file.txt"|],     Header "content-length" "5000000"     ]  interpretHttpStrictWithState ::   Members [State [ByteString], State [Response LByteString], Embed IO] r =>-  InterpreterFor (Http Int) r+  InterpreterFor (Http LByteString) r interpretHttpStrictWithState =   interpretH \case+    Http.Response _ f -> do+      res <- liftT . takeResponse =<< raise get+      fmap Right <$> bindTSimple f res     Http.Request _ ->-      liftT . takeResponse =<< raise get+      liftT . fmap Right . takeResponse =<< raise get     Http.Stream _ handler -> do       handle <- bindT handler       resp <- pureT streamResponse-      raise (interpretHttpStrictWithState (handle resp))+      fmap Right <$> raise (interpretHttpStrictWithState (handle resp))     Http.ConsumeChunk _ ->       liftT . fmap Right . takeChunk =<< raise get {-# INLINE interpretHttpStrictWithState #-}  -- |In-Memory interpreter for 'Http'.--- The first parameter is a list of 'Response'. When a request is made, one response is popped of the head and returned.--- If the list is exhausted, a 502 response is returned. interpretHttpStrict ::   Member (Embed IO) r =>+  -- |When a request is made, one response is popped of the head and returned.+  --   If the list is exhausted, a 502 response is returned.   [Response LByteString] ->+  -- |Chunks used for streaming responses.   [ByteString] ->-  InterpreterFor (Http Int) r+  InterpreterFor (Http LByteString) r interpretHttpStrict responses chunks =   evalState chunks .   evalState responses .

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-http-version:        0.3.0.0+version:        0.3.1.0 synopsis:       Polysemy effect for http-client description:    Please see the README on Github at <https://github.com/tek/polysemy-http> category:       Network@@ -55,7 +55,7 @@   hs-source-dirs:       lib   default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingVia DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PackageImports PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns-  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall+  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall -O2   build-depends:       aeson >=1.4.4.0     , ansi-terminal >=0.9.1@@ -81,8 +81,6 @@     , time   mixins:       base hiding (Prelude)-  if impl(ghc < 8.10)-    ghc-options: -O2   default-language: Haskell2010  test-suite polysemy-http-integration@@ -98,7 +96,7 @@   hs-source-dirs:       integration   default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingVia DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PackageImports PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns-  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall -O2 -threaded -rtsopts -with-rtsopts=-N   build-depends:       aeson >=1.4.4.0     , ansi-terminal >=0.9.1@@ -135,8 +133,6 @@       base hiding (Prelude)     , polysemy-http hiding (Prelude)     , polysemy-http (Polysemy.Http.Prelude as Prelude)-  if impl(ghc < 8.10)-    ghc-options: -O2   default-language: Haskell2010  test-suite polysemy-http-unit@@ -150,7 +146,7 @@   hs-source-dirs:       test   default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingVia DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PackageImports PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns-  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -Wall -O2 -threaded -rtsopts -with-rtsopts=-N   build-depends:       aeson >=1.4.4.0     , ansi-terminal >=0.9.1@@ -182,6 +178,4 @@       base hiding (Prelude)     , polysemy-http hiding (Prelude)     , polysemy-http (Polysemy.Http.Prelude as Prelude)-  if impl(ghc < 8.10)-    ghc-options: -O2   default-language: Haskell2010