module Hasura.Backends.DataConnector.Logging
  ( logAgentRequest,
    logClientError,
  )
where

import Control.Lens ((^.), (^?))
import Data.Aeson (object, (.=))
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap (KeyMap)
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.CaseInsensitive qualified as CI
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Text.Encoding.Error (lenientDecode)
import Hasura.HTTP qualified
import Hasura.Logging (EngineLogType (..), Hasura, LogLevel (..), Logger (..), ToEngineLog (..))
import Hasura.Prelude
import Hasura.Tracing (MonadTrace)
import Hasura.Tracing qualified as Tracing
import Hasura.Tracing.TraceId (spanIdToHex, traceIdToHex)
import Network.HTTP.Client.Transformable qualified as HTTP
import Servant.Client (ClientError (..), responseStatusCode, showBaseUrl)
import Servant.Client.Core (RequestF (..))

data RequestLogInfo = RequestLogInfo
  { RequestLogInfo -> Text
_rliRequestMethod :: Text,
    RequestLogInfo -> Text
_rliRequestUri :: Text,
    RequestLogInfo -> KeyMap Text
_rliRequestHeaders :: KeyMap Text,
    RequestLogInfo -> Maybe Text
_rliRequestBody :: Maybe Text
  }
  deriving stock (Int -> RequestLogInfo -> ShowS
[RequestLogInfo] -> ShowS
RequestLogInfo -> String
(Int -> RequestLogInfo -> ShowS)
-> (RequestLogInfo -> String)
-> ([RequestLogInfo] -> ShowS)
-> Show RequestLogInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestLogInfo -> ShowS
showsPrec :: Int -> RequestLogInfo -> ShowS
$cshow :: RequestLogInfo -> String
show :: RequestLogInfo -> String
$cshowList :: [RequestLogInfo] -> ShowS
showList :: [RequestLogInfo] -> ShowS
Show, RequestLogInfo -> RequestLogInfo -> Bool
(RequestLogInfo -> RequestLogInfo -> Bool)
-> (RequestLogInfo -> RequestLogInfo -> Bool) -> Eq RequestLogInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestLogInfo -> RequestLogInfo -> Bool
== :: RequestLogInfo -> RequestLogInfo -> Bool
$c/= :: RequestLogInfo -> RequestLogInfo -> Bool
/= :: RequestLogInfo -> RequestLogInfo -> Bool
Eq)

data AgentCommunicationLog = AgentCommunicationLog
  { AgentCommunicationLog -> Maybe RequestLogInfo
_aclRequest :: Maybe RequestLogInfo,
    AgentCommunicationLog -> Maybe Int
_aclResponseStatusCode :: Maybe Int,
    AgentCommunicationLog -> Maybe Text
_aclError :: Maybe Text,
    AgentCommunicationLog -> Text
_aclTraceId :: Text,
    AgentCommunicationLog -> Text
_aclSpanId :: Text
  }
  deriving stock (Int -> AgentCommunicationLog -> ShowS
[AgentCommunicationLog] -> ShowS
AgentCommunicationLog -> String
(Int -> AgentCommunicationLog -> ShowS)
-> (AgentCommunicationLog -> String)
-> ([AgentCommunicationLog] -> ShowS)
-> Show AgentCommunicationLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentCommunicationLog -> ShowS
showsPrec :: Int -> AgentCommunicationLog -> ShowS
$cshow :: AgentCommunicationLog -> String
show :: AgentCommunicationLog -> String
$cshowList :: [AgentCommunicationLog] -> ShowS
showList :: [AgentCommunicationLog] -> ShowS
Show, AgentCommunicationLog -> AgentCommunicationLog -> Bool
(AgentCommunicationLog -> AgentCommunicationLog -> Bool)
-> (AgentCommunicationLog -> AgentCommunicationLog -> Bool)
-> Eq AgentCommunicationLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgentCommunicationLog -> AgentCommunicationLog -> Bool
== :: AgentCommunicationLog -> AgentCommunicationLog -> Bool
$c/= :: AgentCommunicationLog -> AgentCommunicationLog -> Bool
/= :: AgentCommunicationLog -> AgentCommunicationLog -> Bool
Eq)

instance ToEngineLog AgentCommunicationLog Hasura where
  toEngineLog :: AgentCommunicationLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog AgentCommunicationLog {Maybe Int
Maybe Text
Maybe RequestLogInfo
Text
_aclRequest :: AgentCommunicationLog -> Maybe RequestLogInfo
_aclResponseStatusCode :: AgentCommunicationLog -> Maybe Int
_aclError :: AgentCommunicationLog -> Maybe Text
_aclTraceId :: AgentCommunicationLog -> Text
_aclSpanId :: AgentCommunicationLog -> Text
_aclRequest :: Maybe RequestLogInfo
_aclResponseStatusCode :: Maybe Int
_aclError :: Maybe Text
_aclTraceId :: Text
_aclSpanId :: Text
..} =
    (LogLevel
LevelDebug, EngineLogType Hasura
ELTDataConnectorLog, Value
logJson)
    where
      logJson :: Value
logJson =
        [Pair] -> Value
object
          ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
            [ (Key
"requestMethod" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair)
-> (RequestLogInfo -> Text) -> RequestLogInfo -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestLogInfo -> Text
_rliRequestMethod (RequestLogInfo -> Pair) -> Maybe RequestLogInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RequestLogInfo
_aclRequest,
              (Key
"requestUri" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair)
-> (RequestLogInfo -> Text) -> RequestLogInfo -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestLogInfo -> Text
_rliRequestUri (RequestLogInfo -> Pair) -> Maybe RequestLogInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RequestLogInfo
_aclRequest,
              (Key
"requestHeaders" Key -> KeyMap Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (KeyMap Text -> Pair)
-> (RequestLogInfo -> KeyMap Text) -> RequestLogInfo -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestLogInfo -> KeyMap Text
_rliRequestHeaders (RequestLogInfo -> Pair) -> Maybe RequestLogInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RequestLogInfo
_aclRequest,
              (Key
"requestBody" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RequestLogInfo -> Maybe Text
_rliRequestBody (RequestLogInfo -> Maybe Text)
-> Maybe RequestLogInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RequestLogInfo
_aclRequest),
              (Key
"responseStatusCode" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_aclResponseStatusCode,
              (Key
"error" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_aclError,
              Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"traceId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_aclTraceId,
              Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"spanId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_aclSpanId
            ]

logAgentRequest :: (MonadIO m, MonadTrace m) => Logger Hasura -> HTTP.Request -> Either HTTP.HttpException (HTTP.Response BSL.ByteString) -> m ()
logAgentRequest :: forall (m :: * -> *).
(MonadIO m, MonadTrace m) =>
Logger Hasura
-> Request -> Either HttpException (Response ByteString) -> m ()
logAgentRequest (Logger forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
writeLog) Request
req Either HttpException (Response ByteString)
responseOrError = do
  Maybe TraceContext
traceCtx <- m (Maybe TraceContext)
forall (m :: * -> *). MonadTrace m => m (Maybe TraceContext)
Tracing.currentContext
  let _aclRequest :: Maybe RequestLogInfo
_aclRequest = RequestLogInfo -> Maybe RequestLogInfo
forall a. a -> Maybe a
Just (RequestLogInfo -> Maybe RequestLogInfo)
-> RequestLogInfo -> Maybe RequestLogInfo
forall a b. (a -> b) -> a -> b
$ Request -> RequestLogInfo
extractRequestLogInfoFromClientRequest Request
req
      _aclResponseStatusCode :: Maybe Int
_aclResponseStatusCode = case Either HttpException (Response ByteString)
responseOrError of
        Right Response ByteString
response -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Status -> Int) -> Status -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
HTTP.statusCode (Status -> Maybe Int) -> Status -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ByteString
response
        Left HttpException
httpExn -> HttpException -> Maybe Int
Hasura.HTTP.getHTTPExceptionStatus (HttpException -> Maybe Int) -> HttpException -> Maybe Int
forall a b. (a -> b) -> a -> b
$ HttpException -> HttpException
Hasura.HTTP.HttpException HttpException
httpExn
      _aclError :: Maybe Text
_aclError = (HttpException -> Maybe Text)
-> (Response ByteString -> Maybe Text)
-> Either HttpException (Response ByteString)
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (HttpException -> Text) -> HttpException -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> Text
Hasura.HTTP.serializeHTTPExceptionMessageForDebugging) (Maybe Text -> Response ByteString -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Either HttpException (Response ByteString)
responseOrError
      _aclTraceId :: Text
_aclTraceId = Text -> (TraceContext -> Text) -> Maybe TraceContext -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (ByteString -> Text
bsToTxt (ByteString -> Text)
-> (TraceContext -> ByteString) -> TraceContext -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceId -> ByteString
traceIdToHex (TraceId -> ByteString)
-> (TraceContext -> TraceId) -> TraceContext -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceContext -> TraceId
Tracing.tcCurrentTrace) Maybe TraceContext
traceCtx
      _aclSpanId :: Text
_aclSpanId = Text -> (TraceContext -> Text) -> Maybe TraceContext -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (ByteString -> Text
bsToTxt (ByteString -> Text)
-> (TraceContext -> ByteString) -> TraceContext -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanId -> ByteString
spanIdToHex (SpanId -> ByteString)
-> (TraceContext -> SpanId) -> TraceContext -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceContext -> SpanId
Tracing.tcCurrentSpan) Maybe TraceContext
traceCtx
  AgentCommunicationLog -> m ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
writeLog AgentCommunicationLog {Maybe Int
Maybe Text
Maybe RequestLogInfo
Text
_aclRequest :: Maybe RequestLogInfo
_aclResponseStatusCode :: Maybe Int
_aclError :: Maybe Text
_aclTraceId :: Text
_aclSpanId :: Text
_aclRequest :: Maybe RequestLogInfo
_aclResponseStatusCode :: Maybe Int
_aclError :: Maybe Text
_aclTraceId :: Text
_aclSpanId :: Text
..}

extractRequestLogInfoFromClientRequest :: HTTP.Request -> RequestLogInfo
extractRequestLogInfoFromClientRequest :: Request -> RequestLogInfo
extractRequestLogInfoFromClientRequest Request
req =
  let _rliRequestMethod :: Text
_rliRequestMethod = Request
req Request -> Getting ByteString Request ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString Request ByteString
Lens' Request ByteString
HTTP.method ByteString -> (ByteString -> Text) -> Text
forall a b. a -> (a -> b) -> b
& ByteString -> Text
fromUtf8
      _rliRequestUri :: Text
_rliRequestUri = Request
req Request -> Getting Text Request Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Request Text
Lens' Request Text
HTTP.url
      _rliRequestPath :: Text
_rliRequestPath = Request
req Request -> Getting ByteString Request ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString Request ByteString
Lens' Request ByteString
HTTP.path ByteString -> (ByteString -> Text) -> Text
forall a b. a -> (a -> b) -> b
& ByteString -> Text
fromUtf8
      _rliRequestHeaders :: KeyMap Text
_rliRequestHeaders = Request
req Request -> Getting [Header] Request [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] Request [Header]
Lens' Request [Header]
HTTP.headers [Header] -> ([Header] -> KeyMap Text) -> KeyMap Text
forall a b. a -> (a -> b) -> b
& [Header] -> KeyMap Text
headersToKeyMap
      -- NOTE: We cannot decode IO based body types.
      _rliRequestBody :: Maybe Text
_rliRequestBody = Request
req Request
-> Getting (First ByteString) Request ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((RequestBody -> Const (First ByteString) RequestBody)
-> Request -> Const (First ByteString) Request
Lens' Request RequestBody
HTTP.body ((RequestBody -> Const (First ByteString) RequestBody)
 -> Request -> Const (First ByteString) Request)
-> ((ByteString -> Const (First ByteString) ByteString)
    -> RequestBody -> Const (First ByteString) RequestBody)
-> Getting (First ByteString) Request ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> RequestBody -> Const (First ByteString) RequestBody
Prism' RequestBody ByteString
HTTP._RequestBodyLBS) Maybe ByteString -> (ByteString -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (ByteString -> Text) -> ByteString -> Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ByteString -> Text
fromUtf8)
   in RequestLogInfo {Maybe Text
Text
KeyMap Text
_rliRequestMethod :: Text
_rliRequestUri :: Text
_rliRequestHeaders :: KeyMap Text
_rliRequestBody :: Maybe Text
_rliRequestMethod :: Text
_rliRequestUri :: Text
_rliRequestHeaders :: KeyMap Text
_rliRequestBody :: Maybe Text
..}

logClientError :: (MonadIO m, MonadTrace m) => Logger Hasura -> ClientError -> m ()
logClientError :: forall (m :: * -> *).
(MonadIO m, MonadTrace m) =>
Logger Hasura -> ClientError -> m ()
logClientError (Logger forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
writeLog) ClientError
clientError = do
  Maybe TraceContext
traceCtx <- m (Maybe TraceContext)
forall (m :: * -> *). MonadTrace m => m (Maybe TraceContext)
Tracing.currentContext
  let _aclResponseStatusCode :: Maybe Int
_aclResponseStatusCode = case ClientError
clientError of
        FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
response -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Status -> Int) -> Status -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
HTTP.statusCode (Status -> Maybe Int) -> Status -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Response -> Status
forall a. ResponseF a -> Status
responseStatusCode Response
response
        ClientError
_ -> Maybe Int
forall a. Maybe a
Nothing
      _aclRequest :: Maybe RequestLogInfo
_aclRequest = ClientError -> Maybe RequestLogInfo
extractRequestLogInfoFromClientInfo ClientError
clientError
      _aclError :: Maybe Text
_aclError = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ClientError -> Text
Hasura.HTTP.serializeServantClientErrorMessageForDebugging ClientError
clientError
      _aclTraceId :: Text
_aclTraceId = Text -> (TraceContext -> Text) -> Maybe TraceContext -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (ByteString -> Text
bsToTxt (ByteString -> Text)
-> (TraceContext -> ByteString) -> TraceContext -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceId -> ByteString
traceIdToHex (TraceId -> ByteString)
-> (TraceContext -> TraceId) -> TraceContext -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceContext -> TraceId
Tracing.tcCurrentTrace) Maybe TraceContext
traceCtx
      _aclSpanId :: Text
_aclSpanId = Text -> (TraceContext -> Text) -> Maybe TraceContext -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (ByteString -> Text
bsToTxt (ByteString -> Text)
-> (TraceContext -> ByteString) -> TraceContext -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanId -> ByteString
spanIdToHex (SpanId -> ByteString)
-> (TraceContext -> SpanId) -> TraceContext -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceContext -> SpanId
Tracing.tcCurrentSpan) Maybe TraceContext
traceCtx
  AgentCommunicationLog -> m ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
writeLog AgentCommunicationLog {Maybe Int
Maybe Text
Maybe RequestLogInfo
Text
_aclRequest :: Maybe RequestLogInfo
_aclResponseStatusCode :: Maybe Int
_aclError :: Maybe Text
_aclTraceId :: Text
_aclSpanId :: Text
_aclResponseStatusCode :: Maybe Int
_aclRequest :: Maybe RequestLogInfo
_aclError :: Maybe Text
_aclTraceId :: Text
_aclSpanId :: Text
..}

extractRequestLogInfoFromClientInfo :: ClientError -> Maybe RequestLogInfo
extractRequestLogInfoFromClientInfo :: ClientError -> Maybe RequestLogInfo
extractRequestLogInfoFromClientInfo = \case
  FailureResponse RequestF () (BaseUrl, ByteString)
request Response
_ ->
    let _rliRequestMethod :: Text
_rliRequestMethod = RequestF () (BaseUrl, ByteString) -> ByteString
forall body path. RequestF body path -> ByteString
requestMethod RequestF () (BaseUrl, ByteString)
request ByteString -> (ByteString -> Text) -> Text
forall a b. a -> (a -> b) -> b
& ByteString -> Text
fromUtf8
        (BaseUrl
baseUrl, ByteString
path') = RequestF () (BaseUrl, ByteString) -> (BaseUrl, ByteString)
forall body path. RequestF body path -> path
requestPath RequestF () (BaseUrl, ByteString)
request
        _rliRequestUri :: Text
_rliRequestUri = String -> Text
Text.pack (BaseUrl -> String
showBaseUrl BaseUrl
baseUrl) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
path'
        _rliRequestHeaders :: KeyMap Text
_rliRequestHeaders = [Header] -> KeyMap Text
headersToKeyMap ([Header] -> KeyMap Text)
-> (Seq Header -> [Header]) -> Seq Header -> KeyMap Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Header -> [Header]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Header -> KeyMap Text) -> Seq Header -> KeyMap Text
forall a b. (a -> b) -> a -> b
$ RequestF () (BaseUrl, ByteString) -> Seq Header
forall body path. RequestF body path -> Seq Header
requestHeaders RequestF () (BaseUrl, ByteString)
request
        _rliRequestBody :: Maybe a
_rliRequestBody = Maybe a
forall a. Maybe a
Nothing
     in RequestLogInfo -> Maybe RequestLogInfo
forall a. a -> Maybe a
Just RequestLogInfo {Maybe Text
Text
KeyMap Text
forall a. Maybe a
_rliRequestMethod :: Text
_rliRequestUri :: Text
_rliRequestHeaders :: KeyMap Text
_rliRequestBody :: Maybe Text
_rliRequestMethod :: Text
_rliRequestUri :: Text
_rliRequestHeaders :: KeyMap Text
_rliRequestBody :: forall a. Maybe a
..}
  ClientError
_ -> Maybe RequestLogInfo
forall a. Maybe a
Nothing

headersToKeyMap :: [HTTP.Header] -> KeyMap Text
headersToKeyMap :: [Header] -> KeyMap Text
headersToKeyMap [Header]
headers' =
  [Header]
headers'
    [Header] -> (Header -> (Key, Text)) -> [(Key, Text)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(HeaderName
name, ByteString
value) -> (Text -> Key
K.fromText (Text -> Key) -> (ByteString -> Text) -> ByteString -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
fromUtf8 (ByteString -> Key) -> ByteString -> Key
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
name, ByteString -> Text
fromUtf8 ByteString
value))
    [(Key, Text)] -> ([(Key, Text)] -> KeyMap Text) -> KeyMap Text
forall a b. a -> (a -> b) -> b
& [(Key, Text)] -> KeyMap Text
forall v. [(Key, v)] -> KeyMap v
KM.fromList

fromUtf8 :: BS.ByteString -> Text
fromUtf8 :: ByteString -> Text
fromUtf8 = OnDecodeError -> ByteString -> Text
Text.decodeUtf8With OnDecodeError
lenientDecode