1+ {-# LANGUAGE DerivingStrategies #-}
12{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE FlexibleInstances #-}
4+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
35{-# LANGUAGE ScopedTypeVariables #-}
6+ {-# LANGUAGE StandaloneDeriving #-}
47{-# LANGUAGE TypeApplications #-}
58{-# LANGUAGE TypeFamilies #-}
69{-# LANGUAGE TypeOperators #-}
1114module Test.Consensus.Shelley.LedgerTables (tests ) where
1215
1316import qualified Cardano.Ledger.Api.Era as L
17+ import qualified Cardano.Ledger.BaseTypes as L
18+ import qualified Cardano.Ledger.Shelley.API.Types as L
19+ import Data.MemPack
1420import Data.Proxy
1521import Data.SOP.BasicFunctors
1622import Data.SOP.Constraint
@@ -29,12 +35,15 @@ import Test.Cardano.Ledger.Dijkstra.Arbitrary ()
2935import Test.Consensus.Shelley.Generators ()
3036import Test.Consensus.Shelley.MockCrypto (CanMock )
3137import Test.LedgerTables
38+ import Test.QuickCheck
3239import Test.Tasty
3340import Test.Tasty.QuickCheck
3441
3542tests :: TestTree
3643tests =
3744 testGroup " LedgerTables"
45+ . (testProperty " Serializing BigEndianTxIn preserves order" testBigEndianTxInPreservesOrder : )
46+ . (testProperty " Serializing TxIn fails to preserve order" (expectFailure testTxInPreservesOrder) : )
3847 . hcollapse
3948 . hcmap (Proxy @ TestLedgerTables ) (K . f)
4049 $ (hpure Proxy :: NP Proxy (CardanoShelleyEras StandardCrypto ))
@@ -74,3 +83,15 @@ instance
7483 Arbitrary (LedgerTables (LedgerState (ShelleyBlock proto era )) ValuesMK )
7584 where
7685 arbitrary = projectLedgerTables . unstowLedgerTables <$> arbitrary
86+
87+ testBigEndianTxInPreservesOrder :: L. TxId -> L. TxIx -> L. TxIx -> Property
88+ testBigEndianTxInPreservesOrder txid txix1 txix2 =
89+ let b1 = packByteString (BigEndianTxIn $ L. TxIn txid txix1)
90+ b2 = packByteString (BigEndianTxIn $ L. TxIn txid txix2)
91+ in counterexample (show b1 <> " " <> show b2) $ compare b1 b2 === compare txix1 txix2
92+
93+ testTxInPreservesOrder :: L. TxId -> L. TxIx -> L. TxIx -> Property
94+ testTxInPreservesOrder txid txix1 txix2 =
95+ let b1 = packByteString (L. TxIn txid txix1)
96+ b2 = packByteString (L. TxIn txid txix2)
97+ in counterexample (show b1 <> " " <> show b2) $ compare b1 b2 === compare txix1 txix2
0 commit comments