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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Marshall.MarshallError
  ( MarshallError (MarshallError, marshallErrorDetailLevel, marshallErrorRowIdentifier, marshallErrorDetails)
  , renderMarshallError
  , MarshallErrorDetails (DecodingError, MissingColumnError)
  , renderMarshallErrorDetails
  , DecodingErrorDetails (DecodingErrorDetails, decodingErrorValues, decodingErrorMessage)
  , renderDecodingErrorDetails
  , MissingColumnErrorDetails (MissingColumnErrorDetails, missingColumnName, actualColumnNames)
  , renderMissingColumnErrorDetails
  )
where

import Control.Exception (Exception)
import qualified Data.ByteString.Char8 as B8
import qualified Data.List as List
import qualified Data.Set as Set

import Orville.PostgreSQL.ErrorDetailLevel (ErrorDetailLevel, redactErrorMessage, redactIdentifierValue, redactNonIdentifierValue, redactSchemaName)
import qualified Orville.PostgreSQL.Raw.PgTextFormatValue as PgTextFormatValue
import qualified Orville.PostgreSQL.Raw.SqlValue as SqlValue

{- |
  A 'MarshallError' may be returned from
  'Orville.PostgreSQL.Marshall.marshallResultFromSql' when a row being decoded
  from the database doesn't meet the expectations of the
  'Orville.PostgreSQL.Marshall.SqlMarshaller' that is decoding it.

@since 1.0.0.0
-}
data MarshallError = MarshallError
  { MarshallError -> ErrorDetailLevel
marshallErrorDetailLevel :: ErrorDetailLevel
  -- ^ The level of detail that will be used to render this error as a
  -- message if 'show' is called.
  , MarshallError -> [(ByteString, SqlValue)]
marshallErrorRowIdentifier :: [(B8.ByteString, SqlValue.SqlValue)]
  -- ^ The identifier of the row that caused the error. This is a list
  -- of pairs of column name and value in their raw form from the database
  -- to avoid further possible decoding errors when reading the values.
  , MarshallError -> MarshallErrorDetails
marshallErrorDetails :: MarshallErrorDetails
  -- ^ The detailed information about the error that occurred during
  -- decoding.
  }

instance Show MarshallError where
  show :: MarshallError -> String
show MarshallError
decodingError =
    ErrorDetailLevel -> MarshallError -> String
renderMarshallError
      (MarshallError -> ErrorDetailLevel
marshallErrorDetailLevel MarshallError
decodingError)
      MarshallError
decodingError

instance Exception MarshallError

{- |
  Renders a 'MarshallError' to a string using the specified 'ErrorDetailLevel'.

  This ignores any 'ErrorDetailLevel' that was captured by default from
  the Orville context and uses the specified level of detail instead.

  You may want to use this function to render certain errors with a higher
  level of detail than you consider safe for (for example) your application
  logs while using a lower default error detail level with the 'Show' instance
  of 'MarshallError' in case an exception is handled in a more visible section
  of code that returns information more publicly (e.g. a request handler for a
  public endpoint).

@since 1.0.0.0
-}
renderMarshallError :: ErrorDetailLevel -> MarshallError -> String
renderMarshallError :: ErrorDetailLevel -> MarshallError -> String
renderMarshallError ErrorDetailLevel
detailLevel MarshallError
marshallError =
  let
    presentableRowId :: [String]
presentableRowId =
      ((ByteString, SqlValue) -> String)
-> [(ByteString, SqlValue)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
        (ErrorDetailLevel
-> (ErrorDetailLevel -> ShowS) -> (ByteString, SqlValue) -> String
presentSqlColumnValue ErrorDetailLevel
detailLevel ErrorDetailLevel -> ShowS
redactIdentifierValue)
        (MarshallError -> [(ByteString, SqlValue)]
marshallErrorRowIdentifier MarshallError
marshallError)
  in
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"Unable to decode row with identifier ["
      , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
presentableRowId
      , String
"]: "
      , ErrorDetailLevel -> MarshallErrorDetails -> String
renderMarshallErrorDetails ErrorDetailLevel
detailLevel (MarshallError -> MarshallErrorDetails
marshallErrorDetails MarshallError
marshallError)
      ]

{- |
  A internal helper to present a redacted column name and sql value in an error
  message. The redacter function is passed as an argument here so that this
  function can be used to present either ID values or general values as
  required by the context of the caller.

@since 1.0.0.0
-}
presentSqlColumnValue ::
  ErrorDetailLevel ->
  (ErrorDetailLevel -> String -> String) ->
  (B8.ByteString, SqlValue.SqlValue) ->
  String
presentSqlColumnValue :: ErrorDetailLevel
-> (ErrorDetailLevel -> ShowS) -> (ByteString, SqlValue) -> String
presentSqlColumnValue ErrorDetailLevel
detailLevel ErrorDetailLevel -> ShowS
redacter (ByteString
columnName, SqlValue
sqlValue) =
  let
    sqlValueString :: String
sqlValueString =
      ErrorDetailLevel -> ShowS
redacter ErrorDetailLevel
detailLevel ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        case SqlValue -> Maybe PgTextFormatValue
SqlValue.toPgValue SqlValue
sqlValue of
          Maybe PgTextFormatValue
Nothing ->
            String
"NULL"
          Just PgTextFormatValue
pgValue ->
            ByteString -> String
B8.unpack (ByteString -> String)
-> (PgTextFormatValue -> ByteString) -> PgTextFormatValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgTextFormatValue -> ByteString
PgTextFormatValue.toByteString (PgTextFormatValue -> String) -> PgTextFormatValue -> String
forall a b. (a -> b) -> a -> b
$ PgTextFormatValue
pgValue
  in
    ErrorDetailLevel -> ShowS
redactSchemaName ErrorDetailLevel
detailLevel (ByteString -> String
B8.unpack ByteString
columnName)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sqlValueString

{- |
  A 'MarshallErrorDetails' may be returned from
  'Orville.PostgreSQL.Marshall.marshallResultFromSql' if the result set being
  decoded from the database doesn't meet the expectations of the
  'Orville.PostgreSQL.Marshall.SqlMarshaller' that is decoding it.

@since 1.0.0.0
-}
data MarshallErrorDetails
  = -- | Indicates that one or more values in a column could not be decoded,
    -- either individually or as a group.
    DecodingError DecodingErrorDetails
  | -- | Indicates that an expected column was not found in the result set.
    MissingColumnError MissingColumnErrorDetails

{- |
  Renders a 'MarshallErrorDetails' to a 'String' with a specified
  'ErrorDetailLevel'.

@since 1.0.0.0
-}
renderMarshallErrorDetails :: ErrorDetailLevel -> MarshallErrorDetails -> String
renderMarshallErrorDetails :: ErrorDetailLevel -> MarshallErrorDetails -> String
renderMarshallErrorDetails ErrorDetailLevel
detailLevel MarshallErrorDetails
err =
  case MarshallErrorDetails
err of
    DecodingError DecodingErrorDetails
details -> ErrorDetailLevel -> DecodingErrorDetails -> String
renderDecodingErrorDetails ErrorDetailLevel
detailLevel DecodingErrorDetails
details
    MissingColumnError MissingColumnErrorDetails
details -> ErrorDetailLevel -> MissingColumnErrorDetails -> String
renderMissingColumnErrorDetails ErrorDetailLevel
detailLevel MissingColumnErrorDetails
details

{- |
  Details about an error that occurred while decoding values found in a SQL
  result set.

@since 1.0.0.0
-}
data DecodingErrorDetails = DecodingErrorDetails
  { DecodingErrorDetails -> [(ByteString, SqlValue)]
decodingErrorValues :: [(B8.ByteString, SqlValue.SqlValue)]
  , DecodingErrorDetails -> String
decodingErrorMessage :: String
  }

{- |
  Renders a 'DecodingErrorDetails' to a 'String' with a specified
  'ErrorDetailLevel'.

@since 1.0.0.0
-}
renderDecodingErrorDetails :: ErrorDetailLevel -> DecodingErrorDetails -> String
renderDecodingErrorDetails :: ErrorDetailLevel -> DecodingErrorDetails -> String
renderDecodingErrorDetails ErrorDetailLevel
detailLevel DecodingErrorDetails
details =
  let
    presentableErrorValues :: [String]
presentableErrorValues =
      ((ByteString, SqlValue) -> String)
-> [(ByteString, SqlValue)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
        (ErrorDetailLevel
-> (ErrorDetailLevel -> ShowS) -> (ByteString, SqlValue) -> String
presentSqlColumnValue ErrorDetailLevel
detailLevel ErrorDetailLevel -> ShowS
redactNonIdentifierValue)
        (DecodingErrorDetails -> [(ByteString, SqlValue)]
decodingErrorValues DecodingErrorDetails
details)
  in
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"Unable to decode columns from result set: "
      , ErrorDetailLevel -> ShowS
redactErrorMessage ErrorDetailLevel
detailLevel (DecodingErrorDetails -> String
decodingErrorMessage DecodingErrorDetails
details)
      , String
". Value(s) that failed to decode: ["
      , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
presentableErrorValues
      , String
"]"
      ]

{- |
  Details about a column that was found to be missing in a SQL result set
  during decoding.

@since 1.0.0.0
-}
data MissingColumnErrorDetails = MissingColumnErrorDetails
  { MissingColumnErrorDetails -> ByteString
missingColumnName :: B8.ByteString
  , MissingColumnErrorDetails -> Set ByteString
actualColumnNames :: (Set.Set B8.ByteString)
  }

{- |
  Renders a 'MissingColumnErrorDetails' to a 'String' with a specified
  'ErrorDetailLevel'.

@since 1.0.0.0
-}
renderMissingColumnErrorDetails :: ErrorDetailLevel -> MissingColumnErrorDetails -> String
renderMissingColumnErrorDetails :: ErrorDetailLevel -> MissingColumnErrorDetails -> String
renderMissingColumnErrorDetails ErrorDetailLevel
detailLevel MissingColumnErrorDetails
details =
  let
    presentableActualNames :: [String]
presentableActualNames =
      (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
        (ErrorDetailLevel -> ShowS
redactSchemaName ErrorDetailLevel
detailLevel ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack)
        (Set ByteString -> [ByteString]
forall a. Set a -> [a]
Set.toList (Set ByteString -> [ByteString]) -> Set ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ MissingColumnErrorDetails -> Set ByteString
actualColumnNames MissingColumnErrorDetails
details)
  in
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"Column "
      , ErrorDetailLevel -> ShowS
redactSchemaName ErrorDetailLevel
detailLevel (ByteString -> String
B8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ MissingColumnErrorDetails -> ByteString
missingColumnName MissingColumnErrorDetails
details)
      , String
" not found in results set. Actual columns were ["
      , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
presentableActualNames
      , String
"]"
      ]