Skip to content

Commit 14b466c

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 2c65b99 commit 14b466c

File tree

7 files changed

+191
-185
lines changed

7 files changed

+191
-185
lines changed

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -111,6 +111,7 @@ library testlib
111111
Test.Cardano.Ledger.Alonzo.Binary.CostModelsSpec
112112
Test.Cardano.Ledger.Alonzo.Binary.RoundTrip
113113
Test.Cardano.Ledger.Alonzo.Binary.TxWitsSpec
114+
Test.Cardano.Ledger.Alonzo.Binary.Twiddle
114115
Test.Cardano.Ledger.Alonzo.CDDL
115116
Test.Cardano.Ledger.Alonzo.Era
116117
Test.Cardano.Ledger.Alonzo.Imp
@@ -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/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/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 & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -35,19 +35,7 @@ tests :: TestTree
3535
tests =
3636
testGroup
3737
"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" $
38+
[ testProperty "alonzo/AlonzoUtxowPredFailure" $
5139
roundTripCborExpectation @(AlonzoUtxowPredFailure AlonzoEra)
5240
, testProperty "alonzo/AlonzoUtxoPredFailure" $
5341
roundTripCborExpectation @(AlonzoUtxoPredFailure AlonzoEra)
@@ -62,5 +50,3 @@ tests =
6250
(eraProtVerLow @AlonzoEra)
6351
(eraProtVerHigh @AlonzoEra)
6452
]
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,

‎eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Binary/Twiddle.hs‎

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE TupleSections #-}
4+
{-# LANGUAGE UndecidableInstances #-}
5+
{-# OPTIONS_GHC -Wno-orphans #-}
6+
7+
module Test.Cardano.Ledger.Babbage.Binary.Twiddle () where
8+
9+
import Cardano.Ledger.Babbage (BabbageEra)
10+
import Cardano.Ledger.Babbage.Core
11+
import Cardano.Ledger.Babbage.Tx
12+
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
13+
import Cardano.Ledger.Binary (Sized, Term (..))
14+
import Cardano.Ledger.Shelley.PParams (Update (..))
15+
import Cardano.Ledger.Val (Val)
16+
import Data.Maybe (catMaybes)
17+
import Test.Cardano.Ledger.Alonzo.Binary.Twiddle ()
18+
import Test.Cardano.Ledger.Binary.Twiddle (Twiddle (..), emptyOrNothing, toTerm, twiddleStrictMaybe)
19+
import Test.Cardano.Ledger.Common
20+
21+
instance EraPParams era => Twiddle (Update era) where
22+
twiddle v = twiddle v . toTerm v
23+
24+
instance Twiddle a => Twiddle (Sized a)
25+
26+
instance (EraScript era, Val (Value era)) => Twiddle (BabbageTxOut era) where
27+
twiddle v = twiddle v . toTerm v
28+
29+
instance Twiddle (TxBody BabbageEra) where
30+
twiddle v txBody = do
31+
inputs' <- twiddle v $ btbInputs txBody
32+
outputs' <- twiddle v $ btbOutputs txBody
33+
fee' <- twiddle v $ btbTxFee txBody
34+
-- Empty collateral can be represented by empty set or the
35+
-- value can be omitted entirely
36+
ttl' <- twiddleStrictMaybe v . invalidHereafter $ btbValidityInterval txBody
37+
cert' <- emptyOrNothing v $ btbCerts txBody
38+
withdrawals' <- twiddle v $ btbWithdrawals txBody
39+
update' <- twiddleStrictMaybe v $ btbUpdate txBody
40+
auxDataHash' <- twiddleStrictMaybe v $ btbAuxDataHash txBody
41+
validityStart' <- twiddleStrictMaybe v . invalidBefore $ btbValidityInterval txBody
42+
mint' <- twiddle v $ btbMint txBody
43+
scriptDataHash' <- twiddleStrictMaybe v $ btbScriptIntegrityHash txBody
44+
collateral' <- emptyOrNothing v $ btbCollateral txBody
45+
requiredSigners' <- emptyOrNothing v $ btbReqSignerHashes txBody
46+
networkId' <- twiddleStrictMaybe v $ btbTxNetworkId txBody
47+
collateralReturn <- twiddleStrictMaybe v $ btbCollateralReturn txBody
48+
totalCollateral <- twiddleStrictMaybe v $ btbTotalCollateral txBody
49+
referenceInputs <- emptyOrNothing v $ btbReferenceInputs txBody
50+
mp <- elements [TMap, TMapI]
51+
let fields =
52+
[ (TInt 0, inputs')
53+
, (TInt 1, outputs')
54+
, (TInt 2, fee')
55+
]
56+
<> catMaybes
57+
[ (TInt 3,) <$> ttl'
58+
, (TInt 4,) <$> cert'
59+
, (TInt 5,) <$> Just withdrawals'
60+
, (TInt 6,) <$> update'
61+
, (TInt 7,) <$> auxDataHash'
62+
, (TInt 8,) <$> validityStart'
63+
, (TInt 9,) <$> Just mint'
64+
, (TInt 11,) <$> scriptDataHash'
65+
, (TInt 13,) <$> collateral'
66+
, (TInt 14,) <$> requiredSigners'
67+
, (TInt 15,) <$> networkId'
68+
, (TInt 16,) <$> collateralReturn
69+
, (TInt 17,) <$> totalCollateral
70+
, (TInt 18,) <$> referenceInputs
71+
]
72+
fields' <- shuffle fields
73+
pure $ mp fields'

0 commit comments

Comments
 (0)