Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@

module Test.Cardano.Ledger.Conway.Binary.Golden (
expectDecoderResultOn,
expectDecoderFailure,
expectDecoderFailureAnn,
listRedeemersEnc,
goldenListRedeemers,
) where
Expand Down Expand Up @@ -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 ->
Expand Down
2 changes: 1 addition & 1 deletion eras/dijkstra/impl/cardano-ledger-dijkstra.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion eras/dijkstra/impl/test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,4 +31,4 @@ main =
txInfoSpec @DijkstraEra SPlutusV3
txInfoSpec @DijkstraEra SPlutusV4
describe "Golden" $ do
Golden.goldenListRedeemersDisallowed @DijkstraEra
Golden.spec @DijkstraEra
Original file line number Diff line number Diff line change
@@ -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