RequestId.hs

{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Network.HTTP.Tower.Middleware.RequestId
-- Description : Generate unique request IDs
-- License     : MIT
--
-- Adds a UUID v4 correlation ID to every request.
--
-- @
-- client '|>' 'withRequestId'                          -- X-Request-ID header
-- client '|>' 'withRequestIdHeader' \"X-Correlation-ID\"  -- custom header
-- @
module Network.HTTP.Tower.Middleware.RequestId
  ( withRequestId
  , withRequestIdHeader
  ) where

import Data.ByteString.Char8 (pack)
import Data.UUID (toString)
import Data.UUID.V4 (nextRandom)
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types.Header as HTTP

import Network.HTTP.Tower.Client (HttpResponse)
import Tower.Service (Middleware)
import Tower.Middleware.Transform (withMapRequest)

-- | Add a unique @X-Request-ID@ header with a UUID v4 to every request.
withRequestId :: Middleware HTTP.Request HttpResponse
withRequestId = withRequestIdHeader "X-Request-ID"

-- | Add a unique request ID using a custom header name.
withRequestIdHeader :: HTTP.HeaderName -> Middleware HTTP.Request HttpResponse
withRequestIdHeader headerName = withMapRequest $ \req -> do
  uuid <- nextRandom
  let reqId = pack (toString uuid)
  pure req { HTTP.requestHeaders = (headerName, reqId) : HTTP.requestHeaders req }