Skip to content

Commit a9b2f87

Browse files
committed
add some tests for whitelist
1 parent edfd3d7 commit a9b2f87

File tree

9 files changed

+307
-189
lines changed

9 files changed

+307
-189
lines changed

cardano-chain-gen/cardano-chain-gen.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -166,6 +166,7 @@ test-suite cardano-chain-gen
166166
Test.Cardano.Db.Mock.Unit.Conway.Simple
167167
Test.Cardano.Db.Mock.Unit.Conway.Stake
168168
Test.Cardano.Db.Mock.Unit.Conway.Tx
169+
Test.Cardano.Db.Mock.Unit.Conway.Whitelist
169170
Test.Cardano.Db.Mock.UnifiedApi
170171
Test.Cardano.Db.Mock.Validate
171172

cardano-chain-gen/src/Cardano/Mock/Query.hs

+8
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ module Cardano.Mock.Query (
77
queryMultiAssetCount,
88
queryTxMetadataCount,
99
queryMultiAssetMetadataPolicy,
10+
queryStakeAddressHashRaw,
1011
) where
1112

1213
import qualified Cardano.Db as Db
@@ -78,3 +79,10 @@ queryMultiAssetMetadataPolicy = do
7879
metadataPolicy <- from $ table @Db.MultiAsset
7980
pure $ metadataPolicy ^. Db.MultiAssetPolicy
8081
pure $ toShort . Base16.encode . unValue <$> res
82+
83+
queryStakeAddressHashRaw :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
84+
queryStakeAddressHashRaw = do
85+
res <- selectOne $ do
86+
stakeAddress <- from $ table @Db.StakeAddress
87+
pure $ stakeAddress ^. Db.StakeAddressHashRaw
88+
pure $ toShort . Base16.encode . unValue <$> res

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs

+8-3
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ import qualified Test.Cardano.Db.Mock.Unit.Conway.Rollback as Rollback
1616
import qualified Test.Cardano.Db.Mock.Unit.Conway.Simple as Simple
1717
import qualified Test.Cardano.Db.Mock.Unit.Conway.Stake as Stake
1818
import qualified Test.Cardano.Db.Mock.Unit.Conway.Tx as Tx
19+
import qualified Test.Cardano.Db.Mock.Unit.Conway.Whitelist as Whitelist
1920
import Test.Tasty (TestTree (), testGroup)
2021
import Test.Tasty.HUnit (Assertion (), testCase)
2122
import Prelude (String ())
@@ -100,8 +101,6 @@ unitTests iom knownMigrations =
100101
, test "consume utxo same block" Tx.consumeSameBlock
101102
, test "tx with metadata" Tx.addTxMetadata
102103
, test "tx with metadata disabled" Tx.addTxMetadataDisabled
103-
, test "tx with metadata whitelist" Tx.addTxMetadataWhitelist
104-
, test "tx with metadata whitelist multiple" Tx.addTxMetadataWhitelistMultiple
105104
]
106105
, testGroup
107106
"stake addresses"
@@ -162,7 +161,13 @@ unitTests iom knownMigrations =
162161
, test "mint many multi assets" Plutus.mintMultiAssets
163162
, test "swap many multi assets" Plutus.swapMultiAssets
164163
, test "swap with multi assets disabled" Plutus.swapMultiAssetsDisabled
165-
, test "add multi assets with whitelist" Plutus.addTxMultiAssetsWhitelist
164+
]
165+
, testGroup
166+
"Whitelist"
167+
[ test "add tx with whitelist" Whitelist.addTxMultiAssetsWhitelist
168+
, test "tx with metadata whitelist" Whitelist.addTxMetadataWhitelist
169+
, test "tx with metadata whitelist multiple" Whitelist.addTxMetadataWhitelistMultiple
170+
, test "add simple tx, whitelist tx address" Whitelist.addSimpleTxStakeAddrsWhitelist
166171
]
167172
, testGroup
168173
"Pools and smash"

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs

+1-88
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,6 @@ module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
2929
mintMultiAssets,
3030
swapMultiAssets,
3131
swapMultiAssetsDisabled,
32-
addTxMultiAssetsWhitelist,
3332
) where
3433

3534
import Cardano.Crypto.Hash.Class (hashToBytes)
@@ -46,10 +45,8 @@ import Cardano.Mock.Forging.Interpreter (withConwayLedgerState)
4645
import qualified Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples as Examples
4746
import qualified Cardano.Mock.Forging.Tx.Conway as Conway
4847
import Cardano.Mock.Forging.Types
49-
import Cardano.Mock.Query (queryMultiAssetCount, queryMultiAssetMetadataPolicy)
48+
import Cardano.Mock.Query (queryMultiAssetCount)
5049
import Cardano.Prelude hiding (head)
51-
import Data.ByteString.Short (toShort)
52-
import Data.List.NonEmpty (fromList)
5350
import qualified Data.Map as Map
5451
import Data.Maybe.Strict (StrictMaybe (..))
5552
import Ouroboros.Consensus.Shelley.Eras (StandardConway ())
@@ -815,87 +812,3 @@ swapMultiAssetsDisabled ioManager metadata = do
815812

816813
testLabel = "conwayConfigMultiAssetsDisabled"
817814
cfgDir = conwayConfigDir
818-
819-
addTxMultiAssetsWhitelist :: IOManager -> [(Text, Text)] -> Assertion
820-
addTxMultiAssetsWhitelist ioManager metadata = do
821-
syncNodeConfig <- mksNodeConfig
822-
withCustomConfig args (Just syncNodeConfig) cfgDir testLabel action ioManager metadata
823-
where
824-
action = \interpreter mockServer dbSync -> do
825-
startDBSync dbSync
826-
-- Forge a block with multiple multi-asset scripts
827-
void $ Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> do
828-
let assetsMinted =
829-
Map.fromList [(head Examples.assetNames, 10), (Examples.assetNames !! 1, 4)]
830-
policy0 = PolicyID $ Examples.alwaysMintScriptHashRandomPolicyVal 1
831-
policy1 = PolicyID $ Examples.alwaysMintScriptHashRandomPolicyVal 2
832-
mintValue =
833-
MultiAsset $
834-
Map.fromList [(policy0, assetsMinted), (policy1, assetsMinted)]
835-
assets =
836-
Map.fromList [(head Examples.assetNames, 5), (Examples.assetNames !! 1, 2)]
837-
outValue =
838-
MaryValue (Coin 20) $
839-
MultiAsset $
840-
Map.fromList [(policy0, assets), (policy1, assets)]
841-
842-
-- Forge a multi-asset script
843-
tx0 <-
844-
Conway.mkMultiAssetsScriptTx
845-
[UTxOIndex 0]
846-
(UTxOIndex 1)
847-
[ (UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)
848-
, (UTxOAddress Examples.alwaysMintScriptAddr, outValue)
849-
]
850-
[]
851-
mintValue
852-
True
853-
100
854-
state'
855-
856-
-- Consume the outputs from tx0
857-
let utxos = Conway.mkUTxOConway tx0
858-
tx1 <-
859-
Conway.mkMultiAssetsScriptTx
860-
[UTxOPair (head utxos), UTxOPair (utxos !! 1), UTxOIndex 2]
861-
(UTxOIndex 3)
862-
[ (UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)
863-
, (UTxOAddress Examples.alwaysMintScriptAddr, outValue)
864-
, (UTxOAddressNew 0, outValue)
865-
, (UTxOAddressNew 0, outValue)
866-
]
867-
[]
868-
mintValue
869-
True
870-
200
871-
state'
872-
pure [tx0, tx1]
873-
874-
-- Verify script counts
875-
assertBlockNoBackoff dbSync 1
876-
assertAlonzoCounts dbSync (2, 4, 1, 2, 4, 2, 0, 0)
877-
-- create 4 multi-assets but only 2 should be added due to the whitelist
878-
assertEqBackoff dbSync queryMultiAssetCount 2 [] "Expected 2 multi-assets"
879-
-- do the policy match the whitelist
880-
assertEqBackoff dbSync queryMultiAssetMetadataPolicy (Just policyShortBs) [] "Expected correct policy in db"
881-
882-
args = initCommandLineArgs {claFullMode = False}
883-
testLabel = "conwayConfigMultiAssetsWhitelist"
884-
885-
cfgDir = conwayConfigDir
886-
887-
policyShortBs = toShort "4509cdddad21412c22c9164e10bc6071340ba235562f1575a35ded4d"
888-
889-
mksNodeConfig :: IO SyncNodeConfig
890-
mksNodeConfig = do
891-
initConfigFile <- mkSyncNodeConfig cfgDir args
892-
let dncInsertOptions' = dncInsertOptions initConfigFile
893-
pure $
894-
initConfigFile
895-
{ dncInsertOptions =
896-
dncInsertOptions'
897-
{ sioMultiAsset =
898-
MultiAssetPolicies $
899-
fromList [policyShortBs]
900-
}
901-
}

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Tx.hs

-86
Original file line numberDiff line numberDiff line change
@@ -7,11 +7,8 @@ module Test.Cardano.Db.Mock.Unit.Conway.Tx (
77
consumeSameBlock,
88
addTxMetadata,
99
addTxMetadataDisabled,
10-
addTxMetadataWhitelist,
11-
addTxMetadataWhitelistMultiple,
1210
) where
1311

14-
import Cardano.Api.Ledger (Coin (..))
1512
import Cardano.DbSync.Config (SyncNodeConfig (..))
1613
import Cardano.DbSync.Config.Types (MetadataConfig (..), SyncInsertOptions (..))
1714
import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..))
@@ -21,7 +18,6 @@ import qualified Cardano.Mock.Forging.Tx.Shelley as Shelley
2118
import Cardano.Mock.Forging.Types (UTxOIndex (..))
2219
import Cardano.Mock.Query (queryNullTxDepositExists, queryTxMetadataCount)
2320
import Cardano.Prelude hiding (head)
24-
import Data.List.NonEmpty (fromList)
2521
import qualified Data.Map as Map
2622
import Test.Cardano.Db.Mock.Config
2723
import qualified Test.Cardano.Db.Mock.UnifiedApi as UnifiedApi
@@ -167,85 +163,3 @@ addTxMetadataDisabled ioManager metadata = do
167163
initConfigFile
168164
{ dncInsertOptions = dncInsertOptions' {sioMetadata = MetadataDisable}
169165
}
170-
171-
-- 2 blocks each with 4 metadata entries.
172-
-- The whitelist has one tx metadata key which is in the first block
173-
-- so only the TX in the first block should have tx metadata kept.
174-
addTxMetadataWhitelist :: IOManager -> [(Text, Text)] -> Assertion
175-
addTxMetadataWhitelist ioManager metadata = do
176-
syncNodeConfig <- mksNodeConfig
177-
withCustomConfigAndDropDB args (Just syncNodeConfig) cfgDir testLabel action ioManager metadata
178-
where
179-
action = \interpreter mockServer dbSync -> do
180-
startDBSync dbSync
181-
-- Add transactions with metadata
182-
void $ do
183-
UnifiedApi.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \_ ->
184-
let txBody = Conway.mkDummyTxBodyWithFee $ Coin 1_000
185-
auxData = Map.fromList [(1, I 1), (2, I 2), (3, I 3), (4, I 4)]
186-
in Right (Conway.mkAuxDataTx True txBody auxData)
187-
void $ do
188-
UnifiedApi.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \_ ->
189-
let txBody = Conway.mkDummyTxBodyWithFee $ Coin 2_000
190-
auxData = Map.fromList [(5, I 5), (6, I 6), (7, I 7), (8, I 8)]
191-
in Right (Conway.mkAuxDataTx True txBody auxData)
192-
193-
assertBlockNoBackoff dbSync 2
194-
-- Should have first block's tx metadata
195-
assertEqBackoff dbSync queryTxMetadataCount 4 [] "Expected tx metadata"
196-
197-
args = initCommandLineArgs {claFullMode = False}
198-
testLabel = "conwayConfigMetadataWhitelist"
199-
200-
cfgDir = conwayConfigDir
201-
202-
-- match all metadata keys of value 1
203-
mksNodeConfig :: IO SyncNodeConfig
204-
mksNodeConfig = do
205-
initConfigFile <- mkSyncNodeConfig cfgDir args
206-
let dncInsertOptions' = dncInsertOptions initConfigFile
207-
pure $
208-
initConfigFile
209-
{ dncInsertOptions = dncInsertOptions' {sioMetadata = MetadataKeys $ fromList [1]}
210-
}
211-
212-
-- 2 blocks each with 4 metadata entries
213-
-- The whitelist is set to keys [1,6] each key in in different TX
214-
-- so all TxMetadata should be kept from both blocks.
215-
addTxMetadataWhitelistMultiple :: IOManager -> [(Text, Text)] -> Assertion
216-
addTxMetadataWhitelistMultiple ioManager metadata = do
217-
syncNodeConfig <- mksNodeConfig
218-
withCustomConfigAndDropDB args (Just syncNodeConfig) cfgDir testLabel action ioManager metadata
219-
where
220-
action = \interpreter mockServer dbSync -> do
221-
startDBSync dbSync
222-
-- Add transactions with metadata
223-
void $ do
224-
UnifiedApi.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \_ ->
225-
let txBody = Conway.mkDummyTxBodyWithFee $ Coin 1_000
226-
auxData = Map.fromList [(1, I 1), (2, I 2), (3, I 3), (4, I 4)]
227-
in Right (Conway.mkAuxDataTx True txBody auxData)
228-
void $ do
229-
UnifiedApi.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \_ ->
230-
let txBody = Conway.mkDummyTxBodyWithFee $ Coin 2_000
231-
auxData = Map.fromList [(5, I 5), (6, I 6), (7, I 7), (8, I 8)]
232-
in Right (Conway.mkAuxDataTx True txBody auxData)
233-
234-
assertBlockNoBackoff dbSync 2
235-
-- Should have both block's tx metadata
236-
assertEqBackoff dbSync queryTxMetadataCount 8 [] "Expected tx metadata"
237-
238-
args = initCommandLineArgs {claFullMode = False}
239-
testLabel = "conwayConfigMetadataWhitelist"
240-
241-
cfgDir = conwayConfigDir
242-
243-
-- match all metadata keys of value 1
244-
mksNodeConfig :: IO SyncNodeConfig
245-
mksNodeConfig = do
246-
initConfigFile <- mkSyncNodeConfig cfgDir args
247-
let dncInsertOptions' = dncInsertOptions initConfigFile
248-
pure $
249-
initConfigFile
250-
{ dncInsertOptions = dncInsertOptions' {sioMetadata = MetadataKeys $ fromList [1, 6]}
251-
}

0 commit comments

Comments
 (0)