EchoServer.hs

{-# 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)