module Katip.Wai.Request
  ( Request (..)
  , traceRequest
  ) where

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


-- | An incoming http request.
data Request = Request
  { Request -> UUID
traceId :: UUID
  -- ^ Unique identifier for the request.
  , Request -> Method
method :: HttpTypes.Method
  -- ^ HTTP request method, ie 'GET', 'HEAD', 'POST', 'PUT', 'DELETE', 'CONNECT', 'OPTIONS', 'TRACE', or 'PATCH'.
  , Request -> HttpVersion
httpVersion :: HttpTypes.HttpVersion
  -- ^ HTTP version that was used for this request.
  , Request -> Method
rawPathInfo :: ByteString
  -- ^ Raw path info for this request.
  , Request -> RequestHeaders
requestHeaders :: HttpTypes.RequestHeaders
  -- ^ All of the headers that were sent in this request. Be careful not log any sensitive headers, like API Keys.
  , Request -> Bool
isSecure :: Bool
  -- ^ Set to 'True' if the connection used https.
  , Request -> SockAddr
remoteHost :: Socket.SockAddr
  -- ^ The remote host the request was sent from.
  , Request -> [Text]
pathInfo :: [Text]
  -- ^ Same as 'rawPathInfo' except this is broken up into a list.
  , Request -> Query
queryString :: HttpTypes.Query
  -- ^ The query string from the request.
  , Request -> UTCTime
receivedAt :: Time.UTCTime
  -- ^ The time the request was received on the server.
  , Request -> TimeSpec
startedAt :: Clock.TimeSpec
  -- ^ The time the server started processing the request. You can probably ignore this, it's only here so we can time how long it takes to respond.
  }
  deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Request -> ShowS
showsPrec :: Int -> Request -> ShowS
$cshow :: Request -> String
show :: Request -> String
$cshowList :: [Request] -> ShowS
showList :: [Request] -> ShowS
Show, Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
/= :: Request -> Request -> Bool
Eq)


-- | Trace a 'Wai.Request' by assigning it a unique 'UUID' and capture information about the request.
traceRequest :: MonadIO m => Wai.Request -> m Request
traceRequest :: forall (m :: * -> *). MonadIO m => Request -> m Request
traceRequest Request
waiRequest = do
  UUID
traceId <- IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
V4.nextRandom
  UTCTime
receivedAt <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime
  TimeSpec
startedAt <- 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

  let request :: Request
request =
        Request
          { traceId :: UUID
traceId = UUID
traceId
          , receivedAt :: UTCTime
receivedAt = UTCTime
receivedAt
          , startedAt :: TimeSpec
startedAt = TimeSpec
startedAt
          , method :: Method
method = Request -> Method
Wai.requestMethod Request
waiRequest
          , httpVersion :: HttpVersion
httpVersion = Request -> HttpVersion
Wai.httpVersion Request
waiRequest
          , rawPathInfo :: Method
rawPathInfo = Request -> Method
Wai.rawPathInfo Request
waiRequest
          , requestHeaders :: RequestHeaders
requestHeaders = Request -> RequestHeaders
Wai.requestHeaders Request
waiRequest
          , isSecure :: Bool
isSecure = Request -> Bool
Wai.isSecure Request
waiRequest
          , remoteHost :: SockAddr
remoteHost = Request -> SockAddr
Wai.remoteHost Request
waiRequest
          , pathInfo :: [Text]
pathInfo = Request -> [Text]
Wai.pathInfo Request
waiRequest
          , queryString :: Query
queryString = Request -> Query
Wai.queryString Request
waiRequest
          }

  Request -> m Request
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
request