http-tower-hs 0.1.0.0 → 0.2.0.0

raw patch · 35 files changed

+166/−1287 lines, 35 filesdep +tower-hsPVP ok

version bump matches the API change (PVP)

Dependencies added: tower-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−2
• README.md +6/−242
• http-tower-hs.cabal +14/−27
• src/Network/HTTP/Tower.hs +14/−15
• src/Network/HTTP/Tower/Client.hs +3/−3
• src/Network/HTTP/Tower/Core.hs +0/−55
• src/Network/HTTP/Tower/Error.hs +0/−40
• src/Network/HTTP/Tower/Middleware/CircuitBreaker.hs +0/−134
• src/Network/HTTP/Tower/Middleware/Filter.hs +0/−42
• src/Network/HTTP/Tower/Middleware/FollowRedirect.hs +2/−2
• src/Network/HTTP/Tower/Middleware/Hedge.hs +0/−39
• src/Network/HTTP/Tower/Middleware/Logging.hs +8/−14
• src/Network/HTTP/Tower/Middleware/RequestId.hs +4/−4
• src/Network/HTTP/Tower/Middleware/Retry.hs +0/−85
• src/Network/HTTP/Tower/Middleware/SetHeader.hs +6/−7
• src/Network/HTTP/Tower/Middleware/TestDouble.hs +6/−3
• src/Network/HTTP/Tower/Middleware/Timeout.hs +0/−29
• src/Network/HTTP/Tower/Middleware/Tracing.hs +23/−29
• src/Network/HTTP/Tower/Middleware/Validate.hs +17/−34
• test/Network/HTTP/Tower/ClientTLSSpec.hs +1/−1
• test/Network/HTTP/Tower/CoreSpec.hs +0/−54
• test/Network/HTTP/Tower/Middleware/CircuitBreakerSpec.hs +0/−146
• test/Network/HTTP/Tower/Middleware/FilterSpec.hs +0/−46
• test/Network/HTTP/Tower/Middleware/FollowRedirectSpec.hs +3/−6
• test/Network/HTTP/Tower/Middleware/HedgeSpec.hs +0/−57
• test/Network/HTTP/Tower/Middleware/LoggingSpec.hs +2/−2
• test/Network/HTTP/Tower/Middleware/RequestIdSpec.hs +1/−1
• test/Network/HTTP/Tower/Middleware/RetrySpec.hs +0/−91
• test/Network/HTTP/Tower/Middleware/SetHeaderSpec.hs +1/−1
• test/Network/HTTP/Tower/Middleware/TestDoubleSpec.hs +2/−2
• test/Network/HTTP/Tower/Middleware/TimeoutSpec.hs +0/−42
• test/Network/HTTP/Tower/Middleware/TracingDockerSpec.hs +24/−15
• test/Network/HTTP/Tower/Middleware/TracingIntegrationSpec.hs +2/−2
• test/Network/HTTP/Tower/Middleware/TracingSpec.hs +3/−9
• test/Network/HTTP/Tower/Middleware/ValidateSpec.hs +3/−6

@@ -1,5 +1,24 @@ # Changelog -## 0.1.0.0 — 2026-04-05+## 0.2.0.0 — 2026-04-06 -Initial release of http-tower-hs, a composable HTTP client middleware library for Haskell inspired by Tower (Rust).+### Breaking Changes++- Refactored into multi-package mono-repo structure+- Generic middleware moved to `tower-hs` package: Retry, Timeout, CircuitBreaker, Filter, Hedge+- Core types moved to `tower-hs` package: `Service`, `Middleware`, `ServiceError`+- Removed modules: `Network.HTTP.Tower.Core`, `Network.HTTP.Tower.Error`, `Network.HTTP.Tower.Middleware.Retry`, `Network.HTTP.Tower.Middleware.Timeout`, `Network.HTTP.Tower.Middleware.CircuitBreaker`, `Network.HTTP.Tower.Middleware.Filter`, `Network.HTTP.Tower.Middleware.Hedge`++### Migration Guide++- Add `tower-hs` as a dependency+- Replace `Network.HTTP.Tower.Core` imports with `Tower.Service`+- Replace `Network.HTTP.Tower.Error` imports with `Tower.Error`+- Replace `Network.HTTP.Tower.Middleware.Retry` with `Tower.Middleware.Retry` (and similarly for Timeout, CircuitBreaker, Filter, Hedge)++## 0.1.0.0 — 2026-04-06++- Initial release+- HTTP client with TLS/mTLS support+- Middleware: Logging, SetHeader, RequestId, FollowRedirect, Validate, Tracing (OpenTelemetry with HTTP semantic conventions), TestDouble (withMockMap)+- `Network.HTTP.Tower` convenience re-export module

@@ -1,248 +1,12 @@ # http-tower-hs -Composable HTTP client middleware for Haskell, inspired by Rust's [Tower](https://docs.rs/tower/latest/tower/).--The Haskell ecosystem has solid HTTP clients (`http-client`, `http-client-tls`) but no middleware composition story. Every project ends up hand-rolling retry logic, timeout handling, and logging around raw HTTP calls. `http-tower-hs` fixes this with a simple `Service`/`Middleware` abstraction.--## Quick start--```haskell-import Network.HTTP.Tower-import qualified Network.HTTP.Client as HTTP--main :: IO ()-main = do-  client <- newClient-  let configured = client-        |> withBearerAuth "my-api-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-  case result of-    Left err   -> putStrLn $ "Failed: " <> show err-    Right resp -> putStrLn $ "OK: " <> show (HTTP.responseStatus resp)-```--## Core concepts--### Service--A function from request to `IO (Either ServiceError response)`:--```haskell-newtype Service req res = Service { runService :: req -> IO (Either ServiceError res) }-```--### Middleware--A function that wraps a service to add behavior:--```haskell-type Middleware req res = Service req res -> Service req res-```--### Client--An HTTP client with a middleware stack, built using the `(|>)` operator:--```haskell-client <- newClient-let configured = client-      |> withRetry (exponentialBackoff 5 0.5 2.0)-      |> withTimeout 3000-```--### TLS / mTLS--`newClient` uses HTTPS by default. For custom CA certificates or client certificate authentication (mTLS):--```haskell--- Custom CA (e.g., internal PKI)-client <- newClientWithTLS (Just "certs/ca.pem") Nothing---- mTLS (client certificate authentication)-client <- newClientWithTLS-  (Just "certs/ca.pem")-  (Just ("certs/client.pem", "certs/client-key.pem"))---- System CA store, no client cert (same as newClient)-client <- newClientWithTLS Nothing Nothing-```--For full control, use `newClientWith` with custom `ManagerSettings`.--## Middleware--### Retry--Retries failed requests with configurable backoff:--```haskell--- Constant: 3 retries, 1 second between each-client |> withRetry (constantBackoff 3 1.0)---- Exponential: 5 retries, starting at 500ms, doubling each time-client |> withRetry (exponentialBackoff 5 0.5 2.0)-```--### Timeout--Fails with `TimeoutError` if the request exceeds the given milliseconds:--```haskell-client |> withTimeout 5000-```--### Logging--Logs method, host, status, and duration:--```haskell-client |> withLogging (\msg -> Data.Text.IO.putStrLn msg)-```--### Circuit Breaker--Three-state circuit breaker (Closed → Open → HalfOpen) using STM:--```haskell-breaker <- newCircuitBreaker-let configured = client-      |> withCircuitBreaker (CircuitBreakerConfig 5 30) breaker-```--Trips open after 5 consecutive failures, rejects immediately for 30 seconds, then probes recovery with one request.--### OpenTelemetry Tracing--Wraps each request in an OTel span with [stable HTTP semantic conventions](https://opentelemetry.io/docs/specs/semconv/http/http-spans/):--```haskell--- Uses global TracerProvider (no-ops if unconfigured)-client |> withTracing---- Or with a specific tracer-client |> withTracingTracer myTracer-```--Attributes: `http.request.method`, `server.address`, `server.port`, `url.full`, `http.response.status_code`, `error.type`.--### Set Header--Add headers to every request:--```haskell-client |> withBearerAuth "my-token"-client |> withUserAgent "my-app/1.0"-client |> withHeader "X-Custom" "value"-client |> withHeaders [("X-A", "1"), ("X-B", "2")]-```--### Request ID--Generate a UUID v4 correlation ID per request:--```haskell-client |> withRequestId                        -- X-Request-ID header-client |> withRequestIdHeader "X-Correlation-ID"  -- custom header name-```--### Follow Redirects--Automatically follow 3xx responses (301, 302, 303, 307, 308):--```haskell-client |> withFollowRedirects 5  -- max 5 hops-```--Respects 303 → GET method change per HTTP spec.--### Filter--Predicate-based request control:--```haskell--- Only allow GET requests-client |> withFilter (\req -> HTTP.method req == "GET")---- Don't retry 4xx responses (place between retry and base service)-client |> withNoRetryOn (\resp -> statusCode (responseStatus resp) < 500)-```--### Hedge--Speculative retry — if the primary request is slow, fire a second and return whichever finishes first:--```haskell-client |> withHedge 200  -- hedge after 200ms-```--Only use for idempotent requests (GET, etc.).--### Response Validation--Reject unexpected responses:--```haskell--- Only accept 2xx-client |> withValidateStatus (\c -> c >= 200 && c < 300)---- Require JSON-client |> withValidateContentType "application/json"---- Require a specific header-client |> withValidateHeader "X-Request-ID"-```--### Test Doubles--Testing utilities — mock services, record requests:--```haskell--- Replace the service entirely-let testClient = client |> withMock (\req -> pure (Right fakeResponse))---- Route-based mocks-let mocks = Map.fromList-      [ ("api.example.com/v1/users", Right usersResponse)-      , ("api.example.com/v1/health", Right healthResponse)-      ]-let testClient = client |> withMockMap mocks---- Record requests for assertions-recorder <- newIORef []-let testClient = client |> withRecorder recorder-_ <- runRequest testClient someRequest-recorded <- readIORef recorder-length recorded `shouldBe` 1-```--## Error handling--All errors are returned as `Either ServiceError Response` — no exceptions escape the middleware stack:--```haskell-data ServiceError-  = HttpError SomeException-  | TimeoutError-  | RetryExhausted Int ServiceError-  | CircuitBreakerOpen-  | CustomError Text-```+Composable HTTP client middleware for Haskell, built on [tower-hs](https://hackage.haskell.org/package/tower-hs). -## Building+Provides HTTP-specific middleware: headers, request IDs, redirect following, response validation, OpenTelemetry tracing with HTTP semantic conventions, and logging. -```bash-stack build-stack test-hlint src/ test/-```+Part of the [tower-hs](https://github.com/jarlah/tower-hs) mono-repo. See the repo README for full documentation and examples. -## License+## Related packages -MIT+- [tower-hs](https://hackage.haskell.org/package/tower-hs) — Generic service middleware core+- [servant-tower-hs](https://hackage.haskell.org/package/servant-tower-hs) — Servant client middleware built on tower-hs

@@ -1,18 +1,18 @@-cabal-version: 1.12+cabal-version: 1.18  -- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           http-tower-hs-version:        0.1.0.0-synopsis:       Composable HTTP client middleware for Haskell, inspired by Rust's Tower-description:    http-tower-hs provides a composable middleware abstraction for HTTP clients.-                Build middleware stacks with retry, timeout, logging, and more — all with-                pure error handling via Either (no exceptions).+version:        0.2.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+                following, OpenTelemetry tracing, response validation, and more. category:       Network-homepage:       https://github.com/jarlah/http-tower-hs#readme-bug-reports:    https://github.com/jarlah/http-tower-hs/issues+homepage:       https://github.com/jarlah/tower-hs#readme+bug-reports:    https://github.com/jarlah/tower-hs/issues author:         Jarl André Hübenthal maintainer:     jarlah@protonmail.com copyright:      2026 Jarl André Hübenthal@@ -21,39 +21,31 @@ build-type:     Simple tested-with:     GHC == 9.6.6, GHC == 9.8.4, GHC == 9.10.1-extra-source-files:+extra-doc-files:     README.md     CHANGELOG.md  source-repository head   type: git-  location: https://github.com/jarlah/http-tower-hs+  location: https://github.com/jarlah/tower-hs  library   exposed-modules:       Network.HTTP.Tower-      Network.HTTP.Tower.Core-      Network.HTTP.Tower.Error       Network.HTTP.Tower.Client-      Network.HTTP.Tower.Middleware.Retry-      Network.HTTP.Tower.Middleware.Timeout       Network.HTTP.Tower.Middleware.Logging-      Network.HTTP.Tower.Middleware.CircuitBreaker-      Network.HTTP.Tower.Middleware.Tracing       Network.HTTP.Tower.Middleware.SetHeader       Network.HTTP.Tower.Middleware.RequestId       Network.HTTP.Tower.Middleware.FollowRedirect-      Network.HTTP.Tower.Middleware.Filter-      Network.HTTP.Tower.Middleware.Hedge       Network.HTTP.Tower.Middleware.Validate+      Network.HTTP.Tower.Middleware.Tracing       Network.HTTP.Tower.Middleware.TestDouble   other-modules:       Paths_http_tower_hs   hs-source-dirs:       src   build-depends:-      async ==2.2.*-    , base >=4.14 && <5+      base >=4.14 && <5     , bytestring >=0.11 && <0.13     , containers >=0.6 && <0.8     , crypton-connection ==0.4.*@@ -64,10 +56,10 @@     , http-client-tls ==0.3.*     , http-types ==0.12.*     , safe-exceptions ==0.1.*-    , stm ==2.5.*     , text >=2.0 && <2.2     , time >=1.11 && <1.15     , tls >=2.0 && <2.2+    , tower-hs >=0.1.0.0 && <0.2     , unordered-containers ==0.2.*     , uuid ==1.3.*   default-language: Haskell2010@@ -77,17 +69,11 @@   main-is: Spec.hs   other-modules:       Network.HTTP.Tower.ClientTLSSpec-      Network.HTTP.Tower.CoreSpec-      Network.HTTP.Tower.Middleware.CircuitBreakerSpec-      Network.HTTP.Tower.Middleware.FilterSpec       Network.HTTP.Tower.Middleware.FollowRedirectSpec-      Network.HTTP.Tower.Middleware.HedgeSpec       Network.HTTP.Tower.Middleware.LoggingSpec       Network.HTTP.Tower.Middleware.RequestIdSpec-      Network.HTTP.Tower.Middleware.RetrySpec       Network.HTTP.Tower.Middleware.SetHeaderSpec       Network.HTTP.Tower.Middleware.TestDoubleSpec-      Network.HTTP.Tower.Middleware.TimeoutSpec       Network.HTTP.Tower.Middleware.TracingDockerSpec       Network.HTTP.Tower.Middleware.TracingIntegrationSpec       Network.HTTP.Tower.Middleware.TracingSpec@@ -122,6 +108,7 @@     , testcontainers ==0.5.*     , text >=2.0 && <2.2     , time >=1.11 && <1.15+    , tower-hs     , unagi-chan ==0.4.*     , uuid ==1.3.*     , vector ==0.13.*

@@ -31,7 +31,7 @@ -- All errors are returned as @'Either' 'ServiceError' response@ — no exceptions -- escape the middleware stack. module Network.HTTP.Tower-  ( -- * Core types+  ( -- * Core types (re-exported from tower-hs)     Service(..)   , Middleware   , mapService@@ -45,21 +45,21 @@   , runRequest   , applyMiddleware   , (|>)-    -- * Errors+    -- * Errors (re-exported from tower-hs)   , ServiceError(..)   , displayError     -- * Middleware-    -- ** Retry+    -- ** Retry (re-exported from tower-hs)   , BackoffStrategy(..)   , constantBackoff   , exponentialBackoff   , withRetry-    -- ** Timeout+    -- ** Timeout (re-exported from tower-hs)   , withTimeout     -- ** Logging   , withLogging   , withLoggingCustom-    -- ** Circuit Breaker+    -- ** Circuit Breaker (re-exported from tower-hs)   , CircuitBreakerConfig(..)   , CircuitBreakerState(..)   , CircuitBreaker@@ -79,11 +79,10 @@   , withRequestIdHeader     -- ** Follow Redirects   , withFollowRedirects-    -- ** Filter+    -- ** Filter (re-exported from tower-hs)   , withFilter   , withNoRetryOn--    -- ** Hedge+    -- ** Hedge (re-exported from tower-hs)   , withHedge     -- ** Response Validation   , withValidateStatus@@ -95,18 +94,18 @@   , withRecorder   ) where -import Network.HTTP.Tower.Core+import Tower.Service+import Tower.Error+import Tower.Middleware.Retry+import Tower.Middleware.Timeout+import Tower.Middleware.CircuitBreaker+import Tower.Middleware.Filter+import Tower.Middleware.Hedge import Network.HTTP.Tower.Client-import Network.HTTP.Tower.Error-import Network.HTTP.Tower.Middleware.Retry-import Network.HTTP.Tower.Middleware.Timeout import Network.HTTP.Tower.Middleware.Logging-import Network.HTTP.Tower.Middleware.CircuitBreaker import Network.HTTP.Tower.Middleware.Tracing import Network.HTTP.Tower.Middleware.SetHeader import Network.HTTP.Tower.Middleware.RequestId import Network.HTTP.Tower.Middleware.FollowRedirect-import Network.HTTP.Tower.Middleware.Filter-import Network.HTTP.Tower.Middleware.Hedge import Network.HTTP.Tower.Middleware.Validate import Network.HTTP.Tower.Middleware.TestDouble

@@ -41,8 +41,8 @@ import qualified Network.TLS.Extra.Cipher as TLS.Cipher import qualified System.X509 as X509System -import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))+import Tower.Service (Service(..), Middleware)+import Tower.Error (ServiceError(..))  -- | Concrete response type used by the client (lazy bytestring body). type HttpResponse = HTTP.Response LBS.ByteString@@ -69,7 +69,7 @@   let baseService = Service $ \req -> do         result <- tryAny $ HTTP.httpLbs req mgr         pure $ case result of-          Left err   -> Left (HttpError err)+          Left err   -> Left (TransportError err)           Right resp -> Right resp   pure Client     { clientService = baseService

@@ -1,55 +0,0 @@--- |--- Module      : Network.HTTP.Tower.Core--- Description : Core Service and Middleware abstractions--- License     : MIT------ The fundamental building blocks for composable middleware stacks.--- A 'Service' is a function from request to @IO (Either ServiceError response)@,--- and 'Middleware' wraps a service to add behavior.-module Network.HTTP.Tower.Core-  ( Service(..)-  , Middleware-  , mapService-  , composeMiddleware-  ) where--import Network.HTTP.Tower.Error (ServiceError)---- | A service transforms a request into an effectful response.--- This is the fundamental building block — middleware wraps services.------ @--- let echoService = 'Service' $ \\req -> pure (Right req)--- result <- 'runService' echoService "hello"--- -- result == Right "hello"--- @-newtype Service req res = Service-  { runService :: req -> IO (Either ServiceError res)-    -- ^ Execute the service with a request, returning either an error or a response.-  }---- | Middleware wraps a service to add behavior (retry, timeout, logging, etc.)------ A middleware is simply a function from 'Service' to 'Service':------ @--- type Middleware req res = Service req res -> Service req res--- @-type Middleware req res = Service req res -> Service req res---- | Transform the response of a service, leaving errors unchanged.------ @--- let svc = 'Service' $ \\_ -> pure (Right 10)--- let doubled = 'mapService' (* 2) svc--- result <- 'runService' doubled ()--- -- result == Right 20--- @-mapService :: (a -> b) -> Service req a -> Service req b-mapService f (Service run) = Service $ \req -> fmap (fmap f) (run req)---- | Compose two middleware, applying the outer first, then the inner.------ @'composeMiddleware' outer inner = outer . inner@-composeMiddleware :: Middleware req res -> Middleware req res -> Middleware req res-composeMiddleware outer inner = outer . inner

@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Network.HTTP.Tower.Error--- Description : Error types for the middleware stack--- License     : MIT------ All middleware returns @Either 'ServiceError' response@ — no exceptions--- escape the middleware stack.-module Network.HTTP.Tower.Error-  ( ServiceError(..)-  , displayError-  ) where--import Control.Exception (SomeException)-import Data.Text (Text, pack)---- | Errors that can occur in a middleware stack.------ All middleware returns @Either ServiceError Response@ — no exceptions escape.-data ServiceError-  = HttpError SomeException-    -- ^ An HTTP-level exception (connection refused, DNS failure, etc.)-  | TimeoutError-    -- ^ The request exceeded the configured timeout.-  | RetryExhausted Int ServiceError-    -- ^ All retries failed. Contains the number of attempts and the last error.-  | CircuitBreakerOpen-    -- ^ The circuit breaker is open — requests are being rejected.-  | CustomError Text-    -- ^ A custom error from middleware (e.g., validation failure, too many redirects).-  deriving (Show)---- | Render a 'ServiceError' as human-readable 'Text'.-displayError :: ServiceError -> Text-displayError (HttpError e)          = pack $ "HTTP error: " <> show e-displayError TimeoutError           = "Request timed out"-displayError (RetryExhausted n err) = "Retry exhausted after " <> pack (show n) <> " attempts: " <> displayError err-displayError CircuitBreakerOpen     = "Circuit breaker is open"-displayError (CustomError t)        = t

@@ -1,134 +0,0 @@--- |--- Module      : Network.HTTP.Tower.Middleware.CircuitBreaker--- Description : Three-state circuit breaker using STM--- License     : MIT------ Prevents cascading failures by tracking consecutive errors and--- short-circuiting requests when a service is known to be down.------ @--- breaker <- 'newCircuitBreaker'--- let config = 'CircuitBreakerConfig' { 'cbFailureThreshold' = 5, 'cbCooldownPeriod' = 30 }--- let client' = client '|>' 'withCircuitBreaker' config breaker--- @------ == State machine------ * __Closed__ — normal operation. Failures are counted. Trips to Open---   after reaching the threshold.--- * __Open__ — all requests rejected with 'CircuitBreakerOpen'. After the---   cooldown period, transitions to HalfOpen.--- * __HalfOpen__ — one probe request is allowed through. Success resets to---   Closed; failure trips back to Open.-module Network.HTTP.Tower.Middleware.CircuitBreaker-  ( CircuitBreakerConfig(..)-  , CircuitBreakerState(..)-  , CircuitBreaker-  , newCircuitBreaker-  , withCircuitBreaker-  , getCircuitBreakerState-  ) where--import Control.Concurrent.STM-import Data.Time.Clock (UTCTime, NominalDiffTime, getCurrentTime, diffUTCTime)--import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))---- | Configuration for the circuit breaker.-data CircuitBreakerConfig = CircuitBreakerConfig-  { cbFailureThreshold :: !Int-    -- ^ Number of consecutive failures before the breaker trips open.-  , cbCooldownPeriod   :: !NominalDiffTime-    -- ^ How long to stay open before transitioning to half-open (in seconds).-  } deriving (Show, Eq)---- | Observable state of the circuit breaker.-data CircuitBreakerState-  = Closed      -- ^ Normal operation, requests flow through.-  | Open        -- ^ Tripped — all requests rejected immediately.-  | HalfOpen    -- ^ Testing — one request allowed through to probe recovery.-  deriving (Show, Eq)--data BreakerInternals = BreakerInternals-  { biState          :: !CircuitBreakerState-  , biFailureCount   :: !Int-  , biLastFailureAt  :: !(Maybe UTCTime)-  }---- | Opaque handle to a circuit breaker instance.--- Create with 'newCircuitBreaker', share across requests.-newtype CircuitBreaker = CircuitBreaker (TVar BreakerInternals)---- | Create a new circuit breaker in the 'Closed' state.-newCircuitBreaker :: IO CircuitBreaker-newCircuitBreaker = CircuitBreaker <$> newTVarIO BreakerInternals-  { biState         = Closed-  , biFailureCount  = 0-  , biLastFailureAt = Nothing-  }---- | Read the current state of the circuit breaker.-getCircuitBreakerState :: CircuitBreaker -> IO CircuitBreakerState-getCircuitBreakerState (CircuitBreaker var) = biState <$> readTVarIO var---- | Circuit breaker middleware.------ The 'CircuitBreaker' handle is shared across all requests — create it--- once and reuse it:------ @--- breaker <- 'newCircuitBreaker'--- let client' = client '|>' 'withCircuitBreaker' config breaker--- @-withCircuitBreaker :: CircuitBreakerConfig -> CircuitBreaker -> Middleware req res-withCircuitBreaker config (CircuitBreaker var) inner = Service $ \req -> do-  now <- getCurrentTime-  decision <- atomically $ do-    internals <- readTVar var-    case biState internals of-      Open ->-        case biLastFailureAt internals of-          Just lastFail-            | diffUTCTime now lastFail >= cbCooldownPeriod config -> do-                writeTVar var internals { biState = HalfOpen }-                pure AllowRequest-          _ -> pure RejectRequest-      HalfOpen -> pure AllowRequest-      Closed   -> pure AllowRequest--  case decision of-    RejectRequest -> pure (Left CircuitBreakerOpen)-    AllowRequest  -> do-      result <- runService inner req-      now' <- getCurrentTime-      atomically $ do-        internals <- readTVar var-        case result of-          Right _ -> writeTVar var BreakerInternals-            { biState         = Closed-            , biFailureCount  = 0-            , biLastFailureAt = Nothing-            }-          Left _ ->-            case biState internals of-              HalfOpen -> writeTVar var BreakerInternals-                { biState         = Open-                , biFailureCount  = cbFailureThreshold config-                , biLastFailureAt = Just now'-                }-              _ -> do-                let newCount = biFailureCount internals + 1-                if newCount >= cbFailureThreshold config-                  then writeTVar var BreakerInternals-                    { biState         = Open-                    , biFailureCount  = newCount-                    , biLastFailureAt = Just now'-                    }-                  else writeTVar var internals-                    { biFailureCount  = newCount-                    , biLastFailureAt = Just now'-                    }-      pure result--data Decision = AllowRequest | RejectRequest

@@ -1,42 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Network.HTTP.Tower.Middleware.Filter--- Description : Predicate-based request and response filtering--- License     : MIT------ @--- -- Only allow GET requests--- client '|>' 'withFilter' (\\req -> HTTP.method req == \"GET\")------ -- Don't retry 4xx responses--- client '|>' 'withNoRetryOn' (\\resp -> statusCode (responseStatus resp) < 500)--- @-module Network.HTTP.Tower.Middleware.Filter-  ( withFilter-  , withNoRetryOn-  ) where--import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))---- | Only pass requests through that match a predicate.--- Requests that don't match are rejected with @'CustomError' \"Request filtered out\"@.-withFilter :: (req -> Bool) -> Middleware req res-withFilter predicate inner = Service $ \req ->-  if predicate req-    then runService inner req-    else pure (Left (CustomError "Request filtered out"))---- | Don't retry responses that match a predicate.--- Pass-through middleware — place between retry and the base service.------ Responses matching the predicate are returned as-is (success), so--- the retry middleware above won't retry them.-withNoRetryOn :: (res -> Bool) -> Middleware req res-withNoRetryOn shouldNotRetry inner = Service $ \req -> do-  result <- runService inner req-  case result of-    Right resp-      | shouldNotRetry resp -> pure (Right resp)-    _ -> pure result

@@ -23,8 +23,8 @@ import qualified Network.HTTP.Types.Status as HTTP  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))+import Tower.Service (Service(..), Middleware)+import Tower.Error (ServiceError(..))  -- | Follow HTTP 3xx redirects up to a maximum number of hops. --

@@ -1,39 +0,0 @@-{-# LANGUAGE NumericUnderscores #-}---- |--- Module      : Network.HTTP.Tower.Middleware.Hedge--- Description : Speculative retry via async race--- License     : MIT------ If the primary request is slow, fire a second speculative request after--- a delay and return whichever finishes first.------ @--- client '|>' 'withHedge' 200  -- hedge after 200ms--- @------ __Only use for idempotent requests__ (GET, etc.) since the request may--- be sent twice.-module Network.HTTP.Tower.Middleware.Hedge-  ( withHedge-  ) where--import Control.Concurrent (threadDelay)-import Control.Concurrent.Async (race)--import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError)---- | Hedging middleware: if the primary request doesn't complete within--- @delayMs@ milliseconds, fire a second request and return whichever--- finishes first.-withHedge :: Int -> Middleware req res-withHedge delayMs inner = Service $ \req -> do-  let primary = runService inner req-      hedged = do-        threadDelay (delayMs * 1_000)-        runService inner req-  result <- race primary hedged-  pure $ case result of-    Left res  -> res-    Right res -> res

@@ -2,7 +2,7 @@  -- | -- Module      : Network.HTTP.Tower.Middleware.Logging--- Description : Request/response logging middleware+-- Description : HTTP request/response logging middleware -- License     : MIT -- -- Logs HTTP method, host, status code, and duration for each request.@@ -16,18 +16,18 @@   ) where  import Data.Text (Text, pack)-import Data.Time.Clock (getCurrentTime, diffUTCTime) import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Types.Status as HTTP +import qualified Tower.Middleware.Logging as Generic import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError, displayError)+import Tower.Service (Middleware)+import Tower.Error (ServiceError, displayError)  -- | Logging middleware using a simple @Text -> IO ()@ logger. -- Logs method, URL, status code, and duration for each request. withLogging :: (Text -> IO ()) -> Middleware HTTP.Request HttpResponse-withLogging = withLoggingCustom formatDefault+withLogging = Generic.withLogging httpFormatter  -- | Logging middleware with a custom formatter. --@@ -36,16 +36,10 @@   :: (HTTP.Request -> Either ServiceError HttpResponse -> Double -> Text)   -> (Text -> IO ())   -> Middleware HTTP.Request HttpResponse-withLoggingCustom formatter logger inner = Service $ \req -> do-  start <- getCurrentTime-  result <- runService inner req-  end <- getCurrentTime-  let durationSec = realToFrac (diffUTCTime end start) :: Double-  logger (formatter req result durationSec)-  pure result+withLoggingCustom = Generic.withLogging -formatDefault :: HTTP.Request -> Either ServiceError HttpResponse -> Double -> Text-formatDefault req result duration =+httpFormatter :: HTTP.Request -> Either ServiceError HttpResponse -> Double -> Text+httpFormatter req result duration =   let method = pack $ show (HTTP.method req)       url    = pack $ show (HTTP.host req) <> show (HTTP.path req)       status = case result of

@@ -23,7 +23,8 @@ import qualified Network.HTTP.Types.Header as HTTP  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core (Service(..), Middleware)+import Tower.Service (Middleware)+import Tower.Middleware.Transform (withMapRequest)  -- | Add a unique @X-Request-ID@ header with a UUID v4 to every request. withRequestId :: Middleware HTTP.Request HttpResponse@@ -31,8 +32,7 @@  -- | Add a unique request ID using a custom header name. withRequestIdHeader :: HTTP.HeaderName -> Middleware HTTP.Request HttpResponse-withRequestIdHeader headerName inner = Service $ \req -> do+withRequestIdHeader headerName = withMapRequest $ \req -> do   uuid <- nextRandom   let reqId = pack (toString uuid)-      req' = req { HTTP.requestHeaders = (headerName, reqId) : HTTP.requestHeaders req }-  runService inner req'+  pure req { HTTP.requestHeaders = (headerName, reqId) : HTTP.requestHeaders req }

@@ -1,85 +0,0 @@-{-# LANGUAGE NumericUnderscores #-}---- |--- Module      : Network.HTTP.Tower.Middleware.Retry--- Description : Retry middleware with configurable backoff--- License     : MIT------ Retries failed requests with constant or exponential backoff.------ @--- client '|>' 'withRetry' ('constantBackoff' 3 1.0)--- client '|>' 'withRetry' ('exponentialBackoff' 5 0.5 2.0)--- @-module Network.HTTP.Tower.Middleware.Retry-  ( BackoffStrategy(..)-  , constantBackoff-  , exponentialBackoff-  , withRetry-  , computeDelay-  ) where--import Control.Concurrent (threadDelay)-import Data.Time.Clock (NominalDiffTime)--import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))---- | Strategy for computing delay between retries.-data BackoffStrategy-  = ConstantBackoff-      { backoffMaxRetries :: !Int-        -- ^ Maximum number of retries.-      , backoffDelay      :: !NominalDiffTime-        -- ^ Fixed delay between retries.-      }-  | ExponentialBackoff-      { backoffMaxRetries :: !Int-        -- ^ Maximum number of retries.-      , backoffBaseDelay  :: !NominalDiffTime-        -- ^ Initial delay before first retry.-      , backoffMultiplier :: !Double-        -- ^ Multiplier applied to delay after each attempt.-      }-  deriving (Show, Eq)---- | Constant backoff: same delay between every retry.------ @'constantBackoff' 3 1.0@ — retry up to 3 times, 1 second apart.-constantBackoff :: Int -> NominalDiffTime -> BackoffStrategy-constantBackoff = ConstantBackoff---- | Exponential backoff: delay grows by multiplier each attempt.------ @'exponentialBackoff' 5 0.5 2.0@ — retry up to 5 times, starting at 500ms, doubling each time.-exponentialBackoff :: Int -> NominalDiffTime -> Double -> BackoffStrategy-exponentialBackoff = ExponentialBackoff---- | Compute the delay for a given attempt number (0-indexed).-computeDelay :: BackoffStrategy -> Int -> NominalDiffTime-computeDelay (ConstantBackoff _ d) _ = d-computeDelay (ExponentialBackoff _ base mult) attempt =-  base * realToFrac (mult ^^ attempt)---- | Retry middleware: retries failed requests according to the backoff strategy.------ On failure, waits for the computed delay, then retries. After all retries--- are exhausted, returns 'RetryExhausted' with the attempt count and last error.-withRetry :: BackoffStrategy -> Middleware req res-withRetry strategy inner = Service $ \req ->-  go req 0-  where-    maxRetries = backoffMaxRetries strategy--    go req attempt = do-      result <- runService inner req-      case result of-        Right resp -> pure (Right resp)-        Left err-          | attempt >= maxRetries ->-              pure (Left (RetryExhausted attempt err))-          | otherwise -> do-              let delaySeconds = computeDelay strategy attempt-                  delayMicros = round (delaySeconds * 1_000_000) :: Int-              threadDelay delayMicros-              go req (attempt + 1)

@@ -22,19 +22,18 @@ import qualified Network.HTTP.Types.Header as HTTP  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core (Service(..), Middleware)+import Tower.Service (Middleware)+import Tower.Middleware.Transform (withMapRequestPure)  -- | Add a single header to every request. withHeader :: HTTP.HeaderName -> ByteString -> Middleware HTTP.Request HttpResponse-withHeader name value inner = Service $ \req ->-  let req' = req { HTTP.requestHeaders = (name, value) : HTTP.requestHeaders req }-  in runService inner req'+withHeader name value = withMapRequestPure $ \req ->+  req { HTTP.requestHeaders = (name, value) : HTTP.requestHeaders req }  -- | Add multiple headers to every request. withHeaders :: [HTTP.Header] -> Middleware HTTP.Request HttpResponse-withHeaders hdrs inner = Service $ \req ->-  let req' = req { HTTP.requestHeaders = hdrs ++ HTTP.requestHeaders req }-  in runService inner req'+withHeaders hdrs = withMapRequestPure $ \req ->+  req { HTTP.requestHeaders = hdrs ++ HTTP.requestHeaders req }  -- | Add a @Authorization: Bearer \<token\>@ header. withBearerAuth :: ByteString -> Middleware HTTP.Request HttpResponse

@@ -1,12 +1,15 @@ -- | -- Module      : Network.HTTP.Tower.Middleware.TestDouble--- Description : Mock services and request recording for testing+-- Description : HTTP-specific mock services and request recording for testing -- License     : MIT -- -- @ -- -- Replace the service entirely -- let testClient = client '|>' 'withMock' (\\req -> pure (Right fakeResponse)) --+-- -- Route-based mocks+-- let testClient = client '|>' 'withMockMap' mocks+-- -- -- Record requests for assertions -- recorder <- newIORef [] -- let testClient = client '|>' 'withRecorder' recorder@@ -24,8 +27,8 @@ import qualified Network.HTTP.Client as HTTP  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))+import Tower.Service (Service(..), Middleware)+import Tower.Error (ServiceError(..))  -- | Replace the inner service entirely with a mock function. -- The inner service is never called.

@@ -1,29 +0,0 @@--- |--- Module      : Network.HTTP.Tower.Middleware.Timeout--- Description : Timeout middleware--- License     : MIT------ Fails with 'TimeoutError' if the inner service doesn't respond within--- the specified number of milliseconds.------ @--- client '|>' 'withTimeout' 5000  -- 5 second timeout--- @-module Network.HTTP.Tower.Middleware.Timeout-  ( withTimeout-  ) where--import qualified System.Timeout as Sys--import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))---- | Timeout middleware: fails with 'TimeoutError' if the request takes--- longer than the specified number of milliseconds.-withTimeout :: Int -> Middleware req res-withTimeout ms inner = Service $ \req -> do-  let micros = ms * 1000-  result <- Sys.timeout micros (runService inner req)-  pure $ case result of-    Nothing        -> Left TimeoutError-    Just innerRes  -> innerRes

@@ -16,21 +16,21 @@   ( Tracer   , InstrumentationLibrary(..)   , TracerOptions(..)-  , SpanArguments(..)   , SpanKind(..)   , SpanStatus(..)   , makeTracer   , getGlobalTracerProvider-  , defaultSpanArguments   , addAttribute   , setStatus-  , inSpan'   )  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError, displayError)+import qualified Data.Version as V+import qualified Paths_http_tower_hs as Pkg +import Tower.Service (Service(..), Middleware)+import Tower.Middleware.Tracing (TracingConfig(..), defaultTracingConfig, withTracingConfig)+ -- | Tracing middleware using the global TracerProvider. -- Reads the global provider on each request (single IORef read, trivial cost). -- If no TracerProvider is configured, this is a no-op (zero overhead).@@ -53,35 +53,29 @@ -- * Attributes: @http.request.method@, @server.address@, @server.port@, --   @url.full@, @http.response.status_code@, @error.type@ withTracingTracer :: Tracer -> Middleware HTTP.Request HttpResponse-withTracingTracer tracer inner = Service $ \req -> do-  let spanName = decodeUtf8 (HTTP.method req)-      spanArgs = defaultSpanArguments { kind = Client }-  inSpan' tracer spanName spanArgs $ \s -> do-    -- Required attributes-    addAttribute s "http.request.method" (decodeUtf8 (HTTP.method req))-    addAttribute s "server.address" (decodeUtf8 (HTTP.host req))-    addAttribute s "server.port" (HTTP.port req)-    addAttribute s "url.full" (buildUrl req)--    result <- runService inner req+withTracingTracer tracer = withTracingConfig tracer httpTracingConfig -    case result of-      Right resp -> do-        let code = HTTP.statusCode (HTTP.responseStatus resp)-        addAttribute s "http.response.status_code" code-        when (code >= 400) $ do-          addAttribute s "error.type" (pack (show code))-          setStatus s (Error "HTTP error status")-        pure (Right resp)-      Left err -> do-        addAttribute s "error.type" (displayError err)-        setStatus s (Error (displayError err))-        pure (Left err)+httpTracingConfig :: TracingConfig HTTP.Request HttpResponse+httpTracingConfig = (defaultTracingConfig "")+  { tracingSpanName = decodeUtf8 . HTTP.method+  , tracingSpanKind = Client+  , tracingReqAttrs = \req s -> do+      addAttribute s "http.request.method" (decodeUtf8 (HTTP.method req))+      addAttribute s "server.address" (decodeUtf8 (HTTP.host req))+      addAttribute s "server.port" (HTTP.port req)+      addAttribute s "url.full" (buildUrl req)+  , tracingResAttrs = \resp s -> do+      let code = HTTP.statusCode (HTTP.responseStatus resp)+      addAttribute s "http.response.status_code" code+      when (code >= 400) $ do+        addAttribute s "error.type" (pack (show code))+        setStatus s (Error "HTTP error status")+  }  instrumentationLibrary :: InstrumentationLibrary instrumentationLibrary = InstrumentationLibrary   { libraryName = "http-tower-hs"-  , libraryVersion = "0.1.0.0"+  , libraryVersion = pack (V.showVersion Pkg.version)   , librarySchemaUrl = ""   , libraryAttributes = emptyAttributes   }

@@ -2,7 +2,7 @@  -- | -- Module      : Network.HTTP.Tower.Middleware.Validate--- Description : Response validation middleware+-- Description : HTTP response validation middleware -- License     : MIT -- -- Reject responses that don't meet expectations:@@ -25,49 +25,32 @@ import qualified Network.HTTP.Types.Status as HTTP  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core (Service(..), Middleware)-import Network.HTTP.Tower.Error (ServiceError(..))+import Tower.Service (Middleware)+import Tower.Middleware.Validate (withValidate)  -- | Validate the response status code. Returns a 'CustomError' if the -- predicate returns 'False'.------ @--- -- Only accept 2xx--- client '|>' 'withValidateStatus' (\\c -> c >= 200 && c < 300)--- @ withValidateStatus :: (Int -> Bool) -> Middleware HTTP.Request HttpResponse-withValidateStatus isValid inner = Service $ \req -> do-  result <- runService inner req-  case result of-    Right resp ->-      let code = HTTP.statusCode (HTTP.responseStatus resp)-      in if isValid code-          then pure (Right resp)-          else pure (Left (CustomError ("Unexpected status code: " <> pack (show code))))-    Left err -> pure (Left err)+withValidateStatus isValid = withValidate $ \resp ->+  let code = HTTP.statusCode (HTTP.responseStatus resp)+  in if isValid code+      then Nothing+      else Just ("Unexpected status code: " <> pack (show code))  -- | Validate that a specific response header is present. withValidateHeader :: HTTP.HeaderName -> Middleware HTTP.Request HttpResponse-withValidateHeader headerName inner = Service $ \req -> do-  result <- runService inner req-  case result of-    Right resp ->-      case lookup headerName (HTTP.responseHeaders resp) of-        Just _  -> pure (Right resp)-        Nothing -> pure (Left (CustomError ("Missing required header: " <> pack (show headerName))))-    Left err -> pure (Left err)+withValidateHeader headerName = withValidate $ \resp ->+  case lookup headerName (HTTP.responseHeaders resp) of+    Just _  -> Nothing+    Nothing -> Just ("Missing required header: " <> pack (show headerName))  -- | Validate the @Content-Type@ header contains the expected value. -- -- Uses substring matching, so @\"application\/json\"@ matches -- @\"application\/json; charset=utf-8\"@. withValidateContentType :: ByteString -> Middleware HTTP.Request HttpResponse-withValidateContentType expected inner = Service $ \req -> do-  result <- runService inner req-  case result of-    Right resp ->-      case lookup "Content-Type" (HTTP.responseHeaders resp) of-        Just ct | expected `isInfixOf` ct -> pure (Right resp)-        Just ct -> pure (Left (CustomError ("Unexpected Content-Type: " <> pack (show ct))))-        Nothing -> pure (Left (CustomError "Missing Content-Type header"))-    Left err -> pure (Left err)+withValidateContentType expected = withValidate $ \resp ->+  case lookup "Content-Type" (HTTP.responseHeaders resp) of+    Just ct | expected `isInfixOf` ct -> Nothing+    Just ct -> Just ("Unexpected Content-Type: " <> pack (show ct))+    Nothing -> Just "Missing Content-Type header"

@@ -16,7 +16,7 @@ import TestContainers.Hspec (withContainers)  import Network.HTTP.Tower.Client (newClientWithTLS, runRequest)-import Network.HTTP.Tower.Error (ServiceError(..))+import Tower.Error (ServiceError(..))  -- | Generate test certificates: CA, server cert, client cert. generateCerts :: FilePath -> IO ()

@@ -1,54 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.HTTP.Tower.CoreSpec (spec) where--import Test.Hspec--import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error--spec :: Spec-spec = describe "Core" $ do-  describe "Service" $ do-    it "runs a simple service" $ do-      let svc = Service $ \n -> pure (Right (n * 2 :: Int))-      result <- runService svc 21-      result `shouldBe` Right 42--    it "returns errors in Left" $ do-      let svc :: Service () String-          svc = Service $ \_ -> pure (Left (CustomError "boom"))-      result <- runService svc ()-      result `shouldBe` Left (CustomError "boom")--  describe "mapService" $ do-    it "transforms successful responses" $ do-      let svc :: Service () Int-          svc = Service $ \_ -> pure (Right 10)-          mapped = mapService (* 3) svc-      result <- runService mapped ()-      result `shouldBe` Right 30--    it "passes through errors unchanged" $ do-      let svc :: Service () Int-          svc = Service $ \_ -> pure (Left TimeoutError)-          mapped = mapService (* 3) svc-      result <- runService mapped ()-      result `shouldBe` Left TimeoutError--  describe "composeMiddleware" $ do-    it "applies outer then inner" $ do-      let addTag tag (Service run) = Service $ \req ->-            run (req ++ tag)-          mw1 = addTag "[1]"-          mw2 = addTag "[2]"-          composed = composeMiddleware mw1 mw2-          svc = Service $ \req -> pure (Right req)-      result <- runService (composed svc) "start"-      result `shouldBe` Right "start[1][2]"--instance Eq ServiceError where-  CustomError a      == CustomError b      = a == b-  TimeoutError       == TimeoutError       = True-  RetryExhausted n _ == RetryExhausted m _ = n == m-  _                  == _                  = False

@@ -1,146 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NumericUnderscores #-}--module Network.HTTP.Tower.Middleware.CircuitBreakerSpec (spec) where--import Control.Concurrent (threadDelay)-import Data.IORef-import Test.Hspec--import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error-import Network.HTTP.Tower.Middleware.CircuitBreaker--spec :: Spec-spec = describe "Circuit Breaker middleware" $ do-  let config = CircuitBreakerConfig-        { cbFailureThreshold = 3-        , cbCooldownPeriod   = 1  -- 1 second-        }--  describe "Closed state" $ do-    it "passes requests through when healthy" $ do-      breaker <- newCircuitBreaker-      let svc :: Service () String-          svc = Service $ \_ -> pure (Right "ok")-          wrapped = withCircuitBreaker config breaker svc-      result <- runService wrapped ()-      result `shouldBe` Right "ok"-      getCircuitBreakerState breaker >>= (`shouldBe` Closed)--    it "stays closed on fewer failures than threshold" $ do-      breaker <- newCircuitBreaker-      callCount <- newIORef (0 :: Int)-      let svc :: Service () String-          svc = Service $ \_ -> do-            modifyIORef' callCount (+ 1)-            pure (Left (CustomError "fail"))-          wrapped = withCircuitBreaker config breaker svc-      -- 2 failures, threshold is 3-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      getCircuitBreakerState breaker >>= (`shouldBe` Closed)-      readIORef callCount >>= (`shouldBe` 2)--  describe "Tripping open" $ do-    it "trips open after reaching failure threshold" $ do-      breaker <- newCircuitBreaker-      let svc :: Service () String-          svc = Service $ \_ -> pure (Left (CustomError "fail"))-          wrapped = withCircuitBreaker config breaker svc-      -- 3 failures = threshold-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      getCircuitBreakerState breaker >>= (`shouldBe` Open)--    it "rejects requests immediately when open" $ do-      breaker <- newCircuitBreaker-      callCount <- newIORef (0 :: Int)-      let failSvc :: Service () String-          failSvc = Service $ \_ -> do-            modifyIORef' callCount (+ 1)-            pure (Left (CustomError "fail"))-          wrapped = withCircuitBreaker config breaker failSvc-      -- Trip the breaker-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      -- Next request should be rejected without calling the service-      countBefore <- readIORef callCount-      result <- runService wrapped ()-      countAfter <- readIORef callCount-      result `shouldBe` Left CircuitBreakerOpen-      countAfter `shouldBe` countBefore  -- service was NOT called--  describe "Half-open state" $ do-    it "transitions to half-open after cooldown" $ do-      let fastConfig = config { cbCooldownPeriod = 0.1 }  -- 100ms cooldown-      breaker <- newCircuitBreaker-      let svc :: Service () String-          svc = Service $ \_ -> pure (Left (CustomError "fail"))-          wrapped = withCircuitBreaker fastConfig breaker svc-      -- Trip the breaker-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      getCircuitBreakerState breaker >>= (`shouldBe` Open)-      -- Wait for cooldown-      threadDelay 150_000  -- 150ms-      -- Next request should go through (half-open allows one probe)-      _ <- runService wrapped ()-      -- It failed again, so back to Open-      getCircuitBreakerState breaker >>= (`shouldBe` Open)--    it "resets to closed on success in half-open" $ do-      let fastConfig = config { cbCooldownPeriod = 0.1 }-      breaker <- newCircuitBreaker-      callCount <- newIORef (0 :: Int)-      let svc :: Service () String-          svc = Service $ \_ -> do-            n <- readIORef callCount-            modifyIORef' callCount (+ 1)-            if n < 3-              then pure (Left (CustomError "fail"))-              else pure (Right "recovered")-          wrapped = withCircuitBreaker fastConfig breaker svc-      -- Trip the breaker (3 failures)-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      _ <- runService wrapped ()-      getCircuitBreakerState breaker >>= (`shouldBe` Open)-      -- Wait for cooldown-      threadDelay 150_000-      -- Next request succeeds — should reset to Closed-      result <- runService wrapped ()-      result `shouldBe` Right "recovered"-      getCircuitBreakerState breaker >>= (`shouldBe` Closed)--  describe "Reset on success" $ do-    it "resets failure count on any success" $ do-      breaker <- newCircuitBreaker-      callCount <- newIORef (0 :: Int)-      let svc :: Service () String-          svc = Service $ \_ -> do-            n <- readIORef callCount-            modifyIORef' callCount (+ 1)-            if n == 1  -- second call succeeds-              then pure (Right "ok")-              else pure (Left (CustomError "fail"))-          wrapped = withCircuitBreaker config breaker svc-      -- Fail once-      _ <- runService wrapped ()-      -- Succeed — resets counter-      _ <- runService wrapped ()-      getCircuitBreakerState breaker >>= (`shouldBe` Closed)-      -- Now need 3 MORE failures to trip (not 2)-      _ <- runService wrapped ()  -- fail-      _ <- runService wrapped ()  -- fail-      getCircuitBreakerState breaker >>= (`shouldBe` Closed)--instance Eq ServiceError where-  CustomError a      == CustomError b      = a == b-  TimeoutError       == TimeoutError       = True-  CircuitBreakerOpen == CircuitBreakerOpen  = True-  RetryExhausted n _ == RetryExhausted m _ = n == m-  _                  == _                  = False

@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.HTTP.Tower.Middleware.FilterSpec (spec) where--import qualified Network.HTTP.Client as HTTP-import Test.Hspec--import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error-import Network.HTTP.Tower.Middleware.Filter--spec :: Spec-spec = describe "Filter middleware" $ do-  describe "withFilter" $ do-    it "allows matching requests through" $ do-      let svc :: Service HTTP.Request String-          svc = Service $ \_ -> pure (Right "ok")-          filtered = withFilter (const True) svc-      req <- HTTP.parseRequest "http://example.com"-      result <- runService filtered req-      result `shouldBe` Right "ok"--    it "rejects non-matching requests" $ do-      let svc :: Service HTTP.Request String-          svc = Service $ \_ -> pure (Right "ok")-          filtered = withFilter (const False) svc-      req <- HTTP.parseRequest "http://example.com"-      result <- runService filtered req-      result `shouldBe` Left (CustomError "Request filtered out")--    it "filters based on request properties" $ do-      let svc :: Service HTTP.Request String-          svc = Service $ \_ -> pure (Right "ok")-          onlyGet = withFilter (\r -> HTTP.method r == "GET") svc-      getReq <- HTTP.parseRequest "http://example.com"-      postReq <- HTTP.parseRequest "http://example.com"-      let postReq' = postReq { HTTP.method = "POST" }-      getResult <- runService onlyGet getReq-      postResult <- runService onlyGet postReq'-      getResult `shouldBe` Right "ok"-      postResult `shouldBe` Left (CustomError "Request filtered out")--instance Eq ServiceError where-  CustomError a == CustomError b = a == b-  _ == _ = False

@@ -10,8 +10,9 @@ import Test.Hspec  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error+import Tower.Service+import Tower.Error+import Tower.Error.Testing () import Network.HTTP.Tower.Middleware.FollowRedirect  spec :: Spec@@ -83,7 +84,3 @@   , HTTP.responseOriginalRequest = error "not used"   , HTTP.responseEarlyHints = []   }--instance Eq ServiceError where-  CustomError a == CustomError b = a == b-  _ == _ = False

@@ -1,57 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NumericUnderscores #-}--module Network.HTTP.Tower.Middleware.HedgeSpec (spec) where--import Control.Concurrent (threadDelay)-import Data.IORef-import Test.Hspec--import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error-import Network.HTTP.Tower.Middleware.Hedge--spec :: Spec-spec = describe "Hedge middleware" $ do-  it "returns result from fast primary without hedging" $ do-    let svc :: Service () String-        svc = Service $ \_ -> pure (Right "fast")-        hedged = withHedge 1000 svc-    result <- runService hedged ()-    result `shouldBe` Right "fast"--  it "returns a result when primary is slow (hedge may win)" $ do-    callCount <- newIORef (0 :: Int)-    let svc :: Service () String-        svc = Service $ \_ -> do-          n <- atomicModifyIORef' callCount (\c -> (c + 1, c))-          if n == 0-            then do-              threadDelay 500_000  -- primary: slow-              pure (Right "primary")-            else pure (Right "hedge")  -- hedge: instant-        hedged = withHedge 50 svc-    result <- runService hedged ()-    case result of-      Right _ -> pure ()-      Left err -> expectationFailure $ "Expected Right, got: " ++ show err--  it "calls service at most twice" $ do-    callCount <- newIORef (0 :: Int)-    let svc :: Service () String-        svc = Service $ \_ -> do-          modifyIORef' callCount (+ 1)-          threadDelay 100_000-          pure (Right "done")-        hedged = withHedge 50 svc-    _ <- runService hedged ()-    threadDelay 200_000-    count <- readIORef callCount-    count `shouldSatisfy` (<= 2)--instance Eq ServiceError where-  CustomError a      == CustomError b      = a == b-  TimeoutError       == TimeoutError       = True-  CircuitBreakerOpen == CircuitBreakerOpen  = True-  RetryExhausted n _ == RetryExhausted m _ = n == m-  _                  == _                  = False

@@ -11,8 +11,8 @@ import Test.Hspec  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error+import Tower.Service+import Tower.Error import Network.HTTP.Tower.Middleware.Logging  spec :: Spec

@@ -7,7 +7,7 @@ import Test.Hspec  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core+import Tower.Service import Network.HTTP.Tower.Middleware.RequestId import Network.HTTP.Tower.Middleware.TestDouble (withRecorder) 

@@ -1,91 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.HTTP.Tower.Middleware.RetrySpec (spec) where--import Data.IORef-import Data.Time.Clock (NominalDiffTime)-import Test.Hspec-import Test.QuickCheck--import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error-import Network.HTTP.Tower.Middleware.Retry--spec :: Spec-spec = describe "Retry middleware" $ do-  describe "withRetry" $ do-    it "returns success immediately without retrying" $ do-      callCount <- newIORef (0 :: Int)-      let svc :: Service () String-          svc = Service $ \_ -> do-            modifyIORef' callCount (+ 1)-            pure (Right "ok")-          retried = withRetry (constantBackoff 3 0) svc-      result <- runService retried ()-      result `shouldBe` Right "ok"-      readIORef callCount >>= (`shouldBe` 1)--    it "retries on failure up to max retries" $ do-      callCount <- newIORef (0 :: Int)-      let svc :: Service () String-          svc = Service $ \_ -> do-            modifyIORef' callCount (+ 1)-            pure (Left (CustomError "fail"))-          retried = withRetry (constantBackoff 3 0) svc-      result <- runService retried ()-      case result of-        Left (RetryExhausted n _) -> n `shouldBe` 3-        other -> expectationFailure $ "Expected RetryExhausted, got: " ++ show other-      readIORef callCount >>= (`shouldBe` 4)  -- 1 initial + 3 retries--    it "succeeds after transient failures" $ do-      callCount <- newIORef (0 :: Int)-      let svc :: Service () String-          svc = Service $ \_ -> do-            n <- readIORef callCount-            modifyIORef' callCount (+ 1)-            if n < 2-              then pure (Left (CustomError "transient"))-              else pure (Right "recovered")-          retried = withRetry (constantBackoff 3 0) svc-      result <- runService retried ()-      result `shouldBe` Right "recovered"-      readIORef callCount >>= (`shouldBe` 3)  -- 2 failures + 1 success--    it "retries zero times when maxRetries is 0" $ do-      callCount <- newIORef (0 :: Int)-      let svc :: Service () String-          svc = Service $ \_ -> do-            modifyIORef' callCount (+ 1)-            pure (Left (CustomError "fail"))-          retried = withRetry (constantBackoff 0 0) svc-      result <- runService retried ()-      case result of-        Left (RetryExhausted 0 _) -> pure ()-        other -> expectationFailure $ "Expected RetryExhausted 0, got: " ++ show other-      readIORef callCount >>= (`shouldBe` 1)--  describe "computeDelay" $ do-    it "constant backoff returns same delay regardless of attempt" $ do-      let strategy = constantBackoff 3 2.0-      computeDelay strategy 0 `shouldBe` 2.0-      computeDelay strategy 1 `shouldBe` 2.0-      computeDelay strategy 5 `shouldBe` 2.0--    it "exponential backoff grows by multiplier" $ do-      let strategy = exponentialBackoff 5 1.0 2.0-      computeDelay strategy 0 `shouldBe` 1.0-      computeDelay strategy 1 `shouldBe` 2.0-      computeDelay strategy 2 `shouldBe` 4.0-      computeDelay strategy 3 `shouldBe` 8.0--    it "exponential delay is always positive" $ property $-      \(Positive base) (Positive mult) (NonNegative attempt) ->-        let strategy = exponentialBackoff 10 (realToFrac (base :: Double)) (mult :: Double)-        in computeDelay strategy (attempt :: Int) >= (0 :: NominalDiffTime)--instance Eq ServiceError where-  CustomError a      == CustomError b      = a == b-  TimeoutError       == TimeoutError       = True-  RetryExhausted n _ == RetryExhausted m _ = n == m-  _                  == _                  = False

@@ -7,7 +7,7 @@ import Test.Hspec  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core+import Tower.Service import Network.HTTP.Tower.Middleware.SetHeader import Network.HTTP.Tower.Middleware.TestDouble (withRecorder) 

@@ -11,8 +11,8 @@ import Test.Hspec  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error+import Tower.Service+import Tower.Error import Network.HTTP.Tower.Middleware.TestDouble  spec :: Spec

@@ -1,42 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NumericUnderscores #-}--module Network.HTTP.Tower.Middleware.TimeoutSpec (spec) where--import Control.Concurrent (threadDelay)-import Test.Hspec--import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error-import Network.HTTP.Tower.Middleware.Timeout--spec :: Spec-spec = describe "Timeout middleware" $ do-  it "allows fast requests through" $ do-    let svc :: Service () String-        svc = Service $ \_ -> pure (Right "fast")-        timed = withTimeout 1000 svc-    result <- runService timed ()-    result `shouldBe` Right "fast"--  it "times out slow requests" $ do-    let svc :: Service () String-        svc = Service $ \_ -> do-          threadDelay 500_000  -- 500ms-          pure (Right "slow")-        timed = withTimeout 100 svc  -- 100ms timeout-    result <- runService timed ()-    result `shouldBe` Left TimeoutError--  it "preserves errors from inner service" $ do-    let svc :: Service () String-        svc = Service $ \_ -> pure (Left (CustomError "inner error"))-        timed = withTimeout 1000 svc-    result <- runService timed ()-    result `shouldBe` Left (CustomError "inner error")--instance Eq ServiceError where-  CustomError a      == CustomError b      = a == b-  TimeoutError       == TimeoutError       = True-  RetryExhausted n _ == RetryExhausted m _ = n == m-  _                  == _                  = False

@@ -8,6 +8,7 @@ import Control.Exception (try, SomeException) import Data.Aeson (Value(..), (.:), decode, withObject) import Data.Aeson.Types (parseMaybe)+import Data.Maybe (fromMaybe) import qualified Data.ByteString.Lazy as LBS import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP@@ -31,7 +32,7 @@ import OpenTelemetry.Trace (initializeGlobalTracerProvider)  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core+import Tower.Service import Network.HTTP.Tower.Middleware.Tracing  -- | Jaeger container setup via testcontainers.@@ -64,6 +65,25 @@   resp <- HTTP.httpLbs req mgr   pure (decode (HTTP.responseBody resp)) +-- | Poll Jaeger until traces appear or max attempts exhausted.+-- Returns the number of traces found.+pollJaegerTraces :: HTTP.Manager -> Int -> String -> Int -> IO Int+pollJaegerTraces mgr port service maxAttempts = go 0+  where+    go attempt+      | attempt >= maxAttempts = pure 0+      | otherwise = do+          threadDelay 2_000_000  -- 2 seconds between polls+          result <- queryJaegerTraces mgr port service+          let count = case result of+                Nothing -> 0+                Just val -> fromMaybe 0 $ parseMaybe (withObject "resp" $ \o -> do+                    arr <- o .: "data"+                    pure (V.length (arr :: V.Vector Value))) val+          if count > 0+            then pure count+            else go (attempt + 1)+ spec :: Spec spec = describe "Tracing Docker integration (Jaeger via testcontainers)" $ beforeAll dockerAvailable $ do @@ -102,21 +122,10 @@         unsetEnv "OTEL_EXPORTER_OTLP_PROTOCOL"         unsetEnv "OTEL_SERVICE_NAME" -        -- Give Jaeger time to index-        threadDelay 3_000_000--        -- Query Jaeger for our traces+        -- Poll Jaeger until traces appear (up to 10 attempts, 2s apart = 20s max)         mgr <- HTTP.newManager TLS.tlsManagerSettings-        result <- queryJaegerTraces mgr jaegerPort "http-tower-hs-tc-test"-        case result of-          Nothing -> expectationFailure "Failed to parse Jaeger API response"-          Just val -> do-            let traceCount = parseMaybe (withObject "resp" $ \o -> do-                    arr <- o .: "data"-                    pure (V.length (arr :: V.Vector Value))) val-            case traceCount of-              Just n  -> n `shouldSatisfy` (>= 1)-              Nothing -> expectationFailure $ "Unexpected Jaeger response: " ++ show val+        traceCount <- pollJaegerTraces mgr jaegerPort "http-tower-hs-tc-test" 10+        traceCount `shouldSatisfy` (>= 1)  fakeResponse :: HttpResponse fakeResponse = HTTP.Response

@@ -29,8 +29,8 @@ import OpenTelemetry.Exporter.InMemory (inMemoryListExporter)  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error+import Tower.Service+import Tower.Error import Network.HTTP.Tower.Middleware.Tracing  withTestTracer :: (Tracer -> IORef [ImmutableSpan] -> IO a) -> IO a

@@ -18,8 +18,9 @@ import OpenTelemetry.Attributes (emptyAttributes)  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error+import Tower.Service+import Tower.Error+import Tower.Error.Testing () import Network.HTTP.Tower.Middleware.Tracing  spec :: Spec@@ -109,10 +110,3 @@ fake404Response = fakeResponse   { HTTP.responseStatus = HTTP.notFound404   }--instance Eq ServiceError where-  CustomError a      == CustomError b      = a == b-  TimeoutError       == TimeoutError       = True-  CircuitBreakerOpen == CircuitBreakerOpen  = True-  RetryExhausted n _ == RetryExhausted m _ = n == m-  _                  == _                  = False

@@ -9,8 +9,9 @@ import Test.Hspec  import Network.HTTP.Tower.Client (HttpResponse)-import Network.HTTP.Tower.Core-import Network.HTTP.Tower.Error+import Tower.Service+import Tower.Error+import Tower.Error.Testing () import Network.HTTP.Tower.Middleware.Validate  spec :: Spec@@ -95,7 +96,3 @@   , HTTP.responseOriginalRequest = error "not used"   , HTTP.responseEarlyHints = []   }--instance Eq ServiceError where-  CustomError a == CustomError b = a == b-  _ == _ = False