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

import Data.Aeson.Types (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 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 permormed.
-- The resulting @Maybe@ function is the constructor of a loggable @Value@
-- from the body bytestring builder.
data Options = Options {
    Options -> LogLevel
logLevel    :: LogLevel
  , Options -> UUID -> Request -> [Pair]
logRequest  :: UUID -> Request -> [Pair]
  , Options
-> UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]
logResponse :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]
  -- | An optional constructor of the response body log value.
  , Options
-> Maybe
     (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
logBody :: Maybe (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
  }

-- | 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'
-- }
-- @
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: LogLevel
-> (UUID -> Request -> [Pair])
-> (UUID -> Request -> Response -> Value -> ResponseTime -> [Pair])
-> Maybe
     (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
-> Options
Options
  { logLevel :: LogLevel
logLevel = LogLevel
LogInfo
  , logRequest :: UUID -> Request -> [Pair]
logRequest = UUID -> Request -> [Pair]
defaultLogRequest
  , logResponse :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]
logResponse = UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]
defaultLogResponse
  , logBody :: Maybe
  (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
logBody = Maybe
  (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
forall a. Maybe a
Nothing
  }

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

-- | Logs the following values:
--
-- * request_uuid
-- * 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 :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]
defaultLogResponse :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]
defaultLogResponse UUID
uuid Request
req Response
resp Value
responseBody ResponseTime
time =
    [ Text
"request_uuid"  Text -> UUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UUID
uuid
    , Text
"method"        Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Method -> Text
forall a. ConvertibleStrings a Text => a -> Text
ts (Request -> Method
requestMethod Request
req)
    , Text
"url"           Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Method -> Text
forall a. ConvertibleStrings a Text => a -> Text
ts (Request -> Method
rawPathInfo Request
req)
    , Text
"response_body" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
responseBody
    , Text
"status" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [ Text
"code"    Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Status -> Int
statusCode (Response -> Status
responseStatus Response
resp)
                         , Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Method -> Text
forall a. ConvertibleStrings a Text => a -> Text
ts (Status -> Method
statusMessage (Response -> Status
responseStatus Response
resp))
                         ]
    , Text
"time"   Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [ Text
"full"    Text -> NominalDiffTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResponseTime -> NominalDiffTime
full ResponseTime
time
                         , Text
"process" Text -> NominalDiffTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResponseTime -> NominalDiffTime
processing ResponseTime
time
                         ]
    ]

-- | Helper to consistently log the UUID in your application by adding
-- @request_uuid@ field to log's 'localData'
logRequestUUID :: MonadLog m => UUID -> m a -> m a
logRequestUUID :: UUID -> m a -> m a
logRequestUUID = [Pair] -> m a -> m a
forall (m :: * -> *) a. MonadLog m => [Pair] -> m a -> m a
localData ([Pair] -> m a -> m a) -> (UUID -> [Pair]) -> UUID -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> [Pair]
requestUUID

-- | Logs the following values:
--
-- * request_uuid
requestUUID :: UUID -> [Pair]
requestUUID :: UUID -> [Pair]
requestUUID UUID
uuid =
  [ Text
"request_uuid" Text -> UUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UUID
uuid ]

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