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
data MarshallError = MarshallError
{ MarshallError -> ErrorDetailLevel
marshallErrorDetailLevel :: ErrorDetailLevel
, MarshallError -> [(ByteString, SqlValue)]
marshallErrorRowIdentifier :: [(B8.ByteString, SqlValue.SqlValue)]
, MarshallError -> MarshallErrorDetails
marshallErrorDetails :: MarshallErrorDetails
}
instance Show MarshallError where
show :: MarshallError -> String
show MarshallError
decodingError =
ErrorDetailLevel -> MarshallError -> String
renderMarshallError
(MarshallError -> ErrorDetailLevel
marshallErrorDetailLevel MarshallError
decodingError)
MarshallError
decodingError
instance Exception MarshallError
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)
]
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
data MarshallErrorDetails
=
DecodingError DecodingErrorDetails
|
MissingColumnError MissingColumnErrorDetails
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
data DecodingErrorDetails = DecodingErrorDetails
{ DecodingErrorDetails -> [(ByteString, SqlValue)]
decodingErrorValues :: [(B8.ByteString, SqlValue.SqlValue)]
, DecodingErrorDetails -> String
decodingErrorMessage :: String
}
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
"]"
]
data MissingColumnErrorDetails = MissingColumnErrorDetails
{ MissingColumnErrorDetails -> ByteString
missingColumnName :: B8.ByteString
, MissingColumnErrorDetails -> Set ByteString
actualColumnNames :: (Set.Set B8.ByteString)
}
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
"]"
]