-- |
-- Module      : Amazonka.Data.Log
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Log where

import Amazonka.Data.ByteString
import Amazonka.Data.Headers
import Amazonka.Data.Path
import Amazonka.Data.Query
import Amazonka.Data.Text
import Amazonka.Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Build
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Encoding as LText
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Types as HTTP
import qualified Numeric

class ToLog a where
  -- | Convert a value to a loggable builder.
  build :: a -> ByteStringBuilder

instance ToLog ByteStringBuilder where
  build :: ByteStringBuilder -> ByteStringBuilder
build = forall a. a -> a
id

instance ToLog ByteStringLazy where
  build :: ByteStringLazy -> ByteStringBuilder
build = ByteStringLazy -> ByteStringBuilder
Build.lazyByteString

instance ToLog ByteString where
  build :: ByteString -> ByteStringBuilder
build = ByteString -> ByteStringBuilder
Build.byteString

instance ToLog Int where
  build :: Int -> ByteStringBuilder
build = Int -> ByteStringBuilder
Build.intDec

instance ToLog Int8 where
  build :: Int8 -> ByteStringBuilder
build = Int8 -> ByteStringBuilder
Build.int8Dec

instance ToLog Int16 where
  build :: Int16 -> ByteStringBuilder
build = Int16 -> ByteStringBuilder
Build.int16Dec

instance ToLog Int32 where
  build :: Int32 -> ByteStringBuilder
build = Int32 -> ByteStringBuilder
Build.int32Dec

instance ToLog Int64 where
  build :: Int64 -> ByteStringBuilder
build = Int64 -> ByteStringBuilder
Build.int64Dec

instance ToLog Integer where
  build :: Integer -> ByteStringBuilder
build = Integer -> ByteStringBuilder
Build.integerDec

instance ToLog Word where
  build :: Word -> ByteStringBuilder
build = Word -> ByteStringBuilder
Build.wordDec

instance ToLog Word8 where
  build :: Word8 -> ByteStringBuilder
build = Word8 -> ByteStringBuilder
Build.word8Dec

instance ToLog Word16 where
  build :: Word16 -> ByteStringBuilder
build = Word16 -> ByteStringBuilder
Build.word16Dec

instance ToLog Word32 where
  build :: Word32 -> ByteStringBuilder
build = Word32 -> ByteStringBuilder
Build.word32Dec

instance ToLog Word64 where
  build :: Word64 -> ByteStringBuilder
build = Word64 -> ByteStringBuilder
Build.word64Dec

instance ToLog UTCTime where
  build :: UTCTime -> ByteStringBuilder
build = String -> ByteStringBuilder
Build.stringUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance ToLog Float where
  build :: Float -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => Maybe Int -> a -> String -> String
Numeric.showFFloat forall a. Maybe a
Nothing

instance ToLog Double where
  build :: Double -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => Maybe Int -> a -> String -> String
Numeric.showFFloat forall a. Maybe a
Nothing

instance ToLog Text where
  build :: Text -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

instance ToLog TextLazy where
  build :: TextLazy -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextLazy -> ByteStringLazy
LText.encodeUtf8

instance ToLog Char where
  build :: Char -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton

instance ToLog [Char] where
  build :: String -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TextLazy
LText.pack

instance ToLog HTTP.StdMethod where
  build :: StdMethod -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> ByteString
HTTP.renderStdMethod

instance ToLog QueryString where
  build :: QueryString -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS

instance ToLog EscapedPath where
  build :: EscapedPath -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS

-- | Intercalate a list of 'ByteStringBuilder's with newlines.
buildLines :: [ByteStringBuilder] -> ByteStringBuilder
buildLines :: [ByteStringBuilder] -> ByteStringBuilder
buildLines = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
List.intersperse ByteStringBuilder
"\n"

instance ToLog a => ToLog (CI a) where
  build :: CI a -> ByteStringBuilder
build = forall a. ToLog a => a -> ByteStringBuilder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.foldedCase

instance ToLog a => ToLog (Maybe a) where
  build :: Maybe a -> ByteStringBuilder
build Maybe a
Nothing = ByteStringBuilder
"Nothing"
  build (Just a
x) = ByteStringBuilder
"Just " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build a
x

instance ToLog Bool where
  build :: Bool -> ByteStringBuilder
build Bool
True = ByteStringBuilder
"True"
  build Bool
False = ByteStringBuilder
"False"

instance ToLog HTTP.Status where
  build :: Status -> ByteStringBuilder
build Status
x = forall a. ToLog a => a -> ByteStringBuilder
build (Status -> Int
HTTP.statusCode Status
x) forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Status -> ByteString
HTTP.statusMessage Status
x)

instance ToLog [HTTP.Header] where
  build :: [Header] -> ByteStringBuilder
build =
    forall a. Monoid a => [a] -> a
mconcat
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
List.intersperse ByteStringBuilder
"; "
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(HeaderName
k, ByteString
v) -> forall a. ToLog a => a -> ByteStringBuilder
build HeaderName
k forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
": " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build ByteString
v)

instance ToLog HTTP.HttpVersion where
  build :: HttpVersion -> ByteStringBuilder
build HTTP.HttpVersion {Int
httpMajor :: HttpVersion -> Int
httpMajor :: Int
httpMajor, Int
httpMinor :: HttpVersion -> Int
httpMinor :: Int
httpMinor} =
    ByteStringBuilder
"HTTP/"
      forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Int
httpMajor
      forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Char
'.'
      forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Int
httpMinor

instance ToLog Client.RequestBody where
  build :: RequestBody -> ByteStringBuilder
build = \case
    Client.RequestBodyBuilder Int64
n ByteStringBuilder
_ -> ByteStringBuilder
" <builder:" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Int64
n forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
">"
    Client.RequestBodyStream Int64
n GivesPopper ()
_ -> ByteStringBuilder
" <stream:" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Int64
n forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
">"
    Client.RequestBodyLBS ByteStringLazy
lbs
      | Int64
n forall a. Ord a => a -> a -> Bool
<= Int64
4096 -> forall a. ToLog a => a -> ByteStringBuilder
build ByteStringLazy
lbs
      | Bool
otherwise -> ByteStringBuilder
" <lazy:" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Int64
n forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
">"
      where
        n :: Int64
n = ByteStringLazy -> Int64
LBS.length ByteStringLazy
lbs
    Client.RequestBodyBS ByteString
bs
      | Int
n forall a. Ord a => a -> a -> Bool
<= Int
4096 -> forall a. ToLog a => a -> ByteStringBuilder
build ByteString
bs
      | Bool
otherwise -> ByteStringBuilder
" <strict:" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Int
n forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
">"
      where
        n :: Int
n = ByteString -> Int
BS.length ByteString
bs
    RequestBody
_ -> ByteStringBuilder
" <chunked>"

instance ToLog Client.HttpException where
  build :: HttpException -> ByteStringBuilder
build HttpException
x = ByteStringBuilder
"[HttpException] {\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall a. Show a => a -> String
show HttpException
x) forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"\n}"

instance ToLog Client.HttpExceptionContent where
  build :: HttpExceptionContent -> ByteStringBuilder
build HttpExceptionContent
x = ByteStringBuilder
"[HttpExceptionContent] {\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall a. Show a => a -> String
show HttpExceptionContent
x) forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"\n}"

instance ToLog Client.Request where
  build :: Request -> ByteStringBuilder
build Request
x =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[Client Request] {",
        ByteStringBuilder
"  host      = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> ByteString
Client.host Request
x) forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
":" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> Int
Client.port Request
x),
        ByteStringBuilder
"  secure    = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> Bool
Client.secure Request
x),
        ByteStringBuilder
"  method    = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> ByteString
Client.method Request
x),
        ByteStringBuilder
"  target    = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Maybe ByteString
target,
        ByteStringBuilder
"  timeout   = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall a. Show a => a -> String
show (Request -> ResponseTimeout
Client.responseTimeout Request
x)),
        ByteStringBuilder
"  redirects = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> Int
Client.redirectCount Request
x),
        ByteStringBuilder
"  path      = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> ByteString
Client.path Request
x),
        ByteStringBuilder
"  query     = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> ByteString
Client.queryString Request
x),
        ByteStringBuilder
"  headers   = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> [Header]
Client.requestHeaders Request
x),
        ByteStringBuilder
"  body      = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Request -> RequestBody
Client.requestBody Request
x),
        ByteStringBuilder
"}"
      ]
    where
      target :: Maybe ByteString
target = HeaderName
hAMZTarget forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` Request -> [Header]
Client.requestHeaders Request
x

instance ToLog (Client.Response a) where
  build :: Response a -> ByteStringBuilder
build Response a
x =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[Client Response] {",
        ByteStringBuilder
"  status  = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall body. Response body -> Status
Client.responseStatus Response a
x),
        ByteStringBuilder
"  headers = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall body. Response body -> [Header]
Client.responseHeaders Response a
x),
        ByteStringBuilder
"}"
      ]