typeable/wai
1
0
Fork 0
mirror of https://github.com/typeable/wai.git synced 2024-12-29 09:04:33 +03:00
Code Issues Projects Releases Wiki Activity

lenient UTF-8 decoding in JSON logging

Browse Source
This commit is contained in:
Daniel Bergey 2018-08-17 17:18:22 -04:00
parent f901afb90d
commit d5acc82172
1 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
wai-extra/Network/Wai/Middleware/RequestLogger/JSON.hs
View File

@ -11,7 +11,8 @@ import qualified Data.ByteString.Char8 as S8
import Data.IP
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Time (NominalDiffTime)
import Data.Word (Word32)
import Network.HTTP.Types as H
@ -32,10 +33,10 @@ formatAsJSON date req status responseSize duration reqBody response =
, "size" .= responseSize
, "body" .=
if statusCode status >= 400
then Just . decodeUtf8 . toStrict . BB.toLazyByteString $ response
then Just . decodeUtf8With lenientDecode . toStrict . BB.toLazyByteString $ response
else Nothing
]
, "time" .= decodeUtf8 date
, "time" .= decodeUtf8With lenientDecode date
]) <> "\n"
word32ToHostAddress :: Word32 -> Text
@ -47,12 +48,12 @@ readAsDouble = read
requestToJSON :: NominalDiffTime -> Request -> [S8.ByteString] -> Value
requestToJSON duration req reqBody =
object
[ "method" .= decodeUtf8 (requestMethod req)
, "path" .= decodeUtf8 (rawPathInfo req)
[ "method" .= decodeUtf8With lenientDecode (requestMethod req)
, "path" .= decodeUtf8With lenientDecode (rawPathInfo req)
, "queryString" .= map queryItemToJSON (queryString req)
, "durationMs" .= (readAsDouble . printf "%.2f" . rationalToDouble $ toRational duration * 1000)
, "size" .= requestBodyLengthToJSON (requestBodyLength req)
, "body" .= decodeUtf8 (S8.concat reqBody)
, "body" .= decodeUtf8With lenientDecode (S8.concat reqBody)
, "remoteHost" .= sockToJSON (remoteHost req)
, "httpVersion" .= httpVersionToJSON (httpVersion req)
, "headers" .= requestHeadersToJSON (requestHeaders req)
@ -78,7 +79,7 @@ sockToJSON (SockAddrCan i) =
object [ "can" .= i ]
queryItemToJSON :: QueryItem -> Value
queryItemToJSON (name, mValue) = toJSON (decodeUtf8 name, fmap decodeUtf8 mValue)
queryItemToJSON (name, mValue) = toJSON (decodeUtf8With lenientDecode name, fmap (decodeUtf8With lenientDecode) mValue)
requestHeadersToJSON :: RequestHeaders -> Value
requestHeadersToJSON = toJSON . map hToJ where
@ -87,7 +88,7 @@ requestHeadersToJSON = toJSON . map hToJ where
hToJ hd = headerToJSON hd
headerToJSON :: Header -> Value
headerToJSON (headerName, header) = toJSON (decodeUtf8 . original $ headerName, decodeUtf8 header)
headerToJSON (headerName, header) = toJSON (decodeUtf8With lenientDecode . original $ headerName, decodeUtf8With lenientDecode header)
portToJSON :: PortNumber -> Value
portToJSON = toJSON . toInteger