Skip to content

Commit 875c556

Browse files
committed
Test flipped serialization for TxIn
1 parent 4675a80 commit 875c556

File tree

2 files changed

+27
-0
lines changed

2 files changed

+27
-0
lines changed

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -378,6 +378,7 @@ test-suite shelley-test
378378
contra-tracer,
379379
filepath,
380380
measures,
381+
mempack,
381382
microlens,
382383
ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib},
383384
ouroboros-consensus-cardano,

ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/LedgerTables.hs

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DerivingStrategies #-}
12
{-# LANGUAGE FlexibleContexts #-}
23
{-# LANGUAGE FlexibleInstances #-}
34
{-# LANGUAGE ScopedTypeVariables #-}
@@ -11,6 +12,9 @@
1112
module Test.Consensus.Shelley.LedgerTables (tests) where
1213

1314
import qualified Cardano.Ledger.Api.Era as L
15+
import qualified Cardano.Ledger.BaseTypes as L
16+
import qualified Cardano.Ledger.Shelley.API.Types as L
17+
import Data.MemPack
1418
import Data.Proxy
1519
import Data.SOP.BasicFunctors
1620
import Data.SOP.Constraint
@@ -29,12 +33,16 @@ import Test.Cardano.Ledger.Dijkstra.Arbitrary ()
2933
import Test.Consensus.Shelley.Generators ()
3034
import Test.Consensus.Shelley.MockCrypto (CanMock)
3135
import Test.LedgerTables
36+
import Test.QuickCheck
3237
import Test.Tasty
3338
import Test.Tasty.QuickCheck
3439

3540
tests :: TestTree
3641
tests =
3742
testGroup "LedgerTables"
43+
. (testProperty "Serializing BigEndianTxIn preserves order" testBigEndianTxInPreservesOrder :)
44+
. (testProperty "Serializing TxIn fails to preserve order" (expectFailure testTxInPreservesOrder) :)
45+
. (testProperty "BigEndianTxIn roundtrips" testBigEndianRoundtrips :)
3846
. hcollapse
3947
. hcmap (Proxy @TestLedgerTables) (K . f)
4048
$ (hpure Proxy :: NP Proxy (CardanoShelleyEras StandardCrypto))
@@ -74,3 +82,21 @@ instance
7482
Arbitrary (LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
7583
where
7684
arbitrary = projectLedgerTables . unstowLedgerTables <$> arbitrary
85+
86+
testBigEndianTxInPreservesOrder :: L.TxId -> L.TxIx -> L.TxIx -> Property
87+
testBigEndianTxInPreservesOrder txid txix1 txix2 =
88+
let b1 = packByteString (BigEndianTxIn $ L.TxIn txid txix1)
89+
b2 = packByteString (BigEndianTxIn $ L.TxIn txid txix2)
90+
in counterexample (show b1 <> " " <> show b2) $ compare b1 b2 === compare txix1 txix2
91+
92+
testBigEndianRoundtrips :: L.TxIn -> Property
93+
testBigEndianRoundtrips txin =
94+
case unpack (pack txin) of
95+
Left err -> counterexample ("unpack failed with error: " ++ show err) False
96+
Right v -> v === txin
97+
98+
testTxInPreservesOrder :: L.TxId -> L.TxIx -> L.TxIx -> Property
99+
testTxInPreservesOrder txid txix1 txix2 =
100+
let b1 = packByteString (L.TxIn txid txix1)
101+
b2 = packByteString (L.TxIn txid txix2)
102+
in counterexample (show b1 <> " " <> show b2) $ compare b1 b2 === compare txix1 txix2

0 commit comments

Comments
 (0)