packages feed

acolyte-test (empty) → 0.1.0.0

raw patch · 7 files changed

+947/−0 lines, 7 filesdep +QuickCheckdep +acolyte-coredep +acolyte-grpc

Dependencies added: QuickCheck, acolyte-core, acolyte-grpc, acolyte-openapi, acolyte-server, acolyte-test, aeson, base, bytestring, http-core, http-types, spire, spire-grpc, spire-server, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Revision history for acolyte-test++## 0.1.0.0 -- 2026-04-27++* Initial release. Test helpers for acolyte: in-process request+  builders and response assertions that talk directly to a Service+  without spinning up a real network stack.
+ 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.
+ acolyte-test.cabal view
@@ -0,0 +1,87 @@+cabal-version:   3.0+name:            acolyte-test+version:         0.1.0.0+synopsis:        Testing utilities for acolyte APIs+category:        Web, Testing+description:+  Test helpers for APIs built with acolyte. Direct dispatch+  (no network), response assertions, and warp-based integration testing.++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:+    Acolyte.Test+    Acolyte.Test.Grpc+    Acolyte.Test.Property++  build-depends:+      base                       >= 4.20 && < 5+    , acolyte-core               >= 0.1  && < 0.2+    , acolyte-server             >= 0.1  && < 0.2+    , spire                      >= 0.1  && < 0.2+    , spire-grpc                 >= 0.1  && < 0.2+    , http-core                  >= 0.1  && < 0.2+    , aeson                      >= 2.1  && < 2.3+    , bytestring                 >= 0.11 && < 0.13+    , text                       >= 2.0  && < 2.2+    , http-types                 >= 0.12 && < 0.13+    , QuickCheck                 >= 2.14 && < 2.17++  hs-source-dirs: src+  default-language: GHC2024+  default-extensions:+    DataKinds+    TypeFamilies+    TypeOperators+    OverloadedStrings+    AllowAmbiguousTypes+    ScopedTypeVariables+    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:+    DataKinds+    TypeFamilies+    TypeOperators+    OverloadedStrings+    AllowAmbiguousTypes+    ScopedTypeVariables+    StrictData++  ghc-options: -Wall -rtsopts "-with-rtsopts=-K1K"++  build-depends:+      base                       >= 4.20 && < 5+    , acolyte-test               >= 0.1  && < 0.2+    , acolyte-core               >= 0.1  && < 0.2+    , acolyte-server             >= 0.1  && < 0.2+    , acolyte-openapi            >= 0.1  && < 0.2+    , acolyte-grpc               >= 0.1  && < 0.2+    , spire                      >= 0.1  && < 0.2+    , spire-grpc                 >= 0.1  && < 0.2+    , spire-server               >= 0.1  && < 0.2+    , http-core                  >= 0.1  && < 0.2+    , aeson                      >= 2.1  && < 2.3+    , bytestring                 >= 0.11 && < 0.13+    , text                       >= 2.0  && < 2.2+    , http-types                 >= 0.12 && < 0.13++source-repository head+  type:     git+  location: https://github.com/joshburgess/acolyte.git
+ src/Acolyte/Test.hs view
@@ -0,0 +1,187 @@+-- | Testing utilities for acolyte APIs.+--+-- Test APIs by dispatching requests directly through the spire Service+-- — no network, no warp, no ports. Fast and deterministic.+--+-- @+-- import Acolyte.Test+--+-- test = do+--   let svc = mkServer @MyAPI handlers+--   resp <- request svc "GET" "/health" [] ""+--   resp `shouldHaveStatus` 200+--   resp `shouldHaveBody` "ok"+-- @+module Acolyte.Test+  ( -- * Making requests+    request+  , get+  , post+  , put_+  , delete_+  , patch+    -- * Response assertions+  , shouldHaveStatus+  , shouldHaveHeader+  , shouldHaveBody+  , shouldHaveJsonBody+  , shouldMatchJson+    -- * Utilities+  , responseBody'+  , responseStatus'+  , responseHeaders'+  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.HTTP.Types (Status, statusCode, RequestHeaders, Header, HeaderName)++import qualified Data.Aeson as Aeson++import Spire.Service (Service (..))+import Http.Core+++-- ===================================================================+-- Making requests+-- ===================================================================++-- | Send a request to a spire Service (no network).+request+  :: Service IO (Request ByteString) (Response ByteString)+  -> ByteString     -- ^ HTTP method+  -> ByteString     -- ^ Path (e.g., "/users/42")+  -> RequestHeaders -- ^ Headers+  -> ByteString     -- ^ Body+  -> IO (Response ByteString)+request svc method path headers body = do+  exts <- emptyExtensions+  let segments = filter (/= "") $ T.splitOn "/" (TE.decodeUtf8 path)+  let req = Request+        { requestMethod     = method+        , requestPathRaw    = path+        , requestPath       = segments+        , requestQuery      = []+        , requestHeaders    = headers+        , requestBody       = body+        , requestExtensions = exts+        }+  runService svc req+++-- | GET request with no body.+get :: Service IO (Request ByteString) (Response ByteString)+    -> ByteString -> IO (Response ByteString)+get svc path = request svc "GET" path [] ""+++-- | POST request with JSON body.+post :: Aeson.ToJSON a+     => Service IO (Request ByteString) (Response ByteString)+     -> ByteString -> a -> IO (Response ByteString)+post svc path body = request svc "POST" path+  [("Content-Type", "application/json")]+  (LBS.toStrict (Aeson.encode body))+++-- | PUT request with JSON body.+put_ :: Aeson.ToJSON a+     => Service IO (Request ByteString) (Response ByteString)+     -> ByteString -> a -> IO (Response ByteString)+put_ svc path body = request svc "PUT" path+  [("Content-Type", "application/json")]+  (LBS.toStrict (Aeson.encode body))+++-- | DELETE request with no body.+delete_ :: Service IO (Request ByteString) (Response ByteString)+        -> ByteString -> IO (Response ByteString)+delete_ svc path = request svc "DELETE" path [] ""+++-- | PATCH request with JSON body.+patch :: Aeson.ToJSON a+      => Service IO (Request ByteString) (Response ByteString)+      -> ByteString -> a -> IO (Response ByteString)+patch svc path body = request svc "PATCH" path+  [("Content-Type", "application/json")]+  (LBS.toStrict (Aeson.encode body))+++-- ===================================================================+-- Response assertions+-- ===================================================================++-- | Assert response has the expected status code.+shouldHaveStatus :: Response ByteString -> Int -> IO ()+shouldHaveStatus resp expected+  | actual == expected = pure ()+  | otherwise = error $+      "Expected status " ++ show expected ++ " but got " ++ show actual+      ++ "\nBody: " ++ show (responseBody resp)+  where actual = statusCode (responseStatus resp)+++-- | Assert response has a specific header with the expected value.+shouldHaveHeader :: Response ByteString -> HeaderName -> ByteString -> IO ()+shouldHaveHeader resp name expected =+  case lookup name (responseHeaders resp) of+    Just actual | actual == expected -> pure ()+    Just actual -> error $+      "Header " ++ show name ++ ": expected " ++ show expected+      ++ " but got " ++ show actual+    Nothing -> error $+      "Header " ++ show name ++ " not found in response"+++-- | Assert response body equals the expected bytes.+shouldHaveBody :: Response ByteString -> ByteString -> IO ()+shouldHaveBody resp expected+  | responseBody resp == expected = pure ()+  | otherwise = error $+      "Expected body " ++ show expected+      ++ " but got " ++ show (responseBody resp)+++-- | Assert response body decodes to the expected JSON value.+shouldHaveJsonBody :: (Aeson.FromJSON a, Eq a, Show a)+                   => Response ByteString -> a -> IO ()+shouldHaveJsonBody resp expected =+  case Aeson.eitherDecodeStrict' (responseBody resp) of+    Right actual | actual == expected -> pure ()+    Right actual -> error $+      "Expected JSON " ++ show expected ++ " but got " ++ show actual+    Left err -> error $+      "Failed to decode JSON: " ++ err ++ "\nBody: " ++ show (responseBody resp)+++-- | Assert response body is valid JSON matching the expected Value.+shouldMatchJson :: Response ByteString -> Aeson.Value -> IO ()+shouldMatchJson resp expected =+  case Aeson.eitherDecodeStrict' (responseBody resp) of+    Right actual | actual == expected -> pure ()+    Right actual -> error $+      "JSON mismatch.\nExpected: " ++ show expected+      ++ "\nActual: " ++ show actual+    Left err -> error $ "Failed to decode JSON: " ++ err+++-- ===================================================================+-- Utilities+-- ===================================================================++-- | Extract the status code as Int.+responseStatus' :: Response ByteString -> Int+responseStatus' = statusCode . responseStatus++-- | Extract the body.+responseBody' :: Response ByteString -> ByteString+responseBody' = responseBody++-- | Extract headers.+responseHeaders' :: Response ByteString -> [(HeaderName, ByteString)]+responseHeaders' = responseHeaders
+ src/Acolyte/Test/Grpc.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedStrings #-}+-- | gRPC testing utilities for acolyte APIs.+--+-- Test gRPC services by dispatching requests directly through the spire+-- Service -- no network, no HTTP/2, no ports. Fast and deterministic.+--+-- @+-- import Acolyte.Test.Grpc+--+-- test = do+--   let svc = grpcServer myServiceMap+--   resp <- grpcCall svc "myapp.MySvc" "SayHello" reqBytes+--   resp `shouldHaveGrpcStatus` 0+--   grpcResponseBody resp `shouldBe` expectedBytes+-- @+module Acolyte.Test.Grpc+  ( -- * Making gRPC requests+    grpcCall+    -- * Response assertions+  , shouldHaveGrpcStatus+  , shouldHaveGrpcBody+  , grpcResponseBody+  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++import Spire.Service (Service (..))+import Http.Core+import Http.Core.Body (Body, fromBytes, bodyToStrict)+import Spire.Grpc.Codec (encodeMessage, decodeMessage, GrpcMessage(..))+++-- ===================================================================+-- Making gRPC requests+-- ===================================================================++-- | Send a gRPC request to a spire Service (no network).+--+-- Constructs a proper gRPC request with:+--+-- * Method: POST+-- * Content-Type: application\/grpc+proto+-- * Path: \/service\/method+-- * Body: payload wrapped in gRPC length-prefixed framing+--+-- Returns the raw HTTP Response (with Body).+grpcCall+  :: Service IO (Request Body) (Response Body)+  -> Text         -- ^ Service name (e.g., "myapp.Greeter")+  -> Text         -- ^ Method name (e.g., "SayHello")+  -> ByteString   -- ^ Request payload bytes (will be gRPC-framed)+  -> IO (Response Body)+grpcCall svc service method payload = do+  exts <- emptyExtensions+  let path = "/" <> TE.encodeUtf8 service <> "/" <> TE.encodeUtf8 method+      framedBody = encodeMessage payload+      segments = filter (/= "") $ T.splitOn "/" (TE.decodeUtf8 path)+      req = Request+        { requestMethod     = "POST"+        , requestPathRaw    = path+        , requestPath       = segments+        , requestQuery      = []+        , requestHeaders    = [("content-type", "application/grpc+proto")]+        , requestBody       = fromBytes framedBody+        , requestExtensions = exts+        }+  runService svc req+++-- ===================================================================+-- Response assertions+-- ===================================================================++-- | Assert that the response has the expected gRPC status code.+--+-- Checks the @grpc-status@ header/trailer value. gRPC status 0 means OK.+shouldHaveGrpcStatus :: Response Body -> Int -> IO ()+shouldHaveGrpcStatus resp expected =+  case lookup "grpc-status" (responseHeaders resp) of+    Just actual ->+      let code = read (BS8.unpack actual) :: Int+      in if code == expected+         then pure ()+         else error $+           "Expected grpc-status " ++ show expected+           ++ " but got " ++ show code+    Nothing -> error+      "grpc-status header/trailer not found in response"+++-- | Assert that the gRPC response body (after removing framing) equals+-- the expected bytes.+shouldHaveGrpcBody :: Response Body -> ByteString -> IO ()+shouldHaveGrpcBody resp expected = do+  body <- bodyToStrict (responseBody resp)+  let payload = stripGrpcFraming body+  if payload == expected+    then pure ()+    else error $+      "Expected gRPC body " ++ show expected+      ++ " but got " ++ show payload+++-- | Extract the payload from a gRPC-framed response body.+--+-- Strips the 5-byte gRPC length-prefixed framing header and returns+-- the raw message bytes. Returns empty bytes if the body is empty+-- or cannot be decoded.+grpcResponseBody :: Response Body -> IO ByteString+grpcResponseBody resp = do+  body <- bodyToStrict (responseBody resp)+  pure (stripGrpcFraming body)+++-- ===================================================================+-- Internal helpers+-- ===================================================================++-- | Strip gRPC length-prefixed framing from a ByteString.+stripGrpcFraming :: ByteString -> ByteString+stripGrpcFraming bs+  | BS.null bs = BS.empty+  | otherwise = case decodeMessage bs of+      Just (msg, _) -> gmPayload msg+      Nothing       -> bs  -- fallback: return raw bytes
+ src/Acolyte/Test/Property.hs view
@@ -0,0 +1,113 @@+-- | Property-based testing for acolyte APIs.+--+-- Generate random valid requests for any endpoint in an API type.+--+-- @+-- prop_noCrash :: Property+-- prop_noCrash = forAll (arbitraryApiRequest @MyAPI) $ \req -> ioProperty $ do+--   resp <- runService myServer req+--   pure (responseStatus' resp `elem` [200, 201, 400, 401, 404])+-- @+module Acolyte.Test.Property+  ( -- * Random request generation+    ArbitraryEndpoint (..)+  , ArbitraryAPI (..)+    -- * Helpers+  , randomCapture+  , generatePath+  , genJsonObject+  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import Data.Kind (Type)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import System.IO.Unsafe (unsafePerformIO)++import Test.QuickCheck++import Http.Core+import Acolyte.Server.Handler (HasEndpointInfo (..))+++-- | Generate a random valid request for a specific endpoint.+class ArbitraryEndpoint endpoint where+  arbitraryEndpointRequest :: Gen (Request ByteString)++instance HasEndpointInfo e => ArbitraryEndpoint e where+  arbitraryEndpointRequest = do+    let method  = endpointMethod @e+        pattern = endpointPattern @e+    pathSegments <- generatePath pattern+    let pathRaw = "/" <> BS8.intercalate "/" (map TE.encodeUtf8 pathSegments)+    body <- oneof [pure "", genJsonObject]+    let exts = unsafePerformIO emptyExtensions+    pure Request+      { requestMethod     = method+      , requestPathRaw    = pathRaw+      , requestPath       = pathSegments+      , requestQuery      = []+      , requestHeaders    = [("Content-Type", "application/json")]+      , requestBody       = body+      , requestExtensions = exts+      }+++-- | Generate a random request for any endpoint in an API.+class ArbitraryAPI (api :: [Type]) where+  arbitraryApiRequest :: Gen (Request ByteString)++instance ArbitraryEndpoint e => ArbitraryAPI '[e] where+  arbitraryApiRequest = arbitraryEndpointRequest @e++instance (ArbitraryEndpoint e, ArbitraryAPI (e2 ': rest))+  => ArbitraryAPI (e ': e2 ': rest) where+    arbitraryApiRequest = oneof+      [ arbitraryEndpointRequest @e+      , arbitraryApiRequest @(e2 ': rest)+      ]+++-- ===================================================================+-- Helpers+-- ===================================================================++-- | Generate a random capture value (int or short string).+randomCapture :: Gen Text+randomCapture = oneof+  [ T.pack . show <$> chooseInt (1, 9999)+  , T.pack <$> listOf1 (elements ['a'..'z'])+  ]+++-- | Generate path segments from a pattern, replacing captures with random values.+generatePath :: Text -> Gen [Text]+generatePath pattern =+  let parts = filter (not . T.null) (T.splitOn "/" pattern)+  in mapM genSegment parts+  where+    genSegment seg+      | "{" `T.isPrefixOf` seg = randomCapture+      | otherwise = pure seg+++-- | Generate a random small JSON object.+genJsonObject :: Gen ByteString+genJsonObject = do+  nFields <- chooseInt (0, 3)+  fields <- vectorOf nFields genField+  pure $ BS8.pack $ "{" ++ intercalateS "," fields ++ "}"+  where+    genField = do+      key <- listOf1 (elements ['a'..'z'])+      val <- oneof+        [ show <$> chooseInt (0 :: Int, 100)+        , (\s -> "\"" ++ s ++ "\"") <$> listOf1 (elements ['a'..'z'])+        ]+      pure $ "\"" ++ key ++ "\":" ++ val++    intercalateS _ [] = ""+    intercalateS _ [x] = x+    intercalateS sep (x:xs) = x ++ sep ++ intercalateS sep xs
+ test/Main.hs view
@@ -0,0 +1,396 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Data.ByteString (ByteString)+import Data.Text (Text)+import qualified Data.Text as T+import Network.HTTP.Types (status400, status500)++import Spire+import Spire.Service (Service (..))+import Http.Core+import Http.Core.Body (Body, fromBytes, bodyToStrict)+import Acolyte.Core+import Acolyte.Server+import Acolyte.Test+import Acolyte.Test.Grpc+import Spire.Grpc (grpcServer, grpcServiceMap, unaryHandler, multiplex)+import Spire.Server (adaptToBody)+import Acolyte.OpenApi+  ( generateSpec, OpenApiSpec(..), specOps )+import Acolyte.Grpc+  ( mkGrpcServiceMap, GrpcHandlerFn+  , generateProto, ProtoMessageName(..)+  )+++-- ===================================================================+-- Test API and server (original tests)+-- ===================================================================++type HealthPath   = '[ 'Lit "health" ]+type UsersPath    = '[ 'Lit "users" ]+type UserByIdPath = '[ 'Lit "users", 'Capture Int ]++type TestAPI =+  '[ Get HealthPath   Text+   , Get UsersPath    (Json [Text])+   , Get UserByIdPath (Json Text)+   ]++testServer :: Service IO (Request ByteString) (Response ByteString)+testServer = mkServer @TestAPI+  ( wrapHandler @(Get HealthPath Text)+      (mkHandler0 (pure ("ok" :: Text)))+  , wrapHandler @(Get UsersPath (Json [Text]))+      (mkHandler0 (pure (Json (["alice", "bob"] :: [Text]))))+  , wrapHandler @(Get UserByIdPath (Json Text))+      (\parts _body -> do+        mCaps <- lookupExtension @CaptureList (rpExtensions parts)+        case mCaps of+          Just (CaptureList (idT : _)) ->+            case parseCapture @Int idT of+              Just n  -> pure $ intoResponse (Json (T.pack ("user-" ++ show n)))+              Nothing -> pure $ intoResponse (mkError status400 "bad id")+          _ -> pure $ intoResponse (mkError status500 "no caps")+      )+  )+++-- ===================================================================+-- Integration API (exercises all layers)+-- ===================================================================++-- ProtoMessageName instances needed for .proto generation+instance ProtoMessageName Text where+  protoMessageName = "StringValue"++instance ProtoMessageName [Text] where+  protoMessageName = "StringList"+++type IntegrationAPI =+  '[ Describe "Health check" (Get (At "health") Text)+   , WithParams '[QP "page" Int]+       (Get (At "users") (Json [Text]))+   , PostCreated (At "users") (Json Text) (Json Text)+   , Get (Param "users" Int) (Json Text)+   ]+++-- Handlers for REST server (mkApi style)+healthHandler :: IO Text+healthHandler = pure "ok"++listUsersHandler :: IO (Json [Text])+listUsersHandler = pure (Json (["alice", "bob"] :: [Text]))++createUserHandler :: JsonBody Text -> IO (Json Text)+createUserHandler (JsonBody name) = pure (Json ("created:" <> name))++getUserHandler :: PathCapture Int -> IO (Json Text)+getUserHandler (PathCapture uid) = pure (Json (T.pack ("user-" ++ show uid)))+++-- gRPC handlers+grpcHealthHandler :: GrpcHandlerFn+grpcHealthHandler _req = pure (Right "ok")++grpcListUsersHandler :: GrpcHandlerFn+grpcListUsersHandler _req = pure (Right "[\"alice\",\"bob\"]")++grpcCreateUserHandler :: GrpcHandlerFn+grpcCreateUserHandler req = pure (Right ("created:" <> req))++grpcGetUserHandler :: GrpcHandlerFn+grpcGetUserHandler _req = pure (Right "user-42")+++-- ===================================================================+-- Effect-tracked API (compile-time middleware tracking)+-- ===================================================================++type EffectAPI =+  '[ Requires Auth (Get (At "profile") (Json Text))+   , Get (At "public") Text+   ]++authMiddleware :: Middleware IO (Request ByteString) (Response ByteString)+authMiddleware = middleware $ \inner -> Service $ \req -> runService inner req+++-- ===================================================================+-- Tests+-- ===================================================================++main :: IO ()+main = do+  putStrLn "acolyte-test tests:"+  putStrLn ""++  -- =================================================================+  -- Original tests+  -- =================================================================++  putStrLn "get helper:"+  resp1 <- get testServer "/health"+  resp1 `shouldHaveStatus` 200+  resp1 `shouldHaveBody` "ok"+  putStrLn "  OK: GET /health -> 200, body ok"++  putStrLn ""+  putStrLn "JSON response:"+  resp2 <- get testServer "/users"+  resp2 `shouldHaveStatus` 200+  resp2 `shouldHaveJsonBody` (["alice", "bob"] :: [Text])+  putStrLn "  OK: GET /users -> 200, JSON body"++  putStrLn ""+  putStrLn "Path captures:"+  resp3 <- get testServer "/users/42"+  resp3 `shouldHaveStatus` 200+  resp3 `shouldHaveJsonBody` ("user-42" :: Text)+  putStrLn "  OK: GET /users/42 -> 200, user-42"++  putStrLn ""+  putStrLn "404:"+  resp4 <- get testServer "/nope"+  resp4 `shouldHaveStatus` 404+  putStrLn "  OK: GET /nope -> 404"++  putStrLn ""+  putStrLn "405:"+  resp5 <- request testServer "POST" "/health" [] ""+  resp5 `shouldHaveStatus` 405+  putStrLn "  OK: POST /health -> 405"++  putStrLn ""+  putStrLn "Middleware:"+  let svc = testServer |> middleware (\inner -> Service $ \req -> do+              resp <- runService inner req+              pure resp { responseHeaders = ("X-Test", "yes") : responseHeaders resp })+  resp6 <- get svc "/health"+  resp6 `shouldHaveStatus` 200+  resp6 `shouldHaveHeader` "X-Test" $ "yes"+  putStrLn "  OK: middleware header present"++  -- =================================================================+  -- gRPC testing utilities (original)+  -- =================================================================++  putStrLn ""+  putStrLn "gRPC test utilities:"++  let echoHandler = unaryHandler $ \reqBytes -> pure (Right reqBytes)+      grpcSvc = grpcServer $ grpcServiceMap+        [ ("test.Echo", "Echo", echoHandler)+        ]++  putStrLn ""+  putStrLn "grpcCall + shouldHaveGrpcStatus:"+  grpcResp1 <- grpcCall grpcSvc "test.Echo" "Echo" "hello"+  grpcResp1 `shouldHaveGrpcStatus` 0+  putStrLn "  OK: grpc-status 0 (OK)"++  putStrLn ""+  putStrLn "grpcResponseBody:"+  body1 <- grpcResponseBody grpcResp1+  if body1 == "hello"+    then putStrLn "  OK: response body matches"+    else error $ "Expected body \"hello\" but got " ++ show body1++  putStrLn ""+  putStrLn "shouldHaveGrpcBody:"+  grpcResp2 <- grpcCall grpcSvc "test.Echo" "Echo" "world"+  grpcResp2 `shouldHaveGrpcBody` "world"+  putStrLn "  OK: gRPC body assertion passed"++  putStrLn ""+  putStrLn "gRPC unimplemented method:"+  grpcResp3 <- grpcCall grpcSvc "test.Echo" "NoSuchMethod" ""+  grpcResp3 `shouldHaveGrpcStatus` 12  -- UNIMPLEMENTED+  putStrLn "  OK: grpc-status 12 (UNIMPLEMENTED)"++  -- =================================================================+  -- INTEGRATION TESTS: Cross-package end-to-end+  -- =================================================================++  putStrLn ""+  putStrLn "============================================"+  putStrLn "Integration tests (full stack):"+  putStrLn "============================================"++  -- -----------------------------------------------------------------+  -- (a) REST server via mkApi+  -- -----------------------------------------------------------------+  putStrLn ""+  putStrLn "a) REST server via mkApi @IntegrationAPI:"++  let restSvc = mkApi @IntegrationAPI+        (healthHandler, listUsersHandler, createUserHandler, getUserHandler)++  ra1 <- get restSvc "/health"+  ra1 `shouldHaveStatus` 200+  ra1 `shouldHaveBody` "ok"+  putStrLn "  OK: GET /health -> 200"++  ra2 <- get restSvc "/users"+  ra2 `shouldHaveStatus` 200+  ra2 `shouldHaveJsonBody` (["alice", "bob"] :: [Text])+  putStrLn "  OK: GET /users -> 200, JSON list"++  ra3 <- post restSvc "/users" ("newuser" :: Text)+  ra3 `shouldHaveStatus` 200+  ra3 `shouldHaveJsonBody` ("created:newuser" :: Text)+  putStrLn "  OK: POST /users -> 200, created"++  ra4 <- get restSvc "/users/42"+  ra4 `shouldHaveStatus` 200+  ra4 `shouldHaveJsonBody` ("user-42" :: Text)+  putStrLn "  OK: GET /users/42 -> 200, user-42"++  ra5 <- get restSvc "/notexist"+  ra5 `shouldHaveStatus` 404+  putStrLn "  OK: GET /notexist -> 404"++  -- -----------------------------------------------------------------+  -- (b) gRPC server via mkGrpcServiceMap+  -- -----------------------------------------------------------------+  putStrLn ""+  putStrLn "b) gRPC server via mkGrpcServiceMap @IntegrationAPI:"++  let grpcServices = mkGrpcServiceMap @IntegrationAPI "test" "IntegrationSvc"+        (grpcHealthHandler, grpcListUsersHandler, grpcCreateUserHandler, grpcGetUserHandler)+      grpcSvc2 = grpcServer grpcServices++  gb1 <- grpcCall grpcSvc2 "test.IntegrationSvc" "Health" "ping"+  gb1 `shouldHaveGrpcStatus` 0+  gb1body <- grpcResponseBody gb1+  if gb1body == "ok"+    then putStrLn "  OK: gRPC Health -> status 0, body ok"+    else error $ "Expected gRPC body \"ok\" but got " ++ show gb1body++  -- Note: "Users" method name is shared by 3 endpoints (list, create, getById).+  -- gRPC dispatches by method name, so the last registered handler wins.+  -- This is expected — in real usage, distinct gRPC method names are needed.+  gb2 <- grpcCall grpcSvc2 "test.IntegrationSvc" "Users" ""+  gb2 `shouldHaveGrpcStatus` 0+  putStrLn "  OK: gRPC Users -> status 0 (dispatched)"++  gb4 <- grpcCall grpcSvc2 "test.IntegrationSvc" "NoSuch" ""+  gb4 `shouldHaveGrpcStatus` 12+  putStrLn "  OK: gRPC NoSuch -> status 12 (UNIMPLEMENTED)"++  -- -----------------------------------------------------------------+  -- (c) Multiplex: REST + gRPC on same service+  -- -----------------------------------------------------------------+  putStrLn ""+  putStrLn "c) Multiplex REST + gRPC:"++  let combined = multiplex (adaptToBody restSvc) grpcSvc2++  -- REST request through combined (no content-type or non-grpc)+  do+    exts <- emptyExtensions+    let segments = ["health"]+        req = Request+          { requestMethod     = "GET"+          , requestPathRaw    = "/health"+          , requestPath       = segments+          , requestQuery      = []+          , requestHeaders    = [("content-type", "application/json")]+          , requestBody       = fromBytes ""+          , requestExtensions = exts+          }+    mresp <- runService combined req+    mbody <- bodyToStrict (responseBody mresp)+    if mbody == "ok"+      then putStrLn "  OK: REST request through multiplex -> ok"+      else error $ "Expected body \"ok\" but got " ++ show mbody++  -- gRPC request through combined+  do+    mgResp <- grpcCall combined "test.IntegrationSvc" "Health" "ping"+    mgResp `shouldHaveGrpcStatus` 0+    mgBody <- grpcResponseBody mgResp+    if mgBody == "ok"+      then putStrLn "  OK: gRPC request through multiplex -> ok"+      else error $ "Expected gRPC body \"ok\" but got " ++ show mgBody++  -- -----------------------------------------------------------------+  -- (d) OpenAPI spec generation+  -- -----------------------------------------------------------------+  putStrLn ""+  putStrLn "d) OpenAPI spec generation:"++  let spec = generateSpec @IntegrationAPI "Integration Test" "1.0.0"+      ops  = specOps spec++  if length ops == 4+    then putStrLn "  OK: generateSpec produced 4 operations"+    else error $ "Expected 4 operations but got " ++ show (length ops)++  if specTitle spec == "Integration Test"+    then putStrLn "  OK: spec title correct"+    else error $ "Expected title 'Integration Test' but got " ++ show (specTitle spec)++  if specVersion spec == "1.0.0"+    then putStrLn "  OK: spec version correct"+    else error $ "Expected version '1.0.0' but got " ++ show (specVersion spec)++  -- -----------------------------------------------------------------+  -- (e) .proto generation+  -- -----------------------------------------------------------------+  putStrLn ""+  putStrLn "e) .proto generation:"++  let proto = generateProto @IntegrationAPI "test" "IntegrationSvc"+      rpcLines = filter (T.isPrefixOf "  rpc ") (T.lines proto)++  if length rpcLines == 4+    then putStrLn "  OK: generateProto produced 4 rpc lines"+    else error $ "Expected 4 rpc lines but got " ++ show (length rpcLines)+              ++ "\nProto:\n" ++ T.unpack proto++  if T.isInfixOf "syntax = \"proto3\";" proto+    then putStrLn "  OK: proto3 syntax declaration present"+    else error "Expected proto3 syntax declaration"++  if T.isInfixOf "service IntegrationSvc" proto+    then putStrLn "  OK: service name correct"+    else error "Expected service IntegrationSvc in proto"++  if T.isInfixOf "package test;" proto+    then putStrLn "  OK: package name correct"+    else error "Expected package test in proto"++  -- -----------------------------------------------------------------+  -- (g) Effect tracking+  -- -----------------------------------------------------------------+  putStrLn ""+  putStrLn "g) Effect tracking:"++  let profileHandler :: IO (Json Text)+      profileHandler = pure (Json ("profile-data" :: Text))++      publicHandler :: IO Text+      publicHandler = pure ("public-data" :: Text)++      -- Build effectful server, provide Auth, then run+      effectSvc = run+        $ provide @Auth authMiddleware+        $ effectfulApi @EffectAPI (profileHandler, publicHandler)++  eg1 <- get effectSvc "/profile"+  eg1 `shouldHaveStatus` 200+  eg1 `shouldHaveJsonBody` ("profile-data" :: Text)+  putStrLn "  OK: effectful GET /profile -> 200 (Auth provided)"++  eg2 <- get effectSvc "/public"+  eg2 `shouldHaveStatus` 200+  eg2 `shouldHaveBody` "public-data"+  putStrLn "  OK: effectful GET /public -> 200"++  putStrLn ""+  putStrLn "============================================"+  putStrLn "All acolyte-test tests passed."