module Test.MarshallError
  ( marshallErrorTests,
  )
where

import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as B8
import qualified Data.Pool as Pool
import qualified Data.Set as Set
import qualified Data.Text as T
import Hedgehog ((===))
import qualified Hedgehog as HH
import qualified Hedgehog.Gen as Gen

import qualified Orville.PostgreSQL as Orville
import qualified Orville.PostgreSQL.Connection as Connection
import qualified Orville.PostgreSQL.Internal.ErrorDetailLevel as ErrorDetailLevel
import qualified Orville.PostgreSQL.Internal.MarshallError as MarshallError
import qualified Orville.PostgreSQL.Internal.RawSql as RawSql
import qualified Orville.PostgreSQL.Internal.SqlValue as SqlValue

import qualified Test.Property as Property

marshallErrorTests :: Pool.Pool Connection.Connection -> Property.Group
marshallErrorTests pool =
  Property.group
    "MarshallError"
    [ prop_renderDecodingErrorWithFullDetails
    , prop_renderDecodingErrorWithoutSchemaNames
    , prop_renderDecodingErrorWithoutRowIdValues
    , prop_renderDecodingErrorWithoutNonIdValues
    , prop_renderDecodingErrorWithoutErrorMessage
    , prop_renderMissingErrorDetailsWithFullDetails
    , prop_renderMissingErrorDetailsWithoutSchemaNames
    , prop_showMarshallErrorRaisedFromOrvilleContext pool
    ]

{- |
  Shared example used to test error detail level rendering of decoding errors
  below.
-}
exampleDecodingError :: MarshallError.MarshallError
exampleDecodingError =
  MarshallError.MarshallError
    { MarshallError.marshallErrorDetailLevel = ErrorDetailLevel.minimalErrorDetailLevel
    , MarshallError.marshallErrorRowIdentifier = [(B8.pack "foo", SqlValue.fromInt8 1)]
    , MarshallError.marshallErrorDetails =
        MarshallError.DecodingError $
          MarshallError.DecodingErrorDetails
            { MarshallError.decodingErrorValues = [(B8.pack "bar", SqlValue.fromText (T.pack "baz"))]
            , MarshallError.decodingErrorMessage = "Failure"
            }
    }

prop_renderDecodingErrorWithFullDetails :: Property.NamedProperty
prop_renderDecodingErrorWithFullDetails =
  Property.singletonNamedProperty "Render decoding error with full details" $
    let rendered =
          MarshallError.renderMarshallError
            ErrorDetailLevel.maximalErrorDetailLevel
            exampleDecodingError
     in rendered
          === "Unable to decode row with identifier [foo = 1]: \
              \Unable to decode columns from result set: Failure. \
              \Value(s) that failed to decode: [bar = baz]"

prop_renderDecodingErrorWithoutSchemaNames :: Property.NamedProperty
prop_renderDecodingErrorWithoutSchemaNames =
  Property.singletonNamedProperty "Render decoding error without schema names" $
    let rendered =
          MarshallError.renderMarshallError
            ( ErrorDetailLevel.maximalErrorDetailLevel
                { ErrorDetailLevel.includeSchemaNames = False
                }
            )
            exampleDecodingError
     in rendered
          === "Unable to decode row with identifier [[REDACTED] = 1]: \
              \Unable to decode columns from result set: Failure. \
              \Value(s) that failed to decode: [[REDACTED] = baz]"

prop_renderDecodingErrorWithoutRowIdValues :: Property.NamedProperty
prop_renderDecodingErrorWithoutRowIdValues =
  Property.singletonNamedProperty "Render decoding error without row id values" $
    let rendered =
          MarshallError.renderMarshallError
            ( ErrorDetailLevel.maximalErrorDetailLevel
                { ErrorDetailLevel.includeRowIdentifierValues = False
                }
            )
            exampleDecodingError
     in rendered
          === "Unable to decode row with identifier [foo = [REDACTED]]: \
              \Unable to decode columns from result set: Failure. \
              \Value(s) that failed to decode: [bar = baz]"

prop_renderDecodingErrorWithoutNonIdValues :: Property.NamedProperty
prop_renderDecodingErrorWithoutNonIdValues =
  Property.singletonNamedProperty "Render decoding error without non id values" $
    let rendered =
          MarshallError.renderMarshallError
            ( ErrorDetailLevel.maximalErrorDetailLevel
                { ErrorDetailLevel.includeNonIdentifierValues = False
                }
            )
            exampleDecodingError
     in rendered
          === "Unable to decode row with identifier [foo = 1]: \
              \Unable to decode columns from result set: Failure. \
              \Value(s) that failed to decode: [bar = [REDACTED]]"

prop_renderDecodingErrorWithoutErrorMessage :: Property.NamedProperty
prop_renderDecodingErrorWithoutErrorMessage =
  Property.singletonNamedProperty "Render decoding error without non id values" $
    let rendered =
          MarshallError.renderMarshallError
            ( ErrorDetailLevel.maximalErrorDetailLevel
                { ErrorDetailLevel.includeErrorMessage = False
                }
            )
            exampleDecodingError
     in rendered
          === "Unable to decode row with identifier [foo = 1]: \
              \Unable to decode columns from result set: [REDACTED]. \
              \Value(s) that failed to decode: [bar = baz]"

{- |
  Shared example used to test error detail level rendering of missing column
  errors below.
-}
exampleMissingColumnError :: MarshallError.MarshallError
exampleMissingColumnError =
  MarshallError.MarshallError
    { MarshallError.marshallErrorDetailLevel = ErrorDetailLevel.minimalErrorDetailLevel
    , MarshallError.marshallErrorRowIdentifier = [(B8.pack "foo", SqlValue.fromInt8 1)]
    , MarshallError.marshallErrorDetails =
        MarshallError.MissingColumnError $
          MarshallError.MissingColumnErrorDetails
            { MarshallError.missingColumnName = B8.pack "baz"
            , MarshallError.actualColumnNames = Set.fromList [B8.pack "foo", B8.pack "bar"]
            }
    }

prop_renderMissingErrorDetailsWithFullDetails :: Property.NamedProperty
prop_renderMissingErrorDetailsWithFullDetails =
  Property.singletonNamedProperty "Render missing column error with full details" $
    let rendered =
          MarshallError.renderMarshallError
            ErrorDetailLevel.maximalErrorDetailLevel
            exampleMissingColumnError
     in rendered
          === "Unable to decode row with identifier [foo = 1]: \
              \Column baz not found in results set. \
              \Actual columns were [bar, foo]"

prop_renderMissingErrorDetailsWithoutSchemaNames :: Property.NamedProperty
prop_renderMissingErrorDetailsWithoutSchemaNames =
  Property.singletonNamedProperty "Render missing column error without schema names" $
    let rendered =
          MarshallError.renderMarshallError
            ( ErrorDetailLevel.maximalErrorDetailLevel
                { ErrorDetailLevel.includeSchemaNames = False
                }
            )
            exampleMissingColumnError
     in rendered
          === "Unable to decode row with identifier [[REDACTED] = 1]: \
              \Column [REDACTED] not found in results set. \
              \Actual columns were [[REDACTED], [REDACTED]]"

prop_showMarshallErrorRaisedFromOrvilleContext :: Property.NamedDBProperty
prop_showMarshallErrorRaisedFromOrvilleContext =
  Property.namedDBProperty "Showing a MarshallError raised from an Orville context" $ \pool -> do
    errorDetailLevel <- HH.forAll generateErrorDetailLevel

    let sql =
          RawSql.fromString "SELECT 1 as id, 'notAnNumber' as number"

        marshaller =
          Orville.annotateSqlMarshaller [Orville.stringToFieldName "id"] $
            Orville.marshallField id (Orville.integerField "number")

        orvilleState =
          Orville.newOrvilleState errorDetailLevel pool

    result <-
      HH.evalIO $ do
        E.try . Orville.runOrvilleWithState orvilleState $ do
          Orville.executeAndDecode sql marshaller

    case result of
      Right _ -> do
        HH.annotate "Expected decoding result set to fail, but it did not"
        HH.failure
      Left marshallError ->
        show marshallError
          === MarshallError.renderMarshallError errorDetailLevel marshallError

generateErrorDetailLevel :: HH.Gen ErrorDetailLevel.ErrorDetailLevel
generateErrorDetailLevel =
  ErrorDetailLevel.ErrorDetailLevel
    <$> Gen.bool
    <*> Gen.bool
    <*> Gen.bool
    <*> Gen.bool
