{-|
Module      : Instana.Wai.Middleware.Entry.Internal
Description : Internals of the WAI Instana Tracing Middleware

Automatically creates entry spans for all incoming HTTP requests in a WAI
application.
-}
module Instana.Wai.Middleware.Entry.Internal
  ( traceHttpEntries
  ) where


import           Instana.SDK.Internal.Id           (Id)
import qualified Instana.SDK.Internal.ServerTiming as ServerTiming
import           Network.Wai                       (Middleware, Response)
import qualified Network.Wai                       as Wai

import           Instana.SDK.SDK                   (InstanaContext,
                                                    currentTraceId,
                                                    withHttpEntry)


{-| Run the tracing middleware given an initialized Instana SDK context. The
middleware will create entry spans automatically. It will also add (or append
to) the HTTP respons header (Server-Timing) that is used for website monitoring
back end correlation.
-}
traceHttpEntries :: InstanaContext -> Middleware
traceHttpEntries :: InstanaContext -> Middleware
traceHttpEntries instana :: InstanaContext
instana app :: Application
app request :: Request
request respond :: Response -> IO ResponseReceived
respond = do
  InstanaContext
-> Request -> IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) a.
MonadIO m =>
InstanaContext -> Request -> m a -> m a
withHttpEntry InstanaContext
instana Request
request (IO ResponseReceived -> IO ResponseReceived)
-> IO ResponseReceived -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ do
    Maybe Id
traceIdMaybe <- InstanaContext -> IO (Maybe Id)
currentTraceId InstanaContext
instana
    case Maybe Id
traceIdMaybe of
      Just traceId :: Id
traceId ->
        Application
app Request
request ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> (Response -> Response) -> Response -> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Response -> Response
addHeader Id
traceId
      Nothing ->
        Application
app Request
request Response -> IO ResponseReceived
respond


addHeader :: Id -> Response -> Response
addHeader :: Id -> Response -> Response
addHeader traceId :: Id
traceId =
  (ResponseHeaders -> ResponseHeaders) -> Response -> Response
Wai.mapResponseHeaders ((ResponseHeaders -> ResponseHeaders) -> Response -> Response)
-> (ResponseHeaders -> ResponseHeaders) -> Response -> Response
forall a b. (a -> b) -> a -> b
$ Id -> ResponseHeaders -> ResponseHeaders
ServerTiming.addTraceIdToServerTiming Id
traceId