diff --git a/integration/Polysemy/Http/Server.hs b/integration/Polysemy/Http/Server.hs --- a/integration/Polysemy/Http/Server.hs +++ b/integration/Polysemy/Http/Server.hs @@ -20,8 +20,25 @@ ) import qualified Network.Wai.Handler.Warp as Warp 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) +import Servant ( + Get, + Handler, + Header, + JSON, + NoFraming, + PlainText, + Post, + ReqBody, + ServerT, + SourceIO, + StreamGet, + serve, + (:<|>) ((:<|>)), + (:>), + ) +import Servant.Client (BaseUrl (BaseUrl), ClientEnv, Scheme (Http), mkClientEnv) +import Servant.Client.Streaming (Client, ClientM, client, runClientM) +import Servant.Types.SourceT (source) freePort :: IO PortNumber @@ -48,7 +65,7 @@ :<|> "add" :> ReqBody '[JSON] Payload :> Post '[JSON] Int :<|> - "stream" :> Get '[PlainText] Text + "stream" :> StreamGet NoFraming PlainText (SourceIO Text) :<|> "cookie" :> Header "cookie" Text :> Get '[PlainText] Text @@ -72,7 +89,7 @@ :<|> (\ (Payload a b) -> pure (a + b)) :<|> - pure (Text.replicate (10 * 8192) "x") + pure (source (replicate 10 (Text.replicate 8192 "x"))) :<|> (\ cookies -> pure (fromMaybe "no cookies" cookies)) diff --git a/lib/Polysemy/Http/Http.hs b/lib/Polysemy/Http/Http.hs --- a/lib/Polysemy/Http/Http.hs +++ b/lib/Polysemy/Http/Http.hs @@ -39,7 +39,7 @@ (∀ x . StreamEvent o c h x -> Sem r x) -> Response c -> Sem r o -streamHandler chunkSize process response = do +streamHandler chunkSize process response = bracket acquire release (streamLoop chunkSize process response) where acquire = diff --git a/lib/Polysemy/Http/Interpreter/Native.hs b/lib/Polysemy/Http/Interpreter/Native.hs --- a/lib/Polysemy/Http/Interpreter/Native.hs +++ b/lib/Polysemy/Http/Interpreter/Native.hs @@ -12,19 +12,19 @@ import Network.HTTP.Client.Internal (CookieJar (CJ)) import Polysemy.Internal.Tactics (liftT) -import Polysemy.Http.Data.Header (Header (Header), unHeaderName, unHeaderValue) +import Polysemy.Http.Data.Header (Header (..), HeaderName (..), HeaderValue (..)) import qualified Polysemy.Http.Data.HttpError as HttpError import Polysemy.Http.Data.HttpError (HttpError) import Polysemy.Http.Data.Request ( - Body (Body), - Host (Host), - Path (Path), - Request (Request), - Tls (Tls), + Body (..), + Host (..), + Path (..), + Port (..), + QueryKey (..), + QueryValue (..), + Request (..), + Tls (..), methodUpper, - unPort, - unQueryKey, - unQueryValue, ) import Polysemy.Http.Data.Response (Response (Response)) import qualified Polysemy.Http.Effect.Http as Http @@ -48,11 +48,11 @@ } where queryParams = - bimap (encodeUtf8 . (.unQueryKey)) (fmap (encodeUtf8 . (.unQueryValue))) <$> query + bimap (encodeUtf8 @Text . coerce) (fmap (encodeUtf8 @Text . coerce)) <$> query port = - maybe (if tls then 443 else 80) (.unPort) portOverride + maybe (if tls then 443 else 80) (coerce) portOverride encodedHeaders = - bimap (CaseInsensitive.mk . encodeUtf8 . (.unHeaderName)) (encodeUtf8 . (.unHeaderValue)) <$> headers + bimap (CaseInsensitive.mk . encodeUtf8 @Text . coerce) (encodeUtf8 @Text . coerce) <$> headers convertResponse :: HTTP.Response b -> Response b convertResponse response = diff --git a/polysemy-http.cabal b/polysemy-http.cabal --- a/polysemy-http.cabal +++ b/polysemy-http.cabal @@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.1. -- -- see: https://github.com/sol/hpack name: polysemy-http -version: 0.13.0.1 +version: 0.13.1.0 synopsis: Polysemy effects for HTTP clients description: See https://hackage.haskell.org/package/polysemy-http/docs/Polysemy-Http.html category: Network @@ -13,7 +13,7 @@ bug-reports: https://github.com/tek/polysemy-http/issues author: Torsten Schmits maintainer: hackage@tryp.io -copyright: 2023 Torsten Schmits +copyright: 2025 Torsten Schmits license: BSD-2-Clause-Patent license-file: LICENSE build-type: Simple @@ -47,6 +47,7 @@ hs-source-dirs: lib default-extensions: + StrictData AllowAmbiguousTypes ApplicativeDo BlockArguments @@ -61,6 +62,7 @@ GADTs LambdaCase LiberalTypeSynonyms + MonadComprehensions MultiWayIf OverloadedLabels OverloadedLists @@ -83,17 +85,17 @@ NoFieldSelectors ghc-options: -fplugin=Polysemy.Plugin -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages build-depends: - aeson >=1.4 && <2.2 - , base ==4.* - , case-insensitive ==1.2.* - , exon >=1.4 && <1.6 - , http-client >=0.5.14 && <0.8 - , http-client-tls >=0.3.1 && <0.4 + aeson >=2.1.0.0 && <2.3 + , base >=4.17.2.1 && <4.21 + , case-insensitive >=1.2.0.11 && <1.3 + , exon >=1.4.0.0 && <1.8 + , http-client >=0.5.13.1 && <0.8 + , http-client-tls >=0.3.0 && <0.4 , http-types >=0.12.3 && <0.13 - , polysemy ==1.9.* - , polysemy-plugin ==0.4.* - , prelate >=0.6 && <0.8 - , time + , polysemy >=1.9.0.0 && <1.10 + , polysemy-plugin >=0.4.4.0 && <0.5 + , prelate >=0.5.0.0 && <0.9 + , time >=1.12.2 && <1.13 mixins: base hiding (Prelude) , prelate (Prelate as Prelude) @@ -112,6 +114,7 @@ hs-source-dirs: integration default-extensions: + StrictData AllowAmbiguousTypes ApplicativeDo BlockArguments @@ -126,6 +129,7 @@ GADTs LambdaCase LiberalTypeSynonyms + MonadComprehensions MultiWayIf OverloadedLabels OverloadedLists @@ -148,21 +152,22 @@ NoFieldSelectors ghc-options: -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages build-depends: - aeson >=1.4 && <2.2 - , base ==4.* - , exon >=1.4 && <1.6 - , hedgehog >=1.1 && <1.3 - , http-client >=0.5.14 && <0.8 - , network ==3.1.* - , polysemy ==1.9.* + aeson >=2.1.0.0 && <2.3 + , base >=4.17.2.1 && <4.21 + , exon >=1.4.0.0 && <1.8 + , hedgehog >=1.1.2 && <1.6 + , http-client >=0.5.13.1 && <0.8 + , network >=3.1.2.9 && <3.2 + , polysemy >=1.9.0.0 && <1.10 , polysemy-http - , polysemy-plugin ==0.4.* - , prelate >=0.6 && <0.8 - , servant-client ==0.19.* - , servant-server ==0.19.* - , tasty ==1.4.* - , tasty-hedgehog >=1.3 && <1.5 - , warp ==3.3.* + , polysemy-plugin >=0.4.4.0 && <0.5 + , prelate >=0.5.0.0 && <0.9 + , servant >=0.19.1 && <0.21 + , servant-client >=0.19 && <0.21 + , servant-server >=0.19.2 && <0.21 + , tasty >=1.2.2 && <1.6 + , tasty-hedgehog >=1.3.0.0 && <1.5 + , warp >=3.3.21 && <3.5 mixins: base hiding (Prelude) , prelate (Prelate as Prelude) @@ -179,6 +184,7 @@ hs-source-dirs: test default-extensions: + StrictData AllowAmbiguousTypes ApplicativeDo BlockArguments @@ -193,6 +199,7 @@ GADTs LambdaCase LiberalTypeSynonyms + MonadComprehensions MultiWayIf OverloadedLabels OverloadedLists @@ -215,16 +222,16 @@ NoFieldSelectors ghc-options: -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages build-depends: - base ==4.* - , exon >=1.4 && <1.6 - , hedgehog >=1.1 && <1.3 - , http-client >=0.5.14 && <0.8 - , polysemy ==1.9.* + base >=4.17.2.1 && <4.21 + , exon >=1.4.0.0 && <1.8 + , hedgehog >=1.1.2 && <1.6 + , http-client >=0.5.13.1 && <0.8 + , polysemy >=1.9.0.0 && <1.10 , polysemy-http - , polysemy-plugin ==0.4.* - , prelate >=0.6 && <0.8 - , tasty ==1.4.* - , tasty-hedgehog >=1.3 && <1.5 + , polysemy-plugin >=0.4.4.0 && <0.5 + , prelate >=0.5.0.0 && <0.9 + , tasty >=1.2.2 && <1.6 + , tasty-hedgehog >=1.3.0.0 && <1.5 mixins: base hiding (Prelude) , prelate (Prelate as Prelude)