{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unused-foralls #-}

module Test.Cardano.Ledger.Conway.Binary.Golden (
  spec,
  listRedeemersEnc,
  goldenListRedeemers,
  witsEmptyFieldWithSetTag,
  conwayDecodeDuplicateDelegCertFails,
  expectFailureOnTxWitsEmptyFieldWithTag,
  module Test.Cardano.Ledger.Alonzo.Binary.Golden,
) where

import Cardano.Ledger.Alonzo.Core (
  AsIx (..),
  EraTxWits (..),
  TxLevel (..),
  eraProtVerLow,
  pattern SpendingPurpose,
 )
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..), unRedeemers)
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR,
  DecoderError (..),
  DeserialiseFailure (..),
  Version,
 )
import qualified Cardano.Ledger.Binary as Binary
import Cardano.Ledger.Binary.Plain (Tokens (..))
import Cardano.Ledger.Conway.Core (
  EraTxBody (..),
 )
import Cardano.Ledger.Plutus (Data (..))
import qualified Data.Map as Map
import Data.Proxy (Proxy (..))
import Data.Void (Void)
import PlutusLedgerApi.Common (Data (..))
import Test.Cardano.Ledger.Alonzo.Binary.Golden hiding (spec)
import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..))
import Test.Cardano.Ledger.Common (
  Expectation,
  Spec,
  ToExpr,
  describe,
  it,
 )
import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
import Test.Cardano.Ledger.Imp.Common (forEachEraVersion)

-- | A simple redeemer encoded as a list
listRedeemersEnc :: Enc
listRedeemersEnc :: Enc
listRedeemersEnc =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
1)
    , [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
4)
        , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
0 :: Int)
        , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
10 :: Int)
        , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
20 :: Int)
        , [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
            [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
2)
            , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
30 :: Int)
            , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
40 :: Int)
            ]
        ]
    ]

goldenListRedeemers :: forall era. ConwayEraTest era => Spec
goldenListRedeemers :: forall era. ConwayEraTest era => Spec
goldenListRedeemers =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding Redeemers encoded as a list succeeds" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(Redeemers era)
      (forall era. Era era => Version
eraProtVerLow @era)
      Enc
listRedeemersEnc
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Redeemers era
forall a b. (a -> b) -> a -> b
$ PlutusPurpose AsIx era
-> (Data era, ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. k -> a -> Map k a
Map.singleton (AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose (AsIx Word32 TxIn -> PlutusPurpose AsIx era)
-> AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
10) (Data -> Data era
forall era. Era era => Data -> Data era
Data (Data -> Data era) -> Data -> Data era
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
20, Natural -> Natural -> ExUnits
ExUnits Natural
30 Natural
40))
      Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers

witsEmptyFieldWithSetTag :: Int -> Enc
witsEmptyFieldWithSetTag :: Int -> Enc
witsEmptyFieldWithSetTag 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
    , (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
TkTag Word
258
    , forall a. ToCBOR a => a -> Enc
E @[Void] []
    ]

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

conwayDecodeDuplicateDelegCertFails ::
  forall era. ConwayEraTest era => Version -> Spec
conwayDecodeDuplicateDelegCertFails :: forall era. ConwayEraTest era => Version -> Spec
conwayDecodeDuplicateDelegCertFails Version
version =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding duplicate delegation certs fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ do
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxBody TopTx era) Version
version (forall era. ShelleyEraTest era => Version -> Enc
duplicateDelegCertsTxBody @era Version
version) (DecoderError -> Expectation) -> DecoderError -> Expectation
forall a b. (a -> b) -> a -> b
$
      Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
        (Proxy (Annotator (TxBody TopTx era)) -> Text
forall a. DecCBOR a => Proxy a -> Text
Binary.label (Proxy (Annotator (TxBody TopTx era)) -> Text)
-> Proxy (Annotator (TxBody TopTx era)) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator (TxBody TopTx era)))
        ( ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure
            ByteOffset
144
            String
"Final number of elements: 1 does not match the total count that was decoded: 2"
        )

spec :: forall era. ConwayEraTest era => Spec
spec :: forall era. ConwayEraTest 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
$
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Empty fields not allowed" (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
        let
          decoderFailure :: ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
n String
msg =
            Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
              (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)))
              (ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure ByteOffset
n String
msg)
        String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Untagged" (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 -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
0 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"nativeScripts" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
1 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"bootstrapWitness" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
2 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV1Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
3 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list of scripts is not allowed"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusData" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
4 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"redeemers" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
5 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV2Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
6 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list of scripts is not allowed"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV3Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
7 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list of scripts is not allowed"
        String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Tagged" (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 -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
0 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"nativeScripts" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
1 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"bootstrapWitness" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
2 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV1Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
3 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list of scripts is not allowed"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusData" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
4 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list found, expected non-empty"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV2Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
6 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list of scripts is not allowed"
          String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV3Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
7 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
            ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list of scripts is not allowed"
        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)
-> ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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. ConwayEraTest era => Version -> Spec
conwayDecodeDuplicateDelegCertFails @era