module Hasura.Server.Auth.JWT.Logging
  ( JwkRefreshLog (..),
    JwkFetchError (..),
  )
where

import Data.Aeson
import Data.ByteString.Lazy qualified as BL
import Hasura.HTTP
import Hasura.Logging
  ( EngineLogType (..),
    Hasura,
    InternalLogTypes (..),
    LogLevel (..),
    ToEngineLog (..),
  )
import Hasura.Prelude
import Network.HTTP.Types qualified as HTTP
import Network.URI (URI)

-- | Possible errors during fetching and parsing JWK
-- (the 'Text' type at the end is a friendly error message)
data JwkFetchError
  = -- | Exception while making the HTTP request
    JFEHttpException !HttpException !Text
  | -- | Non-2xx HTTP errors from the upstream server
    JFEHttpError !URI !HTTP.Status !BL.ByteString !Text
  | -- | Error parsing the JWK response itself
    JFEJwkParseError !Text !Text
  | -- | Error parsing the expiry of the JWK
    JFEExpiryParseError !(Maybe Text) Text
  deriving (Int -> JwkFetchError -> ShowS
[JwkFetchError] -> ShowS
JwkFetchError -> String
(Int -> JwkFetchError -> ShowS)
-> (JwkFetchError -> String)
-> ([JwkFetchError] -> ShowS)
-> Show JwkFetchError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwkFetchError] -> ShowS
$cshowList :: [JwkFetchError] -> ShowS
show :: JwkFetchError -> String
$cshow :: JwkFetchError -> String
showsPrec :: Int -> JwkFetchError -> ShowS
$cshowsPrec :: Int -> JwkFetchError -> ShowS
Show)

instance ToJSON JwkFetchError where
  toJSON :: JwkFetchError -> Value
toJSON = \case
    JFEHttpException HttpException
e Text
_ ->
      [Pair] -> Value
object [Key
"http_exception" Key -> HttpException -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HttpException
e]
    JFEHttpError URI
url Status
status ByteString
body Text
_ ->
      [Pair] -> Value
object
        [ Key
"status_code" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status -> Int
HTTP.statusCode Status
status,
          Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= URI -> Text
forall a. Show a => a -> Text
tshow URI
url,
          Key
"response" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
bsToTxt (ByteString -> ByteString
BL.toStrict ByteString
body)
        ]
    JFEJwkParseError Text
e Text
msg ->
      [Pair] -> Value
object [Key
"error" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
e, Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg]
    JFEExpiryParseError Maybe Text
e Text
msg ->
      [Pair] -> Value
object [Key
"error" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
e, Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg]

data JwkRefreshLog = JwkRefreshLog
  { JwkRefreshLog -> LogLevel
jrlLogLevel :: !LogLevel,
    JwkRefreshLog -> Maybe Text
jrlMessage :: !(Maybe Text),
    JwkRefreshLog -> Maybe JwkFetchError
jrlError :: !(Maybe JwkFetchError)
  }
  deriving (Int -> JwkRefreshLog -> ShowS
[JwkRefreshLog] -> ShowS
JwkRefreshLog -> String
(Int -> JwkRefreshLog -> ShowS)
-> (JwkRefreshLog -> String)
-> ([JwkRefreshLog] -> ShowS)
-> Show JwkRefreshLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwkRefreshLog] -> ShowS
$cshowList :: [JwkRefreshLog] -> ShowS
show :: JwkRefreshLog -> String
$cshow :: JwkRefreshLog -> String
showsPrec :: Int -> JwkRefreshLog -> ShowS
$cshowsPrec :: Int -> JwkRefreshLog -> ShowS
Show)

instance ToJSON JwkRefreshLog where
  toJSON :: JwkRefreshLog -> Value
toJSON (JwkRefreshLog LogLevel
_ Maybe Text
msg Maybe JwkFetchError
err) =
    [Pair] -> Value
object
      [ Key
"message" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
msg,
        Key
"error" Key -> Maybe JwkFetchError -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe JwkFetchError
err
      ]

instance ToEngineLog JwkRefreshLog Hasura where
  toEngineLog :: JwkRefreshLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog JwkRefreshLog
jwkRefreshLog =
    (JwkRefreshLog -> LogLevel
jrlLogLevel JwkRefreshLog
jwkRefreshLog, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTJwkRefreshLog, JwkRefreshLog -> Value
forall a. ToJSON a => a -> Value
toJSON JwkRefreshLog
jwkRefreshLog)