Skip to content

Commit 9f7ccde

Browse files
SoupstrawSoupstraw
committed
Added tests for list Redeemers
1 parent 2e1e3ba commit 9f7ccde

File tree

6 files changed

+142
-1
lines changed

6 files changed

+142
-1
lines changed

‎eras/conway/impl/cardano-ledger-conway.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -127,6 +127,7 @@ library testlib
127127
Test.Cardano.Ledger.Conway.Arbitrary
128128
Test.Cardano.Ledger.Conway.Binary.Annotator
129129
Test.Cardano.Ledger.Conway.Binary.Cddl
130+
Test.Cardano.Ledger.Conway.Binary.Golden
130131
Test.Cardano.Ledger.Conway.Binary.Regression
131132
Test.Cardano.Ledger.Conway.Binary.RoundTrip
132133
Test.Cardano.Ledger.Conway.BinarySpec

‎eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs‎

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,107 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE LambdaCase #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE PatternSynonyms #-}
6+
{-# LANGUAGE RankNTypes #-}
7+
{-# LANGUAGE ScopedTypeVariables #-}
8+
{-# LANGUAGE TypeApplications #-}
9+
{-# OPTIONS_GHC -Wno-unused-foralls #-}
10+
11+
module Test.Cardano.Ledger.Conway.Binary.Golden (
12+
expectDecoderResultOn,
13+
expectDecoderFailure,
14+
listRedeemersEnc,
15+
goldenListRedeemers,
16+
) where
17+
18+
import Cardano.Ledger.Alonzo.Core (
19+
AsIx (..),
20+
eraProtVerLow,
21+
pattern SpendingPurpose,
22+
)
23+
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
24+
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
25+
import Cardano.Ledger.BaseTypes (Version)
26+
import Cardano.Ledger.Binary (
27+
Annotator (..),
28+
DecCBOR (..),
29+
ToCBOR (..),
30+
decodeFullAnnotator,
31+
toStrictByteString,
32+
)
33+
import Cardano.Ledger.Binary.Plain (DecoderError (..), Tokens (..))
34+
import Cardano.Ledger.Plutus (Data (..))
35+
import Data.ByteString (fromStrict)
36+
import qualified Data.Map as Map
37+
import Data.Typeable (Proxy (..), Typeable)
38+
import PlutusLedgerApi.Common (Data (..))
39+
import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..))
40+
import Test.Cardano.Ledger.Common (
41+
Expectation,
42+
Spec,
43+
ToExpr,
44+
expectationFailure,
45+
it,
46+
shouldBe,
47+
shouldBeExpr,
48+
showExpr,
49+
)
50+
import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
51+
52+
expectDecoderFailure ::
53+
forall a.
54+
(ToExpr a, DecCBOR (Annotator a), Typeable a) =>
55+
Version ->
56+
Enc ->
57+
DecoderError ->
58+
Expectation
59+
expectDecoderFailure version enc expectedErr =
60+
case result of
61+
Left err -> err `shouldBe` expectedErr
62+
Right x ->
63+
expectationFailure $
64+
"Expected a failure, but decoder succeeded:\n"
65+
<> showExpr x
66+
where
67+
bytes = fromStrict . toStrictByteString $ toCBOR enc
68+
result = decodeFullAnnotator @a version (label $ Proxy @(Annotator a)) decCBOR bytes
69+
70+
expectDecoderResultOn ::
71+
forall a b.
72+
(ToExpr b, DecCBOR (Annotator a), Typeable a, Eq b) =>
73+
Version -> Enc -> a -> (a -> b) -> Expectation
74+
expectDecoderResultOn version enc expected f =
75+
case result of
76+
Left err -> expectationFailure $ "Decoder failed with:\n" <> show err
77+
Right x -> f x `shouldBeExpr` f expected
78+
where
79+
bytes = fromStrict . toStrictByteString $ toCBOR enc
80+
result = decodeFullAnnotator @a version (label $ Proxy @(Annotator a)) decCBOR bytes
81+
82+
-- | A simple redeemer encoded as a list
83+
listRedeemersEnc :: Enc
84+
listRedeemersEnc =
85+
mconcat
86+
[ E (TkListLen 1)
87+
, mconcat
88+
[ E (TkListLen 4)
89+
, E (0 :: Int)
90+
, E (0 :: Int)
91+
, E (0 :: Int)
92+
, mconcat
93+
[ E (TkListLen 2)
94+
, E (0 :: Int)
95+
, E (0 :: Int)
96+
]
97+
]
98+
]
99+
100+
goldenListRedeemers :: forall era. ConwayEraTest era => Spec
101+
goldenListRedeemers =
102+
it "Decoding Redeemers encoded as a list succeeds" $
103+
expectDecoderResultOn @(Redeemers era)
104+
(eraProtVerLow @era)
105+
listRedeemersEnc
106+
(Redeemers $ Map.singleton (SpendingPurpose $ AsIx 0) (Data $ I 0, ExUnits 0 0))
107+
(\(Redeemers m) -> m)

‎eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Spec.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import qualified Test.Cardano.Ledger.Alonzo.Binary.CostModelsSpec as CostModelsS
2020
import qualified Test.Cardano.Ledger.Alonzo.Binary.TxWitsSpec as TxWitsSpec
2121
import qualified Test.Cardano.Ledger.Babbage.TxInfoSpec as BabbageTxInfo
2222
import Test.Cardano.Ledger.Common
23+
import qualified Test.Cardano.Ledger.Conway.Binary.Golden as Golden
2324
import qualified Test.Cardano.Ledger.Conway.Binary.Regression as Regression
2425
import qualified Test.Cardano.Ledger.Conway.BinarySpec as Binary
2526
import qualified Test.Cardano.Ledger.Conway.CommitteeRatifySpec as CommitteeRatify
@@ -60,3 +61,4 @@ spec =
6061
BabbageTxInfo.spec @era
6162
describe "PlutusV3" $
6263
BabbageTxInfo.txInfoSpec @era SPlutusV3
64+
describe "Golden" $ Golden.goldenListRedeemers @era

‎eras/dijkstra/impl/cardano-ledger-dijkstra.cabal‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,7 @@ library testlib
110110
Test.Cardano.Ledger.Dijkstra.Arbitrary
111111
Test.Cardano.Ledger.Dijkstra.Binary.Annotator
112112
Test.Cardano.Ledger.Dijkstra.Binary.Cddl
113+
Test.Cardano.Ledger.Dijkstra.Binary.Golden
113114
Test.Cardano.Ledger.Dijkstra.Binary.RoundTrip
114115
Test.Cardano.Ledger.Dijkstra.CDDL
115116
Test.Cardano.Ledger.Dijkstra.Era
@@ -135,7 +136,7 @@ library testlib
135136
bytestring,
136137
cardano-data,
137138
cardano-ledger-allegra:{cardano-ledger-allegra, testlib},
138-
cardano-ledger-alonzo:testlib,
139+
cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
139140
cardano-ledger-babbage:{cardano-ledger-babbage, testlib},
140141
cardano-ledger-binary,
141142
cardano-ledger-conway:{cardano-ledger-conway, testlib},

‎eras/dijkstra/impl/test/Main.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ import qualified Test.Cardano.Ledger.Babbage.TxInfoSpec as BabbageTxInfo
1010
import Test.Cardano.Ledger.Common
1111
import Test.Cardano.Ledger.Dijkstra.Binary.Annotator ()
1212
import qualified Test.Cardano.Ledger.Dijkstra.Binary.CddlSpec as Cddl
13+
import qualified Test.Cardano.Ledger.Dijkstra.Binary.Golden as Golden
1314
import Test.Cardano.Ledger.Dijkstra.Binary.RoundTrip ()
1415
import qualified Test.Cardano.Ledger.Dijkstra.GoldenSpec as GoldenSpec
1516
import qualified Test.Cardano.Ledger.Dijkstra.Imp as Imp
@@ -29,3 +30,5 @@ main =
2930
BabbageTxInfo.spec @DijkstraEra
3031
txInfoSpec @DijkstraEra SPlutusV3
3132
txInfoSpec @DijkstraEra SPlutusV4
33+
describe "Golden" $ do
34+
Golden.goldenListRedeemersDisallowed @DijkstraEra

‎eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
6+
7+
module Test.Cardano.Ledger.Dijkstra.Binary.Golden (
8+
goldenListRedeemersDisallowed,
9+
) where
10+
11+
import Cardano.Ledger.Alonzo.TxWits (Redeemers)
12+
import Cardano.Ledger.Binary (DecoderError (..), DeserialiseFailure (..))
13+
import Cardano.Ledger.Dijkstra.Core (eraProtVerLow)
14+
import Test.Cardano.Ledger.Common (Spec, it)
15+
import Test.Cardano.Ledger.Conway.Binary.Golden (expectDecoderFailure, listRedeemersEnc)
16+
import Test.Cardano.Ledger.Dijkstra.Era (DijkstraEraTest)
17+
18+
goldenListRedeemersDisallowed :: forall era. DijkstraEraTest era => Spec
19+
goldenListRedeemersDisallowed =
20+
it "Decoding Redeemers encoded as a list fails" $
21+
expectDecoderFailure @(Redeemers era)
22+
(eraProtVerLow @era)
23+
listRedeemersEnc
24+
( DecoderErrorDeserialiseFailure
25+
"Annotator (MemoBytes (RedeemersRaw DijkstraEra))"
26+
(DeserialiseFailure 0 "List encoding of redeemers not supported starting with PV 12")
27+
)

0 commit comments

Comments
 (0)