WAI middleware to generate a unique id for a request. This can be used in logging for tracing log lines by request id and debugging errors by taking the response X-REQUEST-ID header and searching in logs for it.

RequestId.hs

{-# LANGUAGE OverloadedStrings #-}

module MyApp.Wai.Middleware.RequestId (injectRequestId, hRequestId)  where

import           Data.ByteString           (ByteString)
import           Data.UUID                 (toASCIIBytes)
import           Data.UUID.V4              (nextRandom)
import           Network.HTTP.Types.Header
import           Network.Wai

injectRequestId :: Middleware
injectRequestId app req respond = do
  uuid <- toASCIIBytes <$> nextRandom
  let requestIdHeader = (hRequestId, uuid)
  app (addRequestHeader requestIdHeader req) (respond . addResponseHeader requestIdHeader)


hRequestId :: HeaderName
hRequestId = "X-REQUEST-ID"

addResponseHeader :: Header -> Response -> Response
addResponseHeader h =  mapResponseHeaders (h :)

-- Add a X-REQUEST-ID header removing any existing X-REQUEST-ID set by a client
-- If you add the request id's to your log messages / error responses it makes error tracing easier
addRequestHeader :: Header ->  Request -> Request
addRequestHeader requestId req =
  req { requestHeaders = modifiedHeaders }
  where
    modifiedHeaders = requestId : filter (\(headerName, _) -> headerName /= hRequestId) (requestHeaders req)