packages feed

spire (empty) → 0.1.0.0

raw patch · 8 files changed

+839/−0 lines, 8 filesdep +basedep +hedgehogdep +spire

Dependencies added: base, hedgehog, spire

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Revision history for spire++## 0.1.0.0 -- 2026-04-27++* Initial release. Backend-agnostic Service abstraction for spire and+  acolyte: a single Service type that any HTTP, gRPC, or WebSocket+  adapter can run.
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2024-2026, Josh Burgess++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from this+   software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ spire.cabal view
@@ -0,0 +1,72 @@+cabal-version:   3.0+name:            spire+version:         0.1.0.0+synopsis:        Composable service and middleware abstractions for Haskell+category:        Control+description:+  A standalone, framework-agnostic library providing composable+  Service and Layer abstractions. The Haskell equivalent of Rust's+  tower crate.+  .+  This library is useful on its own; any Haskell project can use it+  for composable middleware without depending on any web framework.++license:         BSD-3-Clause+license-file:    LICENSE+author:          Josh Burgess+maintainer:      Josh Burgess <joshburgess.webdev@gmail.com>+homepage:        https://github.com/joshburgess/acolyte+bug-reports:     https://github.com/joshburgess/acolyte/issues+build-type:      Simple++extra-doc-files:+  CHANGELOG.md++library+  exposed-modules:+    Spire+    Spire.Service+    Spire.Layer++  build-depends:+    base >= 4.20 && < 5++  hs-source-dirs: src+  default-language: GHC2024+  default-extensions:+    StrictData++  ghc-options: -Wall -funbox-strict-fields++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  default-language: GHC2024+  default-extensions:+    StrictData++  ghc-options: -Wall -rtsopts "-with-rtsopts=-K1K"++  build-depends:+    base >= 4.20 && < 5,+    spire++test-suite properties+  type: exitcode-stdio-1.0+  main-is: Properties.hs+  hs-source-dirs: test+  default-language: GHC2024+  default-extensions:+    StrictData++  ghc-options: -Wall++  build-depends:+    base >= 4.20 && < 5,+    spire,+    hedgehog >= 1.4 && < 1.8++source-repository head+  type:     git+  location: https://github.com/joshburgess/acolyte.git
+ src/Spire.hs view
@@ -0,0 +1,58 @@+-- | @spire@ — composable service and middleware abstractions.+--+-- A standalone, framework-agnostic library. Use this for composable+-- middleware in any Haskell project — web servers, gRPC, message+-- queues, or anything else that processes requests.+--+-- @+-- import Spire+--+-- -- Define a service+-- echo :: Service IO String String+-- echo = Service pure+--+-- -- Define middleware+-- logging :: Middleware IO String String+-- logging = before $ \req -> putStrLn (">> " ++ req)+--+-- -- Compose+-- main :: IO ()+-- main = do+--   let svc = echo |> logging+--   result <- runService svc "hello"+--   putStrLn result+-- @+module Spire+  ( -- * Service+    Service (..)+  , mapRequest+  , mapResponse+  , mapResponseM+  , contramapRequest+  , dimap+  , hoistService++    -- * Layer+  , Layer (..)+  , Middleware++    -- * Construction+  , middleware++    -- * Application+  , applyLayer+  , (|>)+  , (<|)++    -- * Composition+  , composeLayer+  , identity++    -- * Combinators+  , before+  , after+  , around+  ) where++import Spire.Service+import Spire.Layer
+ src/Spire/Layer.hs view
@@ -0,0 +1,186 @@+-- | Layers and Middleware for composing services.+--+-- A 'Layer' wraps an inner service to produce an outer service.+-- It is a middleware factory — it carries configuration and produces+-- a transformed service when applied.+--+-- A 'Middleware' is a Layer that does not change the request/response+-- types. Most HTTP middleware (CORS, tracing, timeouts) is this kind.+--+-- @+-- -- A logging middleware+-- logging :: Middleware IO Request Response+-- logging = middleware $ \inner -> Service $ \req -> do+--   putStrLn $ "Request: " ++ show req+--   resp <- runService inner req+--   putStrLn $ "Response: " ++ show resp+--   pure resp+--+-- -- Apply it+-- myService' = applyLayer logging myService+-- @+module Spire.Layer+  ( -- * Layer type+    Layer (..)+    -- * Middleware (same req/resp)+  , Middleware+    -- * Construction+  , middleware+    -- * Application+  , applyLayer+  , (|>)+  , (<|)+    -- * Composition+  , composeLayer+  , identity+    -- * Combinators+  , before+  , after+  , around+  ) where++import Spire.Service (Service (..))+++-- | A layer wraps an inner service to produce an outer service.+--+-- Layers are middleware factories. The type parameters are:+--+-- * @m@ — the monad+-- * @reqI, respI@ — the inner service's request/response types+-- * @reqO, respO@ — the outer (wrapped) service's request/response types+--+-- Most layers don't change types (see 'Middleware'). Layers that DO+-- change types include request/response body transformers, protocol+-- adapters, etc.+newtype Layer m reqI respI reqO respO = Layer+  { runLayer :: Service m reqI respI -> Service m reqO respO+  }+++-- | A middleware does not change request/response types.+--+-- This is the common case: CORS, logging, auth, compression all+-- take a @Service m req resp@ and produce a @Service m req resp@.+type Middleware m req resp = Layer m req resp req resp+++-- | Construct a middleware from a service transformer.+--+-- @+-- logging :: Middleware IO String String+-- logging = middleware $ \inner -> Service $ \req -> do+--   putStrLn $ ">> " ++ req+--   resp <- runService inner req+--   putStrLn $ "<< " ++ resp+--   pure resp+-- @+middleware :: (Service m req resp -> Service m req resp) -> Middleware m req resp+middleware = Layer+{-# INLINABLE middleware #-}+++-- | Apply a layer to a service, producing a new service.+--+-- @+-- myService' = applyLayer loggingLayer myService+-- @+applyLayer :: Layer m reqI respI reqO respO -> Service m reqI respI -> Service m reqO respO+applyLayer (Layer f) = f+{-# INLINABLE applyLayer #-}+++-- | Apply a layer to a service (operator form, left-to-right).+--+-- Read as "service piped through layer":+--+-- @+-- myService |> logging |> cors |> timeout+-- @+--+-- Layers apply inside-out: @logging@ wraps @myService@, then @cors@+-- wraps that, then @timeout@ wraps the whole thing. The outermost+-- layer (timeout) sees the request first.+--+-- Wait — that's wrong. Let's be precise. @s |> l@ means @l@ wraps @s@.+-- So @myService |> logging |> cors@ means cors wraps (logging wraps myService).+-- The outermost layer (cors) sees the request first.+(|>) :: Service m reqI respI -> Layer m reqI respI reqO respO -> Service m reqO respO+(|>) svc layer = applyLayer layer svc+{-# INLINE (|>) #-}+infixl 1 |>+++-- | Apply a layer to a service (operator form, right-to-left).+--+-- @+-- timeout <| cors <| logging <| myService+-- @+(<|) :: Layer m reqI respI reqO respO -> Service m reqI respI -> Service m reqO respO+(<|) = applyLayer+{-# INLINE (<|) #-}+infixr 1 <|+++-- | Compose two layers. The result applies @inner@ first, then @outer@.+--+-- @+-- combined = composeLayer outer inner+-- -- equivalent to: \\svc -> outer (inner svc)+-- @+composeLayer+  :: Layer m req2 resp2 req3 resp3+  -> Layer m req1 resp1 req2 resp2+  -> Layer m req1 resp1 req3 resp3+composeLayer (Layer outer) (Layer inner) = Layer (outer . inner)+{-# INLINABLE composeLayer #-}+++-- | The identity layer — wraps a service without modification.+identity :: Layer m req resp req resp+identity = Layer id+{-# INLINABLE identity #-}+++-- | Run a callback before the service processes the request.+--+-- @+-- logRequest :: Middleware IO Request Response+-- logRequest = before $ \req -> putStrLn ("Request: " ++ show req)+-- @+before :: Monad m => (req -> m ()) -> Middleware m req resp+before hook = Layer $ \(Service inner) -> Service $ \req -> do+  hook req+  inner req+{-# INLINABLE before #-}+++-- | Run a callback after the service produces the response.+--+-- @+-- logResponse :: Middleware IO Request Response+-- logResponse = after $ \req resp -> putStrLn ("Response: " ++ show resp)+-- @+after :: Monad m => (req -> resp -> m ()) -> Middleware m req resp+after hook = Layer $ \(Service inner) -> Service $ \req -> do+  resp <- inner req+  hook req resp+  pure resp+{-# INLINABLE after #-}+++-- | Run a callback that wraps the entire service call.+--+-- @+-- timing :: Middleware IO Request Response+-- timing = around $ \req callInner -> do+--   t0 <- getCurrentTime+--   resp <- callInner req+--   t1 <- getCurrentTime+--   putStrLn $ "Took: " ++ show (diffUTCTime t1 t0)+--   pure resp+-- @+around :: (req -> (req -> m resp) -> m resp) -> Middleware m req resp+around wrapper = Layer $ \(Service inner) -> Service $ \req ->+  wrapper req inner+{-# INLINABLE around #-}
+ src/Spire/Service.hs view
@@ -0,0 +1,95 @@+-- | The core Service abstraction.+--+-- A 'Service' transforms requests into responses in some monad.+-- This is the fundamental building block — HTTP servers, gRPC handlers,+-- message queue consumers, and anything else that processes requests+-- can be expressed as a Service.+--+-- @+-- -- An echo service+-- echo :: Service IO String String+-- echo = Service pure+--+-- -- A service that looks up users+-- userService :: Service IO UserId (Maybe User)+-- userService = Service $ \uid -> lookupUser uid+-- @+module Spire.Service+  ( -- * Service type+    Service (..)+    -- * Combinators+  , mapRequest+  , mapResponse+  , mapResponseM+  , contramapRequest+  , dimap+  , hoistService+  ) where+++-- | A service transforms requests into responses in monad @m@.+--+-- This is a newtype over @req -> m resp@ — deliberately simple.+-- Composition happens via 'Spire.Layer.Layer', not via Service itself.+--+-- The monad parameter @m@ lets the same type work with 'IO',+-- @ReaderT Env IO@, or any monad — unlike Rust's tower which+-- hardcodes @Future@ as the effect type.+newtype Service m req resp = Service+  { runService :: req -> m resp+  }+++-- | Transform the response after the service produces it.+--+-- @+-- addHeader :: Service IO Request Response -> Service IO Request Response+-- addHeader = mapResponse (\resp -> resp { headers = ("X-Foo", "bar") : headers resp })+-- @+mapResponse :: Functor m => (resp -> resp') -> Service m req resp -> Service m req resp'+mapResponse f (Service g) = Service (fmap f . g)+{-# INLINABLE mapResponse #-}+++-- | Transform the response monadically.+mapResponseM :: Monad m => (resp -> m resp') -> Service m req resp -> Service m req resp'+mapResponseM f (Service g) = Service (\req -> g req >>= f)+{-# INLINABLE mapResponseM #-}+++-- | Transform the request before it reaches the service.+--+-- @+-- stripPrefix :: Service IO Request Response -> Service IO Request Response+-- stripPrefix = mapRequest (\req -> req { path = drop 1 (path req) })+-- @+mapRequest :: (req' -> req) -> Service m req resp -> Service m req' resp+mapRequest f (Service g) = Service (g . f)+{-# INLINABLE mapRequest #-}+++-- | Alias for 'mapRequest' (emphasizes the contravariant direction).+contramapRequest :: (req' -> req) -> Service m req resp -> Service m req' resp+contramapRequest = mapRequest+{-# INLINABLE contramapRequest #-}+++-- | Map over both request (contravariantly) and response (covariantly).+--+-- @+-- dimap reqTransform respTransform service+-- @+dimap :: Functor m => (req' -> req) -> (resp -> resp') -> Service m req resp -> Service m req' resp'+dimap f g (Service h) = Service (fmap g . h . f)+{-# INLINABLE dimap #-}+++-- | Change the monad a service runs in.+--+-- @+-- liftService :: Service IO req resp -> Service (ReaderT Env IO) req resp+-- liftService = hoistService liftIO+-- @+hoistService :: (forall a. m a -> n a) -> Service m req resp -> Service n req resp+hoistService nat (Service f) = Service (nat . f)+{-# INLINABLE hoistService #-}
+ test/Main.hs view
@@ -0,0 +1,286 @@+module Main (main) where++import Spire+import Data.IORef+++-- ===================================================================+-- Test helpers+-- ===================================================================++assert :: String -> Bool -> IO ()+assert label True  = putStrLn $ "  OK: " ++ label+assert label False = error   $ "FAIL: " ++ label+++-- ===================================================================+-- 1. Basic Service creation and execution+-- ===================================================================++testServiceBasic :: IO ()+testServiceBasic = do+  -- Pure echo+  let echo :: Service IO String String+      echo = Service pure+  result <- runService echo "hello"+  assert "echo service returns input" (result == "hello")++  -- Service with computation+  let double :: Service IO Int Int+      double = Service $ \n -> pure (n * 2)+  result2 <- runService double 21+  assert "double service computes" (result2 == 42)+++-- ===================================================================+-- 2. mapResponse+-- ===================================================================++testMapResponse :: IO ()+testMapResponse = do+  let svc :: Service IO Int Int+      svc = Service $ \n -> pure (n + 1)+      svc' = mapResponse (* 10) svc+  result <- runService svc' 5+  assert "mapResponse transforms output" (result == 60)  -- (5+1)*10+++-- ===================================================================+-- 3. mapRequest+-- ===================================================================++testMapRequest :: IO ()+testMapRequest = do+  let svc :: Service IO Int String+      svc = Service $ \n -> pure (show n)+      svc' = mapRequest length svc  -- String -> Int via length+  result <- runService svc' "hello"+  assert "mapRequest transforms input" (result == "5")+++-- ===================================================================+-- 4. dimap+-- ===================================================================++testDimap :: IO ()+testDimap = do+  let svc :: Service IO Int Int+      svc = Service $ \n -> pure (n * 2)+      svc' = dimap length show svc  -- String -> show(length*2)+  result <- runService svc' "hey"+  assert "dimap transforms both" (result == "6")  -- length "hey" = 3, *2 = 6+++-- ===================================================================+-- 5. Middleware via `middleware` constructor+-- ===================================================================++testMiddleware :: IO ()+testMiddleware = do+  ref <- newIORef ([] :: [String])+  let svc :: Service IO String String+      svc = Service $ \req -> do+        modifyIORef' ref (++ ["handler:" ++ req])+        pure ("resp:" ++ req)++      logging :: Middleware IO String String+      logging = middleware $ \inner -> Service $ \req -> do+        modifyIORef' ref (++ ["before"])+        resp <- runService inner req+        modifyIORef' ref (++ ["after"])+        pure resp++  let svc' = svc |> logging+  result <- runService svc' "test"+  log <- readIORef ref++  assert "middleware wraps service" (result == "resp:test")+  assert "middleware runs before/after" (log == ["before", "handler:test", "after"])+++-- ===================================================================+-- 6. before combinator+-- ===================================================================++testBefore :: IO ()+testBefore = do+  ref <- newIORef ([] :: [String])+  let svc :: Service IO String String+      svc = Service $ \req -> do+        modifyIORef' ref (++ ["handler"])+        pure req++      logBefore :: Middleware IO String String+      logBefore = before $ \req -> modifyIORef' ref (++ ["before:" ++ req])++  let svc' = svc |> logBefore+  _ <- runService svc' "x"+  log <- readIORef ref+  assert "before runs before handler" (log == ["before:x", "handler"])+++-- ===================================================================+-- 7. after combinator+-- ===================================================================++testAfter :: IO ()+testAfter = do+  ref <- newIORef ([] :: [String])+  let svc :: Service IO String String+      svc = Service $ \req -> do+        modifyIORef' ref (++ ["handler"])+        pure ("resp:" ++ req)++      logAfter :: Middleware IO String String+      logAfter = after $ \_ resp -> modifyIORef' ref (++ ["after:" ++ resp])++  let svc' = svc |> logAfter+  _ <- runService svc' "x"+  log <- readIORef ref+  assert "after runs after handler" (log == ["handler", "after:resp:x"])+++-- ===================================================================+-- 8. around combinator+-- ===================================================================++testAround :: IO ()+testAround = do+  ref <- newIORef ([] :: [String])+  let svc :: Service IO String String+      svc = Service $ \req -> do+        modifyIORef' ref (++ ["handler:" ++ req])+        pure req++      wrap :: Middleware IO String String+      wrap = around $ \req callInner -> do+        modifyIORef' ref (++ ["around:before"])+        resp <- callInner (req ++ "!")+        modifyIORef' ref (++ ["around:after"])+        pure (resp ++ "!!")++  let svc' = svc |> wrap+  result <- runService svc' "hi"+  log <- readIORef ref++  assert "around wraps call" (result == "hi!!!")+  assert "around sees modified request" (log == ["around:before", "handler:hi!", "around:after"])+++-- ===================================================================+-- 9. Layer composition with |>+-- ===================================================================++testPipeComposition :: IO ()+testPipeComposition = do+  ref <- newIORef ([] :: [String])+  let svc :: Service IO String String+      svc = Service $ \req -> do+        modifyIORef' ref (++ ["handler"])+        pure req++      layer1 :: Middleware IO String String+      layer1 = before $ \_ -> modifyIORef' ref (++ ["L1"])++      layer2 :: Middleware IO String String+      layer2 = before $ \_ -> modifyIORef' ref (++ ["L2"])++  -- svc |> layer1 |> layer2+  -- layer2 wraps (layer1 wraps svc)+  -- Request flow: layer2 -> layer1 -> handler+  let svc' = svc |> layer1 |> layer2+  _ <- runService svc' "x"+  log <- readIORef ref+  assert "|> applies layers inside-out" (log == ["L2", "L1", "handler"])+++-- ===================================================================+-- 10. composeLayer+-- ===================================================================++testComposeLayer :: IO ()+testComposeLayer = do+  ref <- newIORef ([] :: [String])+  let svc :: Service IO String String+      svc = Service $ \req -> do+        modifyIORef' ref (++ ["handler"])+        pure req++      layer1 :: Middleware IO String String+      layer1 = before $ \_ -> modifyIORef' ref (++ ["L1"])++      layer2 :: Middleware IO String String+      layer2 = before $ \_ -> modifyIORef' ref (++ ["L2"])++      -- composed applies layer1 first (inner), then layer2 (outer)+      composed = composeLayer layer2 layer1++  let svc' = svc |> composed+  _ <- runService svc' "x"+  log <- readIORef ref+  assert "composeLayer: outer wraps inner" (log == ["L2", "L1", "handler"])+++-- ===================================================================+-- 11. identity layer+-- ===================================================================++testIdentity :: IO ()+testIdentity = do+  let svc :: Service IO Int Int+      svc = Service $ \n -> pure (n + 1)+      svc' = svc |> identity+  result <- runService svc' 5+  assert "identity layer is no-op" (result == 6)+++-- ===================================================================+-- 12. <| operator (right-to-left)+-- ===================================================================++testRightToLeft :: IO ()+testRightToLeft = do+  ref <- newIORef ([] :: [String])+  let svc :: Service IO String String+      svc = Service $ \req -> do+        modifyIORef' ref (++ ["handler"])+        pure req++      layer1 :: Middleware IO String String+      layer1 = before $ \_ -> modifyIORef' ref (++ ["L1"])++  let svc' = layer1 <| svc+  _ <- runService svc' "x"+  log <- readIORef ref+  assert "<| applies layer" (log == ["L1", "handler"])+++-- ===================================================================+-- Main+-- ===================================================================++main :: IO ()+main = do+  putStrLn "Spire tests:"+  putStrLn ""+  putStrLn "Service basics:"+  testServiceBasic+  putStrLn ""+  putStrLn "Transformers:"+  testMapResponse+  testMapRequest+  testDimap+  putStrLn ""+  putStrLn "Middleware:"+  testMiddleware+  testBefore+  testAfter+  testAround+  putStrLn ""+  putStrLn "Composition:"+  testPipeComposition+  testComposeLayer+  testIdentity+  testRightToLeft+  putStrLn ""+  putStrLn "All spire tests passed."
+ test/Properties.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Spire+++-- | Identity layer does not change service behavior.+prop_identityLayer :: Property+prop_identityLayer = property $ do+  input <- forAll $ Gen.string (Range.linear 0 100) Gen.unicode+  let echo = Service pure :: Service IO String String+      wrapped = applyLayer identity echo+  result <- evalIO $ runService wrapped input+  expected <- evalIO $ runService echo input+  result === expected+++-- | mapResponse composes covariantly: mapResponse g . mapResponse f == mapResponse (g . f)+prop_mapResponseComposition :: Property+prop_mapResponseComposition = property $ do+  input <- forAll $ Gen.int (Range.linear (-1000) 1000)+  let svc = Service pure :: Service IO Int Int+      f = (+ 1)+      g = (* 2)+      composed = mapResponse g (mapResponse f svc)+      fused    = mapResponse (g . f) svc+  r1 <- evalIO $ runService composed input+  r2 <- evalIO $ runService fused input+  r1 === r2+++-- | mapRequest composes contravariantly: mapRequest f . mapRequest g == mapRequest (g . f)+prop_mapRequestContravariant :: Property+prop_mapRequestContravariant = property $ do+  input <- forAll $ Gen.int (Range.linear (-1000) 1000)+  let svc = Service pure :: Service IO Int Int+      f = (+ 1)+      g = (* 2)+      composed = mapRequest f (mapRequest g svc)+      fused    = mapRequest (g . f) svc+  r1 <- evalIO $ runService composed input+  r2 <- evalIO $ runService fused input+  r1 === r2+++-- | dimap fusion: dimap f g (dimap h k svc) == dimap (h . f) (g . k) svc+prop_dimapFusion :: Property+prop_dimapFusion = property $ do+  input <- forAll $ Gen.int (Range.linear (-1000) 1000)+  let svc = Service pure :: Service IO Int Int+      f = (+ 1)+      g = (* 2)+      h = (+ 3)+      k = (* 5)+      nested = dimap f g (dimap h k svc)+      fused  = dimap (h . f) (g . k) svc+  r1 <- evalIO $ runService nested input+  r2 <- evalIO $ runService fused input+  r1 === r2+++-- | Layer application order: (svc |> layer1) |> layer2 processes correctly.+-- Use 'before' layers that prepend to a list to verify ordering.+prop_layerApplicationOrder :: Property+prop_layerApplicationOrder = property $ do+  input <- forAll $ Gen.string (Range.linear 0 50) Gen.unicode+  let svc = Service (\req -> pure [req, "base"]) :: Service IO String [String]+      layer1 = middleware $ \(Service inner) -> Service $ \req -> do+        rs <- inner req+        pure ("layer1" : rs)+      layer2 = middleware $ \(Service inner) -> Service $ \req -> do+        rs <- inner req+        pure ("layer2" : rs)+      composed = (svc |> layer1) |> layer2+  result <- evalIO $ runService composed input+  -- layer2 wraps layer1 wraps svc, so layer2 prepends last (outermost)+  result === ["layer2", "layer1", input, "base"]+++-- | before does not change the service's response.+prop_beforeDoesNotChangeResponse :: Property+prop_beforeDoesNotChangeResponse = property $ do+  input <- forAll $ Gen.int (Range.linear (-1000) 1000)+  let svc = Service pure :: Service IO Int Int+      wrapped = applyLayer (before (\_ -> pure ())) svc+  r1 <- evalIO $ runService svc input+  r2 <- evalIO $ runService wrapped input+  r1 === r2+++-- | after does not change the service's response.+prop_afterDoesNotChangeResponse :: Property+prop_afterDoesNotChangeResponse = property $ do+  input <- forAll $ Gen.int (Range.linear (-1000) 1000)+  let svc = Service pure :: Service IO Int Int+      wrapped = applyLayer (after (\_ _ -> pure ())) svc+  r1 <- evalIO $ runService svc input+  r2 <- evalIO $ runService wrapped input+  r1 === r2+++main :: IO Bool+main = checkParallel $$(discover)