diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -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.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/spire.cabal b/spire.cabal
new file mode 100644
--- /dev/null
+++ b/spire.cabal
@@ -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
diff --git a/src/Spire.hs b/src/Spire.hs
new file mode 100644
--- /dev/null
+++ b/src/Spire.hs
@@ -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
diff --git a/src/Spire/Layer.hs b/src/Spire/Layer.hs
new file mode 100644
--- /dev/null
+++ b/src/Spire/Layer.hs
@@ -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 #-}
diff --git a/src/Spire/Service.hs b/src/Spire/Service.hs
new file mode 100644
--- /dev/null
+++ b/src/Spire/Service.hs
@@ -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 #-}
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -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."
diff --git a/test/Properties.hs b/test/Properties.hs
new file mode 100644
--- /dev/null
+++ b/test/Properties.hs
@@ -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)