{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.ErrorDetailLevel
  ( ErrorDetailLevel (ErrorDetailLevel, includeErrorMessage, includeSchemaNames, includeRowIdentifierValues, includeNonIdentifierValues)
  , defaultErrorDetailLevel
  , minimalErrorDetailLevel
  , maximalErrorDetailLevel
  , redactErrorMessage
  , redactSchemaName
  , redactIdentifierValue
  , redactNonIdentifierValue
  )
where

{- |
  'ErrorDetailLevel' provides a means to configure what elements of information
  are included in error messages that originate from decoding rows queried
  from the database. This can be specified either by manually rendering the
  error message and providing the desired configuration, or by setting the
  desired detail level in the @OrvilleState@ as a default.

  Information will be redacted from error messages for any of the fields
  that are set to @False@.

@since 1.0.0.0
-}
data ErrorDetailLevel = ErrorDetailLevel
  { ErrorDetailLevel -> Bool
includeErrorMessage :: Bool
  , ErrorDetailLevel -> Bool
includeSchemaNames :: Bool
  , ErrorDetailLevel -> Bool
includeRowIdentifierValues :: Bool
  , ErrorDetailLevel -> Bool
includeNonIdentifierValues :: Bool
  }
  deriving
    ( -- | @since 1.0.0.0
      Int -> ErrorDetailLevel -> ShowS
[ErrorDetailLevel] -> ShowS
ErrorDetailLevel -> String
(Int -> ErrorDetailLevel -> ShowS)
-> (ErrorDetailLevel -> String)
-> ([ErrorDetailLevel] -> ShowS)
-> Show ErrorDetailLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorDetailLevel -> ShowS
showsPrec :: Int -> ErrorDetailLevel -> ShowS
$cshow :: ErrorDetailLevel -> String
show :: ErrorDetailLevel -> String
$cshowList :: [ErrorDetailLevel] -> ShowS
showList :: [ErrorDetailLevel] -> ShowS
Show
    )

{- |
  A minimal 'ErrorDetailLevel' where all information (including any
  situationally-specific error messages!) is redacted from error messages.

@since 1.0.0.0
-}
minimalErrorDetailLevel :: ErrorDetailLevel
minimalErrorDetailLevel :: ErrorDetailLevel
minimalErrorDetailLevel =
  ErrorDetailLevel
    { includeErrorMessage :: Bool
includeErrorMessage = Bool
False
    , includeSchemaNames :: Bool
includeSchemaNames = Bool
False
    , includeRowIdentifierValues :: Bool
includeRowIdentifierValues = Bool
False
    , includeNonIdentifierValues :: Bool
includeNonIdentifierValues = Bool
False
    }

{- |
  A default 'ErrorDetailLevel' that strikes a balance of including all "Generic"
  information such as the error message, schema names and row identifiers, but
  avoids unintentionally leaking non-identifier values from the database by
  redacting them.

@since 1.0.0.0
-}
defaultErrorDetailLevel :: ErrorDetailLevel
defaultErrorDetailLevel :: ErrorDetailLevel
defaultErrorDetailLevel =
  ErrorDetailLevel
    { includeErrorMessage :: Bool
includeErrorMessage = Bool
True
    , includeSchemaNames :: Bool
includeSchemaNames = Bool
True
    , includeRowIdentifierValues :: Bool
includeRowIdentifierValues = Bool
True
    , includeNonIdentifierValues :: Bool
includeNonIdentifierValues = Bool
False
    }

{- |
  A maximal 'ErrorDetailLevel' that redacts no information from the error
  messages. Error messages will include values from the database for any
  columns that are involved in a decoding failure, including some which you may
  not have intended to expose through error messages. Use with caution.

@since 1.0.0.0
-}
maximalErrorDetailLevel :: ErrorDetailLevel
maximalErrorDetailLevel :: ErrorDetailLevel
maximalErrorDetailLevel =
  ErrorDetailLevel
    { includeErrorMessage :: Bool
includeErrorMessage = Bool
True
    , includeSchemaNames :: Bool
includeSchemaNames = Bool
True
    , includeRowIdentifierValues :: Bool
includeRowIdentifierValues = Bool
True
    , includeNonIdentifierValues :: Bool
includeNonIdentifierValues = Bool
True
    }

{- |
  Redacts given the error message string if the 'ErrorDetailLevel' indicates
  that error messages should be redacted.

@since 1.0.0.0
-}
redactErrorMessage :: ErrorDetailLevel -> String -> String
redactErrorMessage :: ErrorDetailLevel -> ShowS
redactErrorMessage ErrorDetailLevel
detailLevel String
message =
  if ErrorDetailLevel -> Bool
includeErrorMessage ErrorDetailLevel
detailLevel
    then String
message
    else String
redactedValue

{- |
  Redacts given the schema name string if the 'ErrorDetailLevel' indicates
  that schema names should be redacted.

@since 1.0.0.0
-}
redactSchemaName :: ErrorDetailLevel -> String -> String
redactSchemaName :: ErrorDetailLevel -> ShowS
redactSchemaName ErrorDetailLevel
detailLevel String
schemaName =
  if ErrorDetailLevel -> Bool
includeSchemaNames ErrorDetailLevel
detailLevel
    then String
schemaName
    else String
redactedValue

{- |
  Redacts given the identifier value string if the 'ErrorDetailLevel' indicates
  that identifier values should be redacted.

@since 1.0.0.0
-}
redactIdentifierValue :: ErrorDetailLevel -> String -> String
redactIdentifierValue :: ErrorDetailLevel -> ShowS
redactIdentifierValue ErrorDetailLevel
detailLevel String
idValue =
  if ErrorDetailLevel -> Bool
includeRowIdentifierValues ErrorDetailLevel
detailLevel
    then String
idValue
    else String
redactedValue

{- |
  Redacts given the non-identifier value string if the 'ErrorDetailLevel' indicates
  that non-identifier values should be redacted.

@since 1.0.0.0
-}
redactNonIdentifierValue :: ErrorDetailLevel -> String -> String
redactNonIdentifierValue :: ErrorDetailLevel -> ShowS
redactNonIdentifierValue ErrorDetailLevel
detailLevel String
nonIdValue =
  if ErrorDetailLevel -> Bool
includeNonIdentifierValues ErrorDetailLevel
detailLevel
    then String
nonIdValue
    else String
redactedValue

redactedValue :: String
redactedValue :: String
redactedValue =
  String
"[REDACTED]"