module Network.Wai.Log.Options (
-- * Options & Timing
  Options(..)
, ResponseTime(..)
-- * Defaults
, defaultOptions
, defaultLogRequest
, defaultLogResponse
-- * Helpers
, mkOpaqueDefaultOptions
, logRequestId
, requestId
) where

import Data.Aeson.Types (ToJSON, Pair, Value)
import Data.ByteString.Builder (Builder)
import Data.String.Conversions (ConvertibleStrings, StrictText, cs)
import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime)
import Data.UUID (UUID)
import Data.UUID.V4 (nextRandom)
import Log
import Network.HTTP.Types.Header (ResponseHeaders)
import Network.HTTP.Types.Status (Status, statusCode, statusMessage)
import Network.Wai

-- | Logging options
--
-- Logging response body involves extracting it from @Response@ via IO operations,
-- therefore the @logBody@ option takes @Request@, @Status@ and @ResponseHeaders@
-- as arguments to decide whether the IO operations of body extraction have
-- to be performed.
-- The resulting @Maybe@ function is the constructor of a loggable @Value@
-- from the body bytestring builder.
data Options id = Options {
    forall id. Options id -> LogLevel
logLevel    :: LogLevel
  , forall id. Options id -> id -> Request -> [Pair]
logRequest  :: id -> Request -> [Pair]
  , forall id.
Options id
-> id -> Request -> Response -> Value -> ResponseTime -> [Pair]
logResponse :: id -> Request -> Response -> Value -> ResponseTime -> [Pair]
  -- | An optional constructor of the response body log value.
  , forall id.
Options id
-> Maybe
     (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
logBody :: Maybe (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
  -- | A function for getting the request id
  , forall id. Options id -> Request -> IO id
logGetRequestId :: Request -> IO id
  }

-- | Timing data
data ResponseTime = ResponseTime {
  -- | Time between request received and application finished processing request
    ResponseTime -> NominalDiffTime
processing :: NominalDiffTime
  -- | Time between request received and response sent
  , ResponseTime -> NominalDiffTime
full       :: NominalDiffTime
  }

-- | Default 'Options'
--
-- @
-- { logLevel = 'LogInfo'
-- , logRequest = 'defaultLogRequest'
-- , logResponse = 'defaultLogResponse'
-- , logGetRequestId = 'const nextRandom'
-- }
-- @
defaultOptions :: Options UUID
defaultOptions :: Options UUID
defaultOptions = Options
  { logLevel :: LogLevel
logLevel = LogLevel
LogInfo
  , logRequest :: UUID -> Request -> [Pair]
logRequest = forall id. ToJSON id => id -> Request -> [Pair]
defaultLogRequest
  , logResponse :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]
logResponse = forall id.
ToJSON id =>
id -> Request -> Response -> Value -> ResponseTime -> [Pair]
defaultLogResponse
  , logBody :: Maybe
  (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
logBody = forall a. Maybe a
Nothing
  , logGetRequestId :: Request -> IO UUID
logGetRequestId = forall a b. a -> b -> a
const IO UUID
nextRandom
  }

-- | Build a default 'Options' record for an opaque id given a function
-- for retrieving an id.
mkOpaqueDefaultOptions :: ToJSON id => (Request -> IO id) -> Options id
mkOpaqueDefaultOptions :: forall id. ToJSON id => (Request -> IO id) -> Options id
mkOpaqueDefaultOptions Request -> IO id
getReqId = Options
  { logLevel :: LogLevel
logLevel = LogLevel
LogInfo
  , logRequest :: id -> Request -> [Pair]
logRequest = forall id. ToJSON id => id -> Request -> [Pair]
defaultLogRequest
  , logResponse :: id -> Request -> Response -> Value -> ResponseTime -> [Pair]
logResponse = forall id.
ToJSON id =>
id -> Request -> Response -> Value -> ResponseTime -> [Pair]
defaultLogResponse
  , logBody :: Maybe
  (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
logBody = forall a. Maybe a
Nothing
  , logGetRequestId :: Request -> IO id
logGetRequestId = Request -> IO id
getReqId
  }

-- | Logs the following request values:
--
-- * request_uuid
-- * method
-- * url path
-- * remote host
-- * user agent
-- * body-length
defaultLogRequest :: ToJSON id => id -> Request -> [Pair]
defaultLogRequest :: forall id. ToJSON id => id -> Request -> [Pair]
defaultLogRequest id
reqId Request
req =
  [ Key
"request_id"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= id
reqId
  , Key
"method"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ConvertibleStrings a Text => a -> Text
ts (Request -> Method
requestMethod Request
req)
  , Key
"url"          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ConvertibleStrings a Text => a -> Text
ts (Request -> Method
rawPathInfo Request
req)
  , Key
"remote_host"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show (Request -> SockAddr
remoteHost Request
req)
  , Key
"user_agent"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ConvertibleStrings a Text => a -> Text
ts (Request -> Maybe Method
requestHeaderUserAgent Request
req)
  , Key
"body_length"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show (Request -> RequestBodyLength
requestBodyLength Request
req)
  ]

-- | Logs the following values:
--
-- * request_id
-- * request method
-- * request url path
-- * response_body details provided as 'Value'
-- * status code
-- * status message
-- * time full
-- * time processing
--
-- Time is in seconds as that is how 'NominalDiffTime' is treated by default
defaultLogResponse :: ToJSON id => id -> Request -> Response -> Value -> ResponseTime -> [Pair]
defaultLogResponse :: forall id.
ToJSON id =>
id -> Request -> Response -> Value -> ResponseTime -> [Pair]
defaultLogResponse id
reqId Request
req Response
resp Value
responseBody ResponseTime
time =
  [ Key
"request_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= id
reqId
  , Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ConvertibleStrings a Text => a -> Text
ts (Request -> Method
requestMethod Request
req)
  , Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ConvertibleStrings a Text => a -> Text
ts (Request -> Method
rawPathInfo Request
req)
  , Key
"response_body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
responseBody
  , Key
"response_code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status -> Int
statusCode (Response -> Status
responseStatus Response
resp)
  , Key
"response_message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ConvertibleStrings a Text => a -> Text
ts (Status -> Method
statusMessage forall a b. (a -> b) -> a -> b
$ Response -> Status
responseStatus Response
resp)
  , Key
"full_time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ResponseTime -> NominalDiffTime
full ResponseTime
time
  , Key
"elapsed_time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ResponseTime -> NominalDiffTime
processing ResponseTime
time
  ]

-- | Helper to consistently log the request id in your application by adding
-- @request_id@ field to log's 'localData'
logRequestId :: (MonadLog m, ToJSON id) => id -> m a -> m a
logRequestId :: forall (m :: * -> *) id a.
(MonadLog m, ToJSON id) =>
id -> m a -> m a
logRequestId = forall (m :: * -> *) a. MonadLog m => [Pair] -> m a -> m a
localData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id. ToJSON id => id -> [Pair]
requestId

-- | Logs the following values:
--
-- * request_id
requestId :: ToJSON id => id -> [Pair]
requestId :: forall id. ToJSON id => id -> [Pair]
requestId id
reqId =
  [ Key
"request_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= id
reqId ]

ts :: ConvertibleStrings a StrictText => a -> Text
ts :: forall a. ConvertibleStrings a Text => a -> Text
ts = forall a b. ConvertibleStrings a b => a -> b
cs