{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Alonzo.Binary.Golden (
  spec,
  witsEmptyField,
  expectFailureOnTxWitsEmptyField,
  txWitsDecodingFailsOnInvalidField,
  module Test.Cardano.Ledger.Allegra.Binary.Golden,
) where

import Cardano.Ledger.Alonzo.Core (EraTxWits (..), ShelleyEraTxCert)
import Cardano.Ledger.Binary (
  Annotator,
  DecoderError (..),
  DeserialiseFailure (..),
  Tokens (..),
  Version,
 )
import qualified Cardano.Ledger.Binary as Binary
import Cardano.Ledger.MemoBytes (EqRaw (..))
import Data.Data (Proxy (..))
import Data.Void (Void)
import Test.Cardano.Ledger.Allegra.Binary.Golden hiding (spec)
import Test.Cardano.Ledger.Alonzo.Era (AlonzoEraTest)
import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..))
import Test.Cardano.Ledger.Common (
  Expectation,
  Spec,
  describe,
  it,
  prop,
  (==>),
 )
import Test.Cardano.Ledger.Imp.Common (forEachEraVersion)

witsEmptyField :: Int -> Enc
witsEmptyField :: Int -> Enc
witsEmptyField Int
k =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
1
    , Int -> Enc
forall a. ToCBOR a => a -> Enc
E Int
k
    , forall a. ToCBOR a => a -> Enc
E @[Void] []
    ]

expectFailureOnTxWitsEmptyField ::
  forall era.
  AlonzoEraTest era =>
  Version ->
  Int ->
  DecoderError ->
  Expectation
expectFailureOnTxWitsEmptyField :: forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField Version
version Int
k =
  forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era) Version
version (Int -> Enc
witsEmptyField Int
k)

expectSuccessOnEmptyFieldRaw ::
  forall era.
  AlonzoEraTest era =>
  Version ->
  Int ->
  Expectation
expectSuccessOnEmptyFieldRaw :: forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw Version
version Int
k =
  (TxWits era -> TxWits era -> Bool)
-> Version -> Enc -> TxWits era -> Expectation
forall a.
(DecCBOR (Annotator a), HasCallStack, Show a, Eq a) =>
(a -> a -> Bool) -> Version -> Enc -> a -> Expectation
expectDecoderSuccessAnnWith TxWits era -> TxWits era -> Bool
forall a. EqRaw a => a -> a -> Bool
eqRaw Version
version (Int -> Enc
witsEmptyField Int
k) (forall era. EraTxWits era => TxWits era
mkBasicTxWits @era)

txWitsDecodingFailsOnInvalidField :: forall era. AlonzoEraTest era => Version -> [Int] -> Spec
txWitsDecodingFailsOnInvalidField :: forall era. AlonzoEraTest era => Version -> [Int] -> Spec
txWitsDecodingFailsOnInvalidField Version
version [Int]
validFields =
  String -> (Int -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Invalid field" ((Int -> Property) -> Spec) -> (Int -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \Int
n ->
    Int
n
      Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
validFields
        Bool -> Expectation -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
n
      (DecoderError -> Expectation) -> DecoderError -> Expectation
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then
          Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
            Text
lbl
            ( ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
24 then ByteOffset
3 else ByteOffset
2) (String -> DeserialiseFailure) -> String -> DeserialiseFailure
forall a b. (a -> b) -> a -> b
$
                -- TODO fix the `occured` typo in the produced value
                String
"An error occured while decoding (Int,Void) not a valid key:.\nError: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
            )
        else
          Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure Text
lbl (ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure ByteOffset
1 String
"expected word")
  where
    lbl :: Text
lbl = Proxy (Annotator (TxWits era)) -> Text
forall a. DecCBOR a => Proxy a -> Text
Binary.label (Proxy (Annotator (TxWits era)) -> Text)
-> Proxy (Annotator (TxWits era)) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator (TxWits era))

spec ::
  forall era.
  (AlonzoEraTest era, ShelleyEraTxCert era) =>
  Spec
spec :: forall era. (AlonzoEraTest era, ShelleyEraTxCert era) => Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxWits" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. (Era era, HasCallStack) => (Version -> Spec) -> Spec
forEachEraVersion @era ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \Version
version -> do
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Empty fields allowed" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"addrTxWits" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
0
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"nativeScripts" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
1
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"bootstrapWitness" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
2
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV1Script" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
3
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusData" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
4
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"redeemers" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
5
        -- Fields 6 and 7 should not deserialize, but they do due to a bug in the Alonzo decoder
        -- This should not be a problem starting with PV9, because we won't allow empty lists
        -- from there onwards
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV2Script" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
6
        String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV3Script" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraTest era => Version -> Int -> Expectation
expectSuccessOnEmptyFieldRaw @era Version
version Int
7
      forall era. AlonzoEraTest era => Version -> [Int] -> Spec
txWitsDecodingFailsOnInvalidField @era Version
version [Int
0 .. Int
7]
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxCerts" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. (Era era, HasCallStack) => (Version -> Spec) -> Spec
forEachEraVersion @era ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ forall era.
(AllegraEraTest era, ShelleyEraTxCert era) =>
Version -> Spec
allegraDecodeDuplicateDelegCertSucceeds @era