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

import Data.Aeson.Types (Pair)
import Data.String.Conversions (ConvertibleStrings, StrictText, cs)
import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime)
import Log
import Network.HTTP.Types.Status
import Network.Wai

-- | Logging options
data Options = Options {
    Options -> LogLevel
logLevel            :: LogLevel
  , Options -> Request -> [Pair]
logRequest          :: Request -> [Pair]
  , Options -> Bool
logSendingResponse  :: Bool
  , Options -> Request -> Response -> ResponseTime -> [Pair]
logResponse         :: Request -> Response -> ResponseTime -> [Pair]
  }

-- | 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'
-- , logSendingResponse = True
-- , logResponse = 'defaultLogResponse'
-- }
-- @
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: LogLevel
-> (Request -> [Pair])
-> Bool
-> (Request -> Response -> ResponseTime -> [Pair])
-> Options
Options
  { logLevel :: LogLevel
logLevel = LogLevel
LogInfo
  , logRequest :: Request -> [Pair]
logRequest = Request -> [Pair]
defaultLogRequest
  , logSendingResponse :: Bool
logSendingResponse = Bool
True
  , logResponse :: Request -> Response -> ResponseTime -> [Pair]
logResponse = Request -> Response -> ResponseTime -> [Pair]
defaultLogResponse
  }

-- | Logs the following request values:
--
-- * method
-- * url path
-- * remote host
-- * user agent
-- * body-length
defaultLogRequest :: Request -> [Pair]
defaultLogRequest :: Request -> [Pair]
defaultLogRequest req :: Request
req =
  [ "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)
  , "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)
  , "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)
  , "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)
  , "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:
--
-- * status code
-- * status message
-- * time full
-- * time processing
--
-- Nothing from the 'Request' is logged
--
-- Time is in seconds as that is how 'NominalDiffTime' is treated by default
defaultLogResponse :: Request -> Response -> ResponseTime -> [Pair]
defaultLogResponse :: Request -> Response -> ResponseTime -> [Pair]
defaultLogResponse _req :: Request
_req resp :: Response
resp time :: ResponseTime
time =
    [ "status" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [ "code"    Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Status -> Int
statusCode (Response -> Status
responseStatus Response
resp)
                         , "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))
                         ]
    , "time"   Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [ "full"    Text -> NominalDiffTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResponseTime -> NominalDiffTime
full ResponseTime
time
                         , "process" Text -> NominalDiffTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResponseTime -> NominalDiffTime
processing ResponseTime
time
                         ]
    ]

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