module Katip.Wai.Response
  ( Response (..)
  , traceResponse
  ) where

import Katip.Wai.Request (Request)
import qualified Katip.Wai.Request as Request

import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Data.Time as Time
import qualified Network.HTTP.Types as HttpTypes
import qualified Network.Wai as Wai
import qualified System.Clock as Clock


-- | Response that was sent back to client.
data Response = Response
  { Response -> Status
status :: HttpTypes.Status
  -- ^ The HTTP status code of the response.
  , Response -> ResponseHeaders
responseHeaders :: HttpTypes.ResponseHeaders
  -- ^ The headers in the response. Be careful not to log any sensntive headers.
  , Response -> UTCTime
respondedAt :: Time.UTCTime
  -- ^ The time server responded.
  , Response -> TimeSpec
responseTime :: Clock.TimeSpec
  -- ^ How long it took the server to respond.
  }
  deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Response -> ShowS
showsPrec :: Int -> Response -> ShowS
$cshow :: Response -> String
show :: Response -> String
$cshowList :: [Response] -> ShowS
showList :: [Response] -> ShowS
Show, Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
/= :: Response -> Response -> Bool
Eq)


-- | Trace a response and time how long it took to process a request.
traceResponse :: MonadIO m => Request -> Wai.Response -> m Response
traceResponse :: forall (m :: * -> *).
MonadIO m =>
Request -> Response -> m Response
traceResponse Request
request Response
response = do
  TimeSpec
endedAt <- IO TimeSpec -> m TimeSpec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> m TimeSpec) -> IO TimeSpec -> m TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
  UTCTime
respondedAt <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime

  let responseTime :: TimeSpec
responseTime = TimeSpec
endedAt TimeSpec -> TimeSpec -> TimeSpec
`Clock.diffTimeSpec` Request -> TimeSpec
Request.startedAt Request
request

  Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Response
      { status :: Status
status = Response -> Status
Wai.responseStatus Response
response
      , responseHeaders :: ResponseHeaders
responseHeaders = Response -> ResponseHeaders
Wai.responseHeaders Response
response
      , UTCTime
respondedAt :: UTCTime
respondedAt :: UTCTime
respondedAt
      , TimeSpec
responseTime :: TimeSpec
responseTime :: TimeSpec
responseTime
      }