{-# language OverloadedStrings #-} -- | A minimal WAI echo application and Tasty test fixture. -- -- The server accepts any HTTP request and responds with a JSON object -- reflecting the method, path, query string, request headers, and body. -- Header names are normalised to lowercase for predictable assertions. module HTTP.EchoServer (withEchoServer) where import Data.Aeson (encode, object, (.=)) import qualified Data.ByteString.Lazy as BL import qualified Data.CaseInsensitive as CI import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Network.HTTP.Types (status200) import Network.Wai ( Application , rawPathInfo , rawQueryString , requestHeaders , requestMethod , responseLBS , strictRequestBody ) import Network.Wai.Handler.Warp (Port, testWithApplication) -- | WAI application that echoes request details back as JSON. echoApp :: Application echoApp req respond = do body <- strictRequestBody req let method = TE.decodeUtf8 (requestMethod req) path = TE.decodeUtf8 (rawPathInfo req) query = TE.decodeUtf8 (rawQueryString req) hdrs = Map.fromList [ (TE.decodeUtf8 (CI.foldedCase k), TE.decodeUtf8 v) | (k, v) <- requestHeaders req ] :: Map T.Text T.Text bodyTxt = TE.decodeUtf8 (BL.toStrict body) payload = object [ "method" .= method , "path" .= path , "query" .= query , "headers" .= hdrs , "body" .= bodyTxt ] respond $ responseLBS status200 [("Content-Type", "application/json")] (encode payload) -- | Bracket helper: spin up an echo server on a free OS-assigned port, -- run the supplied action with that port number, then tear down the server. -- -- Safe to use inside 'Test.Tasty.HUnit.testCase' — the server is -- terminated even if the action throws an exception. withEchoServer :: (Port -> IO a) -> IO a withEchoServer = testWithApplication (pure echoApp)