http-tower-hs 0.2.0.0 → 0.3.0.0

raw patch · 18 files changed

+100/−67 lines, 18 filesdep ~tower-hsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: tower-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• http-tower-hs.cabal +2/−2
• src/Network/HTTP/Tower.hs +13/−8
• src/Network/HTTP/Tower/Client.hs +10/−5
• src/Network/HTTP/Tower/Middleware/FollowRedirect.hs +2/−1
• src/Network/HTTP/Tower/Middleware/Logging.hs +2/−1
• src/Network/HTTP/Tower/Middleware/RequestId.hs +3/−2
• src/Network/HTTP/Tower/Middleware/SetHeader.hs +4/−3
• src/Network/HTTP/Tower/Middleware/TestDouble.hs +9/−6
• src/Network/HTTP/Tower/Middleware/Tracing.hs +2/−1
• src/Network/HTTP/Tower/Middleware/Validate.hs +4/−3
• test/Network/HTTP/Tower/Middleware/FollowRedirectSpec.hs +5/−4
• test/Network/HTTP/Tower/Middleware/LoggingSpec.hs +4/−3
• test/Network/HTTP/Tower/Middleware/RequestIdSpec.hs +4/−3
• test/Network/HTTP/Tower/Middleware/SetHeaderSpec.hs +5/−4
• test/Network/HTTP/Tower/Middleware/TestDoubleSpec.hs +7/−6
• test/Network/HTTP/Tower/Middleware/TracingSpec.hs +9/−8
• test/Network/HTTP/Tower/Middleware/ValidateSpec.hs +8/−7

@@ -1,5 +1,12 @@ # Changelog +## 0.3.0.0 — 2026-04-07++- Re-export `contramapService` and `dimapService` from `tower-hs`+- Adopt `(&)` from `Data.Function` as idiomatic style in docs, tests, and examples+- `(|>)` operator remains available for newcomers+- Requires `tower-hs >= 0.2.0.0`+ ## 0.2.0.0 — 2026-04-06  ### Breaking Changes

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           http-tower-hs-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Composable HTTP client middleware for Haskell, built on tower-hs description:    http-tower-hs provides HTTP-specific middleware for composable HTTP clients,                 built on top of tower-hs. Includes logging, header manipulation, redirect@@ -59,7 +59,7 @@     , text >=2.0 && <2.2     , time >=1.11 && <1.15     , tls >=2.0 && <2.2-    , tower-hs >=0.1.0.0 && <0.2+    , tower-hs >=0.2.0.0 && <0.3     , unordered-containers ==0.2.*     , uuid ==1.3.*   default-language: Haskell2010

@@ -4,22 +4,25 @@ -- License     : MIT -- -- Inspired by Rust's <https://docs.rs/tower/latest/tower/ Tower> crate.--- Build composable middleware stacks for HTTP clients with the @('|>')@ operator.+-- Build composable middleware stacks for HTTP clients with @'Data.Function.&'@+-- and @'applyMiddleware'@, or use the @('|>')@ operator for a pipeline style. -- -- @+-- import Data.Function (('&')) -- import Network.HTTP.Tower -- import qualified Network.HTTP.Client as HTTP -- -- main :: IO () -- main = do --   client <- 'newClient'---   let configured = client---         '|>' 'withBearerAuth' \"my-token\"---         '|>' 'withRequestId'---         '|>' 'withRetry' ('constantBackoff' 3 1.0)---         '|>' 'withTimeout' 5000---         '|>' 'withValidateStatus' (\\c -> c >= 200 && c < 300)---         '|>' 'withTracing'+--   let configured = client '&' 'applyMiddleware'+--         ( 'withBearerAuth' \"my-token\"+--         . 'withRequestId'+--         . 'withRetry' ('constantBackoff' 3 1.0)+--         . 'withTimeout' 5000+--         . 'withValidateStatus' (\\c -> c >= 200 && c < 300)+--         . 'withTracing'+--         ) -- --   req <- HTTP.parseRequest \"https://api.example.com/v1/users\" --   result <- 'runRequest' configured req@@ -35,6 +38,8 @@     Service(..)   , Middleware   , mapService+  , contramapService+  , dimapService   , composeMiddleware     -- * Client   , Client(..)

@@ -3,13 +3,15 @@ -- Description : HTTP client with composable middleware -- License     : MIT ----- Create an HTTP client and compose middleware using the @('|>')@ operator:+-- Create an HTTP client and compose middleware using @'Data.Function.&'@: -- -- @+-- import Data.Function (('&')) -- client <- 'newClient'--- let configured = client---       '|>' withRetry (constantBackoff 3 1.0)---       '|>' withTimeout 5000+-- let configured = client '&' 'applyMiddleware'+--       ( withRetry (constantBackoff 3 1.0)+--       . withTimeout 5000+--       ) -- result <- 'runRequest' configured request -- @ --@@ -150,7 +152,10 @@ applyMiddleware :: Middleware HTTP.Request HttpResponse -> Client -> Client applyMiddleware mw client = client { clientService = mw (clientService client) } --- | Operator for fluent middleware application.+-- | Operator for fluent middleware application (Rust\/Elixir-style).+--+-- Equivalent to using @'Data.Function.&'@ with individual middleware.+-- Provided for newcomers who prefer a left-to-right pipeline syntax: -- -- @ -- client <- 'newClient'

@@ -9,7 +9,8 @@ -- configurable maximum number of hops. -- -- @--- client '|>' 'withFollowRedirects' 5  -- max 5 hops+-- import Data.Function (('&'))+-- svc '&' 'withFollowRedirects' 5  -- max 5 hops -- @ -- -- Handles 301, 302, 303, 307, and 308. On 303, the method is changed

@@ -8,7 +8,8 @@ -- Logs HTTP method, host, status code, and duration for each request. -- -- @--- client '|>' 'withLogging' (\\msg -> Data.Text.IO.putStrLn msg)+-- import Data.Function (('&'))+-- svc '&' 'withLogging' (\\msg -> Data.Text.IO.putStrLn msg) -- @ module Network.HTTP.Tower.Middleware.Logging   ( withLogging

@@ -8,8 +8,9 @@ -- Adds a UUID v4 correlation ID to every request. -- -- @--- client '|>' 'withRequestId'                          -- X-Request-ID header--- client '|>' 'withRequestIdHeader' \"X-Correlation-ID\"  -- custom header+-- import Data.Function (('&'))+-- svc '&' 'withRequestId'                          -- X-Request-ID header+-- svc '&' 'withRequestIdHeader' \"X-Correlation-ID\"  -- custom header -- @ module Network.HTTP.Tower.Middleware.RequestId   ( withRequestId

@@ -6,9 +6,10 @@ -- License     : MIT -- -- @--- client '|>' 'withBearerAuth' \"my-token\"--- client '|>' 'withUserAgent' \"my-app\/1.0\"--- client '|>' 'withHeader' \"X-Custom\" \"value\"+-- import Data.Function (('&'))+-- svc '&' 'withBearerAuth' \"my-token\"+-- svc '&' 'withUserAgent' \"my-app\/1.0\"+-- svc '&' 'withHeader' \"X-Custom\" \"value\" -- @ module Network.HTTP.Tower.Middleware.SetHeader   ( withHeader

@@ -4,15 +4,16 @@ -- License     : MIT -- -- @+-- import Data.Function (('&')) -- -- Replace the service entirely--- let testClient = client '|>' 'withMock' (\\req -> pure (Right fakeResponse))+-- let testSvc = svc '&' 'withMock' (\\req -> pure (Right fakeResponse)) -- -- -- Route-based mocks--- let testClient = client '|>' 'withMockMap' mocks+-- let testSvc = svc '&' 'withMockMap' mocks -- -- -- Record requests for assertions -- recorder <- newIORef []--- let testClient = client '|>' 'withRecorder' recorder+-- let testSvc = svc '&' 'withRecorder' recorder -- @ module Network.HTTP.Tower.Middleware.TestDouble   ( withMock@@ -41,11 +42,12 @@ -- Falls through to the inner service if no match is found. -- -- @+-- import Data.Function (('&')) -- let mocks = Map.fromList --       [ (\"api.example.com\/v1\/users\", Right usersResponse) --       , (\"api.example.com\/v1\/health\", Right healthResponse) --       ]--- let testClient = client '|>' 'withMockMap' mocks+-- let testSvc = svc '&' 'withMockMap' mocks -- @ withMockMap   :: Map ByteString (Either ServiceError HttpResponse)@@ -60,9 +62,10 @@ -- The recorder stores requests in reverse order (most recent first). -- -- @+-- import Data.Function (('&')) -- recorder <- newIORef []--- let testClient = client '|>' 'withRecorder' recorder--- _ <- runRequest testClient someRequest+-- let testSvc = svc '&' 'withRecorder' recorder+-- _ <- runService testSvc someRequest -- recorded <- readIORef recorder -- length recorded \`shouldBe\` 1 -- @

@@ -36,7 +36,8 @@ -- If no TracerProvider is configured, this is a no-op (zero overhead). -- -- @--- let client' = client |> withTracing+-- import Data.Function (('&'))+-- let svc' = svc '&' 'withTracing' -- @ withTracing :: Middleware HTTP.Request HttpResponse withTracing inner = Service $ \req -> do

@@ -8,9 +8,10 @@ -- Reject responses that don't meet expectations: -- -- @--- client '|>' 'withValidateStatus' (\\c -> c >= 200 && c < 300)--- client '|>' 'withValidateContentType' \"application\/json\"--- client '|>' 'withValidateHeader' \"X-Request-ID\"+-- import Data.Function (('&'))+-- svc '&' 'withValidateStatus' (\\c -> c >= 200 && c < 300)+-- svc '&' 'withValidateContentType' \"application\/json\"+-- svc '&' 'withValidateHeader' \"X-Request-ID\" -- @ module Network.HTTP.Tower.Middleware.Validate   ( withValidateStatus

@@ -13,13 +13,14 @@ import Tower.Service import Tower.Error import Tower.Error.Testing ()+import Data.Function ((&)) import Network.HTTP.Tower.Middleware.FollowRedirect  spec :: Spec spec = describe "FollowRedirect middleware" $ do   it "passes non-redirect responses through" $ do     let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.status200 []))-        followed = withFollowRedirects 5 svc+        followed = svc & withFollowRedirects 5     req <- HTTP.parseRequest "http://example.com"     result <- runService followed req     case result of@@ -36,7 +37,7 @@               (HTTP.mkStatus 302 "Found")               [("Location", "http://example.com/redirected")]             else pure $ Right $ fakeResponseWith HTTP.status200 []-        followed = withFollowRedirects 5 svc+        followed = svc & withFollowRedirects 5     req <- HTTP.parseRequest "http://example.com/original"     result <- runService followed req     case result of@@ -48,7 +49,7 @@     let svc = Service $ \_ -> pure $ Right $ fakeResponseWith           (HTTP.mkStatus 301 "Moved")           [("Location", "http://example.com/loop")]-        followed = withFollowRedirects 3 svc+        followed = svc & withFollowRedirects 3     req <- HTTP.parseRequest "http://example.com/loop"     result <- runService followed req     case result of@@ -65,7 +66,7 @@               (HTTP.mkStatus 303 "See Other")               [("Location", "http://example.com/result")]             else pure $ Right $ fakeResponseWith HTTP.status200 []-        followed = withFollowRedirects 5 svc+        followed = svc & withFollowRedirects 5     req <- HTTP.parseRequest "http://example.com/action"     let postReq = req { HTTP.method = "POST" }     _ <- runService followed postReq

@@ -13,6 +13,7 @@ import Network.HTTP.Tower.Client (HttpResponse) import Tower.Service import Tower.Error+import Data.Function ((&)) import Network.HTTP.Tower.Middleware.Logging  spec :: Spec@@ -21,7 +22,7 @@     logRef <- newIORef ([] :: [Text])     let logger msg = modifyIORef' logRef (msg :)         svc = Service $ \_ -> pure (Right fakeResponse)-        logged = withLogging logger svc+        logged = svc & withLogging logger     req <- HTTP.parseRequest "http://example.com/test"     _ <- runService logged req     logs <- readIORef logRef@@ -34,7 +35,7 @@     let logger msg = modifyIORef' logRef (msg :)         svc :: Service HTTP.Request HttpResponse         svc = Service $ \_ -> pure (Left TimeoutError)-        logged = withLogging logger svc+        logged = svc & withLogging logger     req <- HTTP.parseRequest "http://example.com/fail"     _ <- runService logged req     logs <- readIORef logRef@@ -45,7 +46,7 @@   it "does not alter the result" $ do     let logger _ = pure ()         svc = Service $ \_ -> pure (Right fakeResponse)-        logged = withLogging logger svc+        logged = svc & withLogging logger     req <- HTTP.parseRequest "http://example.com/passthrough"     result <- runService logged req     case result of

@@ -8,6 +8,7 @@  import Network.HTTP.Tower.Client (HttpResponse) import Tower.Service+import Data.Function ((&)) import Network.HTTP.Tower.Middleware.RequestId import Network.HTTP.Tower.Middleware.TestDouble (withRecorder) @@ -15,7 +16,7 @@ spec = describe "RequestId middleware" $ do   it "adds X-Request-ID header" $ do     recorder <- newIORef []-    let svc = withRequestId (withRecorder recorder (Service $ \_ -> pure (Right fakeResponse)))+    let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder & withRequestId     req <- HTTP.parseRequest "http://example.com"     _ <- runService svc req     recorded <- readIORef recorder@@ -24,7 +25,7 @@    it "generates unique IDs per request" $ do     recorder <- newIORef []-    let svc = withRequestId (withRecorder recorder (Service $ \_ -> pure (Right fakeResponse)))+    let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder & withRequestId     req <- HTTP.parseRequest "http://example.com"     _ <- runService svc req     _ <- runService svc req@@ -35,7 +36,7 @@    it "uses custom header name" $ do     recorder <- newIORef []-    let svc = withRequestIdHeader "X-Correlation-ID" (withRecorder recorder (Service $ \_ -> pure (Right fakeResponse)))+    let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder & withRequestIdHeader "X-Correlation-ID"     req <- HTTP.parseRequest "http://example.com"     _ <- runService svc req     recorded <- readIORef recorder

@@ -8,6 +8,7 @@  import Network.HTTP.Tower.Client (HttpResponse) import Tower.Service+import Data.Function ((&)) import Network.HTTP.Tower.Middleware.SetHeader import Network.HTTP.Tower.Middleware.TestDouble (withRecorder) @@ -15,7 +16,7 @@ spec = describe "SetHeader middleware" $ do   it "adds a single header to requests" $ do     recorder <- newIORef []-    let svc = withHeader "X-Custom" "value" (withRecorder recorder (Service $ \_ -> pure (Right fakeResponse)))+    let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder & withHeader "X-Custom" "value"     req <- HTTP.parseRequest "http://example.com"     _ <- runService svc req     recorded <- readIORef recorder@@ -24,7 +25,7 @@    it "adds multiple headers" $ do     recorder <- newIORef []-    let svc = withHeaders [("X-A", "1"), ("X-B", "2")] (withRecorder recorder (Service $ \_ -> pure (Right fakeResponse)))+    let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder & withHeaders [("X-A", "1"), ("X-B", "2")]     req <- HTTP.parseRequest "http://example.com"     _ <- runService svc req     recorded <- readIORef recorder@@ -34,7 +35,7 @@    it "adds Bearer auth header" $ do     recorder <- newIORef []-    let svc = withBearerAuth "my-token" (withRecorder recorder (Service $ \_ -> pure (Right fakeResponse)))+    let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder & withBearerAuth "my-token"     req <- HTTP.parseRequest "http://example.com"     _ <- runService svc req     recorded <- readIORef recorder@@ -43,7 +44,7 @@    it "sets User-Agent header" $ do     recorder <- newIORef []-    let svc = withUserAgent "http-tower/0.1" (withRecorder recorder (Service $ \_ -> pure (Right fakeResponse)))+    let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder & withUserAgent "http-tower/0.1"     req <- HTTP.parseRequest "http://example.com"     _ <- runService svc req     recorded <- readIORef recorder

@@ -13,6 +13,7 @@ import Network.HTTP.Tower.Client (HttpResponse) import Tower.Service import Tower.Error+import Data.Function ((&)) import Network.HTTP.Tower.Middleware.TestDouble  spec :: Spec@@ -23,7 +24,7 @@       let inner = Service $ \_ -> do             writeIORef innerCalled True             pure (Right fakeResponse)-          mocked = withMock (\_ -> pure (Right fakeResponse)) inner+          mocked = inner & withMock (\_ -> pure (Right fakeResponse))       req <- HTTP.parseRequest "http://example.com"       result <- runService mocked req       case result of@@ -32,7 +33,7 @@       readIORef innerCalled >>= (`shouldBe` False)      it "can return errors" $ do-      let mocked = withMock (\_ -> pure (Left (CustomError "mock error"))) (Service $ \_ -> pure (Right fakeResponse))+      let mocked = Service (\_ -> pure (Right fakeResponse)) & withMock (\_ -> pure (Left (CustomError "mock error")))       req <- HTTP.parseRequest "http://example.com"       result <- runService mocked req       case result of@@ -44,7 +45,7 @@       let mocks = Map.fromList             [ ("example.com/api/users", Right fakeResponse)             ]-          mocked = withMockMap mocks (Service $ \_ -> pure (Left (CustomError "not mocked")))+          mocked = Service (\_ -> pure (Left (CustomError "not mocked"))) & withMockMap mocks       req <- HTTP.parseRequest "http://example.com/api/users"       result <- runService mocked req       case result of@@ -55,7 +56,7 @@       let mocks = Map.fromList             [ ("example.com/api/users", Right fakeResponse)             ]-          mocked = withMockMap mocks (Service $ \_ -> pure (Right fakeResponse))+          mocked = Service (\_ -> pure (Right fakeResponse)) & withMockMap mocks       req <- HTTP.parseRequest "http://example.com/api/other"       result <- runService mocked req       case result of@@ -65,7 +66,7 @@   describe "withRecorder" $ do     it "records all requests" $ do       recorder <- newIORef []-      let svc = withRecorder recorder (Service $ \_ -> pure (Right fakeResponse))+      let svc = Service (\_ -> pure (Right fakeResponse)) & withRecorder recorder       req1 <- HTTP.parseRequest "http://example.com/a"       req2 <- HTTP.parseRequest "http://example.com/b"       _ <- runService svc req1@@ -79,7 +80,7 @@       let inner = Service $ \_ -> do             modifyIORef' innerCalled (+ 1)             pure (Right fakeResponse)-          svc = withRecorder recorder inner+          svc = inner & withRecorder recorder       req <- HTTP.parseRequest "http://example.com"       _ <- runService svc req       readIORef innerCalled >>= (`shouldBe` 1)

@@ -21,6 +21,7 @@ import Tower.Service import Tower.Error import Tower.Error.Testing ()+import Data.Function ((&)) import Network.HTTP.Tower.Middleware.Tracing  spec :: Spec@@ -30,7 +31,7 @@    it "passes successful responses through unchanged" $ do     let svc = Service $ \_ -> pure (Right fakeResponse)-        traced = withTracing svc+        traced = svc & withTracing     req <- HTTP.parseRequest "http://example.com/test"     result <- runService traced req     case result of@@ -40,7 +41,7 @@   it "passes errors through unchanged" $ do     let svc :: Service HTTP.Request HttpResponse         svc = Service $ \_ -> pure (Left TimeoutError)-        traced = withTracing svc+        traced = svc & withTracing     req <- HTTP.parseRequest "http://example.com/fail"     result <- runService traced req     case result of@@ -52,7 +53,7 @@     let svc = Service $ \_ -> do           modifyIORef' callCount (+ 1)           pure (Right fakeResponse)-        traced = withTracing svc+        traced = svc & withTracing     req <- HTTP.parseRequest "http://example.com/once"     _ <- runService traced req     readIORef callCount >>= (`shouldBe` 1)@@ -68,7 +69,7 @@             })           (TracerOptions Nothing)         svc = Service $ \_ -> pure (Right fakeResponse)-        traced = withTracingTracer tracer svc+        traced = svc & withTracingTracer tracer     req <- HTTP.parseRequest "https://api.example.com/v1/data"     result <- runService traced req     case result of@@ -77,17 +78,17 @@    it "handles 4xx responses without altering the result" $ do     let svc = Service $ \_ -> pure (Right fake404Response)-        traced = withTracing svc+        traced = svc & withTracing     req <- HTTP.parseRequest "http://example.com/notfound"     result <- runService traced req     case result of       Right resp -> HTTP.responseStatus resp `shouldBe` HTTP.notFound404       Left err   -> expectationFailure $ "Expected Right, got: " ++ show err -  it "composes with the |> operator" $ do-    -- withTracing is now a pure Middleware, so it works directly with |>+  it "composes with the (&) operator" $ do+    -- withTracing is now a pure Middleware, so it works directly with (&)     let svc = Service $ \_ -> pure (Right fakeResponse)-        traced = withTracing svc+        traced = svc & withTracing     req <- HTTP.parseRequest "http://example.com/pipe"     result <- runService traced req     case result of

@@ -12,6 +12,7 @@ import Tower.Service import Tower.Error import Tower.Error.Testing ()+import Data.Function ((&)) import Network.HTTP.Tower.Middleware.Validate  spec :: Spec@@ -19,7 +20,7 @@   describe "withValidateStatus" $ do     it "passes valid status codes" $ do       let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.status200 []))-          validated = withValidateStatus (\c -> c >= 200 && c < 300) svc+          validated = svc & withValidateStatus (\c -> c >= 200 && c < 300)       req <- HTTP.parseRequest "http://example.com"       result <- runService validated req       case result of@@ -28,7 +29,7 @@      it "rejects invalid status codes" $ do       let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.internalServerError500 []))-          validated = withValidateStatus (\c -> c >= 200 && c < 300) svc+          validated = svc & withValidateStatus (\c -> c >= 200 && c < 300)       req <- HTTP.parseRequest "http://example.com"       result <- runService validated req       case result of@@ -39,7 +40,7 @@     it "passes matching content type" $ do       let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.status200               [("Content-Type", "application/json; charset=utf-8")]))-          validated = withValidateContentType "application/json" svc+          validated = svc & withValidateContentType "application/json"       req <- HTTP.parseRequest "http://example.com"       result <- runService validated req       case result of@@ -49,7 +50,7 @@     it "rejects non-matching content type" $ do       let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.status200               [("Content-Type", "text/html")]))-          validated = withValidateContentType "application/json" svc+          validated = svc & withValidateContentType "application/json"       req <- HTTP.parseRequest "http://example.com"       result <- runService validated req       case result of@@ -58,7 +59,7 @@      it "rejects missing content type" $ do       let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.status200 []))-          validated = withValidateContentType "application/json" svc+          validated = svc & withValidateContentType "application/json"       req <- HTTP.parseRequest "http://example.com"       result <- runService validated req       case result of@@ -69,7 +70,7 @@     it "passes when header is present" $ do       let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.status200               [("X-Request-ID", "abc")]))-          validated = withValidateHeader "X-Request-ID" svc+          validated = svc & withValidateHeader "X-Request-ID"       req <- HTTP.parseRequest "http://example.com"       result <- runService validated req       case result of@@ -78,7 +79,7 @@      it "rejects when header is missing" $ do       let svc = Service $ \_ -> pure (Right (fakeResponseWith HTTP.status200 []))-          validated = withValidateHeader "X-Request-ID" svc+          validated = svc & withValidateHeader "X-Request-ID"       req <- HTTP.parseRequest "http://example.com"       result <- runService validated req       case result of