1
+ {-# LANGUAGE DerivingStrategies #-}
1
2
{-# LANGUAGE FlexibleContexts #-}
2
3
{-# LANGUAGE FlexibleInstances #-}
4
+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
3
5
{-# LANGUAGE ScopedTypeVariables #-}
6
+ {-# LANGUAGE StandaloneDeriving #-}
4
7
{-# LANGUAGE TypeApplications #-}
5
8
{-# LANGUAGE TypeFamilies #-}
6
9
{-# LANGUAGE TypeOperators #-}
11
14
module Test.Consensus.Shelley.LedgerTables (tests ) where
12
15
13
16
import 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
14
20
import Data.Proxy
15
21
import Data.SOP.BasicFunctors
16
22
import Data.SOP.Constraint
@@ -29,12 +35,15 @@ import Test.Cardano.Ledger.Dijkstra.Arbitrary ()
29
35
import Test.Consensus.Shelley.Generators ()
30
36
import Test.Consensus.Shelley.MockCrypto (CanMock )
31
37
import Test.LedgerTables
38
+ import Test.QuickCheck
32
39
import Test.Tasty
33
40
import Test.Tasty.QuickCheck
34
41
35
42
tests :: TestTree
36
43
tests =
37
44
testGroup " LedgerTables"
45
+ . (testProperty " Serializing BigEndianTxIn preserves order" testBigEndianTxInPreservesOrder : )
46
+ . (testProperty " Serializing TxIn fails to preserve order" (expectFailure testTxInPreservesOrder) : )
38
47
. hcollapse
39
48
. hcmap (Proxy @ TestLedgerTables ) (K . f)
40
49
$ (hpure Proxy :: NP Proxy (CardanoShelleyEras StandardCrypto ))
@@ -74,3 +83,15 @@ instance
74
83
Arbitrary (LedgerTables (LedgerState (ShelleyBlock proto era )) ValuesMK )
75
84
where
76
85
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