diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs index e43873e61bd..9d936bc3fe3 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs @@ -10,7 +10,7 @@ module Test.Cardano.Ledger.Conway.Binary.Golden ( expectDecoderResultOn, - expectDecoderFailure, + expectDecoderFailureAnn, listRedeemersEnc, goldenListRedeemers, ) where @@ -50,14 +50,14 @@ import Test.Cardano.Ledger.Common ( ) import Test.Cardano.Ledger.Conway.Era (ConwayEraTest) -expectDecoderFailure :: +expectDecoderFailureAnn :: forall a. (ToExpr a, DecCBOR (Annotator a), Typeable a, HasCallStack) => Version -> Enc -> DecoderError -> Expectation -expectDecoderFailure version enc expectedErr = +expectDecoderFailureAnn version enc expectedErr = case result of Left err -> err `shouldBe` expectedErr Right x -> diff --git a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal b/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal index 9d305f33346..16c8b7f2f24 100644 --- a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal +++ b/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal @@ -140,7 +140,7 @@ library testlib cardano-ledger-allegra:{cardano-ledger-allegra, testlib}, cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib}, cardano-ledger-babbage:{cardano-ledger-babbage, testlib}, - cardano-ledger-binary, + cardano-ledger-binary:{cardano-ledger-binary, testlib}, cardano-ledger-conway:{cardano-ledger-conway, testlib}, cardano-ledger-core:{cardano-ledger-core, testlib}, cardano-ledger-dijkstra, diff --git a/eras/dijkstra/impl/test/Main.hs b/eras/dijkstra/impl/test/Main.hs index cc628db1428..a2c0e16ba12 100644 --- a/eras/dijkstra/impl/test/Main.hs +++ b/eras/dijkstra/impl/test/Main.hs @@ -31,4 +31,4 @@ main = txInfoSpec @DijkstraEra SPlutusV3 txInfoSpec @DijkstraEra SPlutusV4 describe "Golden" $ do - Golden.goldenListRedeemersDisallowed @DijkstraEra + Golden.spec @DijkstraEra diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs index 900315ea9c7..fe850f5557e 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs @@ -1,27 +1,83 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Cardano.Ledger.Dijkstra.Binary.Golden ( - goldenListRedeemersDisallowed, + spec, ) where import Cardano.Ledger.Alonzo.TxWits (Redeemers) -import Cardano.Ledger.Binary (DecoderError (..), DeserialiseFailure (..)) -import Cardano.Ledger.Dijkstra.Core (eraProtVerLow) -import Test.Cardano.Ledger.Common (Spec, it) -import Test.Cardano.Ledger.Conway.Binary.Golden (expectDecoderFailure, listRedeemersEnc) +import Cardano.Ledger.BaseTypes (Version) +import Cardano.Ledger.Binary (DecoderError (..), DeserialiseFailure (..), Tokens (..)) +import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Conway.TxCert (Delegatee (..)) +import Cardano.Ledger.Credential (Credential (..)) +import Cardano.Ledger.Dijkstra.Core ( + EraTxBody (..), + EraTxOut (..), + TxLevel (..), + eraProtVerLow, + pattern DelegTxCert, + ) +import Cardano.Ledger.TxIn (TxIn (..)) +import qualified Data.Set as Set +import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..)) +import Test.Cardano.Ledger.Common (Spec, describe, it) +import Test.Cardano.Ledger.Conway.Binary.Golden (expectDecoderFailureAnn, listRedeemersEnc) +import Test.Cardano.Ledger.Core.KeyPair (mkKeyHash) import Test.Cardano.Ledger.Dijkstra.Era (DijkstraEraTest) +spec :: forall era. DijkstraEraTest era => Spec +spec = describe "Golden" $ do + goldenListRedeemersDisallowed @era + goldenDuplicateCertsDisallowed @era + goldenListRedeemersDisallowed :: forall era. DijkstraEraTest era => Spec goldenListRedeemersDisallowed = it "Decoding Redeemers encoded as a list fails" $ - expectDecoderFailure @(Redeemers era) + expectDecoderFailureAnn @(Redeemers era) (eraProtVerLow @era) listRedeemersEnc ( DecoderErrorDeserialiseFailure "Annotator (MemoBytes (RedeemersRaw DijkstraEra))" (DeserialiseFailure 0 "List encoding of redeemers not supported starting with PV 12") ) + +duplicateCertsTx :: forall era. DijkstraEraTest era => Version -> Enc +duplicateCertsTx v = + mconcat + [ E $ TkMapLen 4 + , Em [E @Int 0, Ev v $ Set.empty @TxIn] + , Em [E @Int 1, Ev v $ [] @(TxOut era)] + , Em [E @Int 2, E $ Coin 0] + , Em + [ E @Int 4 + , Em + [ E $ TkTag 258 + , E $ TkListLen 2 + , Ev v cert + , Ev v cert + ] + ] + ] + where + cert = DelegTxCert @era (KeyHashObj (mkKeyHash 0)) (DelegStake (mkKeyHash 1)) + +goldenDuplicateCertsDisallowed :: forall era. DijkstraEraTest era => Spec +goldenDuplicateCertsDisallowed = + it "Decoding a transaction body with duplicate certificates fails" $ + expectDecoderFailureAnn @(TxBody TopTx era) + version + (duplicateCertsTx @era version) + ( DecoderErrorDeserialiseFailure + "Annotator (MemoBytes (DijkstraTxBodyRaw TopTx DijkstraEra))" + ( DeserialiseFailure + 143 + "Final number of elements: 1 does not match the total count that was decoded: 2" + ) + ) + where + version = eraProtVerLow @era