module Network.Wai.Log.Options (
Options(..)
, ResponseTime(..)
, defaultOptions
, defaultLogRequest
, defaultLogResponse
, 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
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]
, forall id.
Options id
-> Maybe
(Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
logBody :: Maybe (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))
, forall id. Options id -> Request -> IO id
logGetRequestId :: Request -> IO id
}
data ResponseTime = ResponseTime {
ResponseTime -> NominalDiffTime
processing :: NominalDiffTime
, ResponseTime -> NominalDiffTime
full :: NominalDiffTime
}
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
}
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
}
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)
]
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
]
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
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