Skip to content

Commit ad49dac

Browse files
teodanciuteodanciu
committed
Move Twiddle instances from alonzo & babbage-test packages to testlib
as well as the skipped tests to the respective test suites
1 parent ac97691 commit ad49dac

File tree

11 files changed

+207
-192
lines changed

11 files changed

+207
-192
lines changed

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,7 @@ library testlib
110110
Test.Cardano.Ledger.Alonzo.Binary.Cddl
111111
Test.Cardano.Ledger.Alonzo.Binary.CostModelsSpec
112112
Test.Cardano.Ledger.Alonzo.Binary.RoundTrip
113+
Test.Cardano.Ledger.Alonzo.Binary.Twiddle
113114
Test.Cardano.Ledger.Alonzo.Binary.TxWitsSpec
114115
Test.Cardano.Ledger.Alonzo.CDDL
115116
Test.Cardano.Ledger.Alonzo.Era
@@ -145,12 +146,13 @@ library testlib
145146
cardano-data:{cardano-data, testlib},
146147
cardano-ledger-allegra,
147148
cardano-ledger-alonzo,
148-
cardano-ledger-binary,
149+
cardano-ledger-binary:{cardano-ledger-binary, testlib},
149150
cardano-ledger-core:{cardano-ledger-core, testlib},
150151
cardano-ledger-mary:{cardano-ledger-mary, testlib},
151152
cardano-ledger-shelley:{cardano-ledger-shelley, testlib},
152153
cardano-slotting,
153154
cardano-strict-containers,
155+
cborg,
154156
containers,
155157
cuddle >=0.4,
156158
generic-random,

‎eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,19 @@ module Test.Cardano.Ledger.Alonzo.BinarySpec (spec) where
44

55
import Cardano.Ledger.Alonzo
66
import Cardano.Ledger.Alonzo.Genesis
7+
import Cardano.Ledger.Alonzo.Scripts
78
import Cardano.Ledger.Alonzo.TxWits (Redeemers, TxDats)
9+
import Cardano.Ledger.Core
10+
import Cardano.Ledger.MemoBytes (zipMemoRawType)
11+
import Cardano.Ledger.Plutus.Data (BinaryData, Data (..))
812
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
913
import Test.Cardano.Ledger.Alonzo.Binary.RoundTrip (roundTripAlonzoCommonSpec)
14+
import Test.Cardano.Ledger.Alonzo.Binary.Twiddle ()
1015
import Test.Cardano.Ledger.Alonzo.TreeDiff ()
16+
import Test.Cardano.Ledger.Binary.RoundTrip (
17+
roundTripAnnTwiddledProperty,
18+
roundTripTwiddledProperty,
19+
)
1120
import Test.Cardano.Ledger.Common
1221
import Test.Cardano.Ledger.Core.Binary as Binary (
1322
decoderEquivalenceCoreEraTypesSpec,
@@ -22,6 +31,11 @@ spec = do
2231
roundTripAlonzoCommonSpec @AlonzoEra
2332
-- AlonzoGenesis only makes sense in Alonzo era
2433
roundTripEraSpec @AlonzoEra @AlonzoGenesis
34+
xdescribe "Twiddled" $ do
35+
prop "Script" $ roundTripAnnTwiddledProperty @(Script AlonzoEra) eqAlonzoScriptRaw
36+
prop "Data" $ roundTripAnnTwiddledProperty @(Data AlonzoEra) (zipMemoRawType (===))
37+
prop "BinaryData" $ roundTripTwiddledProperty @(BinaryData AlonzoEra)
38+
prop "TxBody" $ roundTripAnnTwiddledProperty @(TxBody AlonzoEra) (zipMemoRawType (===))
2539
describe "DecCBOR instances equivalence" $ do
2640
Binary.decoderEquivalenceCoreEraTypesSpec @AlonzoEra
2741
decoderEquivalenceEraSpec @AlonzoEra @(TxDats AlonzoEra)

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Twiddle.hs‎

Lines changed: 112 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE TupleSections #-}
4+
{-# LANGUAGE UndecidableInstances #-}
5+
{-# OPTIONS_GHC -Wno-orphans #-}
6+
7+
module Test.Cardano.Ledger.Alonzo.Binary.Twiddle () where
8+
9+
import Cardano.Ledger.Alonzo (AlonzoEra)
10+
import Cardano.Ledger.Alonzo.Core
11+
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
12+
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..), TxBody (..))
13+
import Cardano.Ledger.BaseTypes
14+
import Cardano.Ledger.Binary (EncCBOR (..))
15+
import Cardano.Ledger.Coin (Coin)
16+
import Cardano.Ledger.Mary.Value (MultiAsset)
17+
import Cardano.Ledger.Plutus.Data (BinaryData, Data (..))
18+
import Cardano.Ledger.Shelley.PParams (Update)
19+
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert)
20+
import Cardano.Ledger.TxIn (TxIn)
21+
import Cardano.Ledger.Val (Val)
22+
import Codec.CBOR.Term (Term (..))
23+
import Data.Maybe (catMaybes)
24+
import Data.Typeable (Typeable)
25+
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
26+
import Test.Cardano.Ledger.Binary.Twiddle
27+
import Test.Cardano.Ledger.Common
28+
29+
instance (Era era, Val (Value era)) => Twiddle (AlonzoTxOut era) where
30+
twiddle v = twiddle v . toTerm v
31+
32+
instance Twiddle SlotNo where
33+
twiddle v = twiddle v . toTerm v
34+
35+
instance Era era => Twiddle (ShelleyTxCert era) where
36+
twiddle v = twiddle v . toTerm v
37+
38+
instance Twiddle Withdrawals where
39+
twiddle v = twiddle v . toTerm v
40+
41+
instance Twiddle TxAuxDataHash where
42+
twiddle v = twiddle v . toTerm v
43+
44+
instance Twiddle (Update AlonzoEra) where
45+
twiddle v = twiddle v . toTerm v
46+
47+
instance Twiddle MultiAsset where
48+
twiddle v = twiddle v . encodingToTerm v . encCBOR
49+
50+
instance Twiddle ScriptIntegrityHash where
51+
twiddle v = twiddle v . toTerm v
52+
53+
instance Typeable t => Twiddle (KeyHash t) where
54+
twiddle v = twiddle v . toTerm v
55+
56+
instance Twiddle Network where
57+
twiddle v = twiddle v . toTerm v
58+
59+
instance Twiddle TxIn where
60+
twiddle v = twiddle v . toTerm v
61+
62+
instance Twiddle Coin where
63+
twiddle v = twiddle v . toTerm v
64+
65+
instance Twiddle (TxBody AlonzoEra) where
66+
twiddle v txBody = do
67+
inputs' <- twiddle v $ atbInputs txBody
68+
outputs' <- twiddle v $ atbOutputs txBody
69+
fee' <- twiddle v $ atbTxFee txBody
70+
-- Empty collateral can be represented by empty set or the
71+
-- value can be omitted entirely
72+
ttl' <- twiddleStrictMaybe v . invalidHereafter $ atbValidityInterval txBody
73+
cert' <- emptyOrNothing v $ atbCerts txBody
74+
withdrawals' <- twiddle v $ atbWithdrawals txBody
75+
update' <- twiddleStrictMaybe v $ atbUpdate txBody
76+
auxDataHash' <- twiddleStrictMaybe v $ atbAuxDataHash txBody
77+
validityStart' <- twiddleStrictMaybe v . invalidBefore $ atbValidityInterval txBody
78+
mint' <- twiddle v $ atbMint txBody
79+
scriptDataHash' <- twiddleStrictMaybe v $ atbScriptIntegrityHash txBody
80+
collateral' <- emptyOrNothing v $ atbCollateral txBody
81+
requiredSigners' <- emptyOrNothing v $ atbReqSignerHashes txBody
82+
networkId' <- twiddleStrictMaybe v $ atbTxNetworkId txBody
83+
mp <- elements [TMap, TMapI]
84+
let fields =
85+
[ (TInt 0, inputs')
86+
, (TInt 1, outputs')
87+
, (TInt 2, fee')
88+
]
89+
<> catMaybes
90+
[ (TInt 3,) <$> ttl'
91+
, (TInt 4,) <$> cert'
92+
, (TInt 5,) <$> Just withdrawals'
93+
, (TInt 6,) <$> update'
94+
, (TInt 7,) <$> auxDataHash'
95+
, (TInt 8,) <$> validityStart'
96+
, (TInt 9,) <$> Just mint'
97+
, (TInt 11,) <$> scriptDataHash'
98+
, (TInt 13,) <$> collateral'
99+
, (TInt 14,) <$> requiredSigners'
100+
, (TInt 15,) <$> networkId'
101+
]
102+
fields' <- shuffle fields
103+
pure $ mp fields'
104+
105+
instance Twiddle (AlonzoScript AlonzoEra) where
106+
twiddle v = twiddle v . toTerm v
107+
108+
instance Twiddle (Data AlonzoEra) where
109+
twiddle v = twiddle v . toTerm v
110+
111+
instance Twiddle (BinaryData AlonzoEra) where
112+
twiddle v = twiddle v . toTerm v

‎eras/alonzo/test-suite/cardano-ledger-alonzo-test.cabal‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,6 @@ library
5555
cardano-protocol-tpraos >=1.0,
5656
cardano-slotting,
5757
cardano-strict-containers,
58-
cborg,
5958
containers,
6059
microlens,
6160
plutus-ledger-api >=1.33,

‎eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs‎

Lines changed: 0 additions & 104 deletions
Original file line numberDiff line numberDiff line change
@@ -10,109 +10,5 @@
1010

1111
module Test.Cardano.Ledger.Alonzo.Serialisation.Generators where
1212

13-
import Cardano.Ledger.Alonzo (AlonzoEra)
14-
import Cardano.Ledger.Alonzo.Core
15-
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
16-
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..), TxBody (..))
17-
import Cardano.Ledger.BaseTypes
18-
import Cardano.Ledger.Binary (EncCBOR (..))
19-
import Cardano.Ledger.Coin (Coin)
20-
import Cardano.Ledger.Mary.Value (MultiAsset)
21-
import Cardano.Ledger.Plutus.Data (BinaryData, Data (..))
22-
import Cardano.Ledger.Shelley.PParams (Update)
23-
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert)
24-
import Cardano.Ledger.TxIn (TxIn)
25-
import Cardano.Ledger.Val (Val)
26-
import Codec.CBOR.Term (Term (..))
27-
import Data.Maybe (catMaybes)
28-
import Data.Typeable (Typeable)
2913
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
30-
import Test.Cardano.Ledger.Binary.Twiddle
3114
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
32-
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
33-
import Test.QuickCheck
34-
35-
instance (Era era, Val (Value era)) => Twiddle (AlonzoTxOut era) where
36-
twiddle v = twiddle v . toTerm v
37-
38-
instance Twiddle SlotNo where
39-
twiddle v = twiddle v . toTerm v
40-
41-
instance Era era => Twiddle (ShelleyTxCert era) where
42-
twiddle v = twiddle v . toTerm v
43-
44-
instance Twiddle Withdrawals where
45-
twiddle v = twiddle v . toTerm v
46-
47-
instance Twiddle TxAuxDataHash where
48-
twiddle v = twiddle v . toTerm v
49-
50-
instance Twiddle (Update AlonzoEra) where
51-
twiddle v = twiddle v . toTerm v
52-
53-
instance Twiddle MultiAsset where
54-
twiddle v = twiddle v . encodingToTerm v . encCBOR
55-
56-
instance Twiddle ScriptIntegrityHash where
57-
twiddle v = twiddle v . toTerm v
58-
59-
instance Typeable t => Twiddle (KeyHash t) where
60-
twiddle v = twiddle v . toTerm v
61-
62-
instance Twiddle Network where
63-
twiddle v = twiddle v . toTerm v
64-
65-
instance Twiddle TxIn where
66-
twiddle v = twiddle v . toTerm v
67-
68-
instance Twiddle Coin where
69-
twiddle v = twiddle v . toTerm v
70-
71-
instance Twiddle (TxBody AlonzoEra) where
72-
twiddle v txBody = do
73-
inputs' <- twiddle v $ atbInputs txBody
74-
outputs' <- twiddle v $ atbOutputs txBody
75-
fee' <- twiddle v $ atbTxFee txBody
76-
-- Empty collateral can be represented by empty set or the
77-
-- value can be omitted entirely
78-
ttl' <- twiddleStrictMaybe v . invalidHereafter $ atbValidityInterval txBody
79-
cert' <- emptyOrNothing v $ atbCerts txBody
80-
withdrawals' <- twiddle v $ atbWithdrawals txBody
81-
update' <- twiddleStrictMaybe v $ atbUpdate txBody
82-
auxDataHash' <- twiddleStrictMaybe v $ atbAuxDataHash txBody
83-
validityStart' <- twiddleStrictMaybe v . invalidBefore $ atbValidityInterval txBody
84-
mint' <- twiddle v $ atbMint txBody
85-
scriptDataHash' <- twiddleStrictMaybe v $ atbScriptIntegrityHash txBody
86-
collateral' <- emptyOrNothing v $ atbCollateral txBody
87-
requiredSigners' <- emptyOrNothing v $ atbReqSignerHashes txBody
88-
networkId' <- twiddleStrictMaybe v $ atbTxNetworkId txBody
89-
mp <- elements [TMap, TMapI]
90-
let fields =
91-
[ (TInt 0, inputs')
92-
, (TInt 1, outputs')
93-
, (TInt 2, fee')
94-
]
95-
<> catMaybes
96-
[ (TInt 3,) <$> ttl'
97-
, (TInt 4,) <$> cert'
98-
, (TInt 5,) <$> Just withdrawals'
99-
, (TInt 6,) <$> update'
100-
, (TInt 7,) <$> auxDataHash'
101-
, (TInt 8,) <$> validityStart'
102-
, (TInt 9,) <$> Just mint'
103-
, (TInt 11,) <$> scriptDataHash'
104-
, (TInt 13,) <$> collateral'
105-
, (TInt 14,) <$> requiredSigners'
106-
, (TInt 15,) <$> networkId'
107-
]
108-
fields' <- shuffle fields
109-
pure $ mp fields'
110-
111-
instance Twiddle (AlonzoScript AlonzoEra) where
112-
twiddle v = twiddle v . toTerm v
113-
114-
instance Twiddle (Data AlonzoEra) where
115-
twiddle v = twiddle v . toTerm v
116-
117-
instance Twiddle (BinaryData AlonzoEra) where
118-
twiddle v = twiddle v . toTerm v

‎eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs‎

Lines changed: 1 addition & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -15,11 +15,8 @@ import Cardano.Ledger.Alonzo.Rules (
1515
AlonzoUtxosPredFailure,
1616
AlonzoUtxowPredFailure,
1717
)
18-
import Cardano.Ledger.Alonzo.Scripts (eqAlonzoScriptRaw)
1918
import Cardano.Ledger.Block (Block)
2019
import Cardano.Ledger.Core
21-
import Cardano.Ledger.MemoBytes (zipMemoRawType)
22-
import Cardano.Ledger.Plutus.Data (BinaryData, Data (..))
2320
import Cardano.Protocol.Crypto (StandardCrypto)
2421
import Cardano.Protocol.TPraos.BHeader (BHeader)
2522
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
@@ -35,19 +32,7 @@ tests :: TestTree
3532
tests =
3633
testGroup
3734
"Alonzo CBOR round-trip"
38-
[ skip $
39-
testProperty "alonzo/Script twiddled" $
40-
roundTripAnnTwiddledProperty @(Script AlonzoEra) eqAlonzoScriptRaw
41-
, skip $
42-
testProperty "alonzo/Data twiddled" $
43-
roundTripAnnTwiddledProperty @(Data AlonzoEra) (zipMemoRawType (===))
44-
, skip $
45-
testProperty "alonzo/BinaryData twiddled" $
46-
roundTripTwiddledProperty @(BinaryData AlonzoEra)
47-
, skip $
48-
testProperty "alonzo/TxBody twiddled" $
49-
roundTripAnnTwiddledProperty @(TxBody AlonzoEra) (zipMemoRawType (===))
50-
, testProperty "alonzo/AlonzoUtxowPredFailure" $
35+
[ testProperty "alonzo/AlonzoUtxowPredFailure" $
5136
roundTripCborExpectation @(AlonzoUtxowPredFailure AlonzoEra)
5237
, testProperty "alonzo/AlonzoUtxoPredFailure" $
5338
roundTripCborExpectation @(AlonzoUtxoPredFailure AlonzoEra)
@@ -62,5 +47,3 @@ tests =
6247
(eraProtVerLow @AlonzoEra)
6348
(eraProtVerHigh @AlonzoEra)
6449
]
65-
where
66-
skip _ = testProperty "Test skipped" True

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -102,6 +102,7 @@ library testlib
102102
Test.Cardano.Ledger.Babbage.Arbitrary
103103
Test.Cardano.Ledger.Babbage.Binary.Annotator
104104
Test.Cardano.Ledger.Babbage.Binary.Cddl
105+
Test.Cardano.Ledger.Babbage.Binary.Twiddle
105106
Test.Cardano.Ledger.Babbage.CDDL
106107
Test.Cardano.Ledger.Babbage.Era
107108
Test.Cardano.Ledger.Babbage.Imp
@@ -130,7 +131,7 @@ library testlib
130131
bytestring,
131132
cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
132133
cardano-ledger-babbage,
133-
cardano-ledger-binary,
134+
cardano-ledger-binary:{cardano-ledger-binary, testlib},
134135
cardano-ledger-core:{cardano-ledger-core, testlib} >=1.13.2,
135136
cardano-ledger-shelley,
136137
cardano-strict-containers,

0 commit comments

Comments
 (0)