1
1
{-# LANGUAGE NumericUnderscores #-}
2
+ {-# LANGUAGE OverloadedStrings #-}
2
3
{-# LANGUAGE TypeApplications #-}
3
4
4
5
module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
@@ -28,10 +29,13 @@ module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
28
29
mintMultiAssets ,
29
30
swapMultiAssets ,
30
31
swapMultiAssetsDisabled ,
32
+ addTxMultiAssetsWhitelist ,
31
33
) where
32
34
33
35
import Cardano.Crypto.Hash.Class (hashToBytes )
34
36
import qualified Cardano.Db as DB
37
+ import Cardano.DbSync.Config (SyncNodeConfig (.. ))
38
+ import Cardano.DbSync.Config.Types (MultiAssetConfig (.. ), SyncInsertOptions (.. ))
35
39
import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress )
36
40
import Cardano.Ledger.Coin (Coin (.. ))
37
41
import Cardano.Ledger.Mary.Value (MaryValue (.. ), MultiAsset (.. ), PolicyID (.. ))
@@ -42,8 +46,10 @@ import Cardano.Mock.Forging.Interpreter (withConwayLedgerState)
42
46
import qualified Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples as Examples
43
47
import qualified Cardano.Mock.Forging.Tx.Conway as Conway
44
48
import Cardano.Mock.Forging.Types
45
- import Cardano.Mock.Query (queryMultiAssetCount )
49
+ import Cardano.Mock.Query (queryMultiAssetCount , queryMultiAssetMetadataPolicy )
46
50
import Cardano.Prelude hiding (head )
51
+ import Data.ByteString.Short (toShort )
52
+ import Data.List.NonEmpty (fromList )
47
53
import qualified Data.Map as Map
48
54
import Data.Maybe.Strict (StrictMaybe (.. ))
49
55
import Ouroboros.Consensus.Shelley.Eras (StandardConway ())
@@ -763,41 +769,133 @@ swapMultiAssets =
763
769
testLabel = " conwaySwapMultiAssets"
764
770
765
771
swapMultiAssetsDisabled :: IOManager -> [(Text , Text )] -> Assertion
766
- swapMultiAssetsDisabled =
767
- withCustomConfig args Nothing cfgDir testLabel $ \ interpreter mockServer dbSync -> do
768
- startDBSync dbSync
772
+ swapMultiAssetsDisabled ioManager metadata = do
773
+ syncNodeConfig <- mksNodeConfig
774
+ withCustomConfig cmdlArgs (Just syncNodeConfig) cfgDir testLabel action ioManager metadata
775
+ where
776
+ action = \ interpreter mockServer dbSync -> do
777
+ startDBSync dbSync
778
+
779
+ -- Forge a block with multiple multi-asset scripts
780
+ void $ Api. withConwayFindLeaderAndSubmit interpreter mockServer $ \ state' -> do
781
+ let policy = PolicyID Examples. alwaysMintScriptHash
782
+ assets = Map. singleton (Prelude. head Examples. assetNames) 1
783
+ mintedValue = MultiAsset $ Map. singleton policy assets
784
+ outValue = MaryValue (Coin 20 ) (MultiAsset $ Map. singleton policy assets)
785
+
786
+ -- Forge a multi-asset script
787
+ tx0 <-
788
+ Conway. mkMultiAssetsScriptTx
789
+ [UTxOIndex 0 ]
790
+ (UTxOIndex 1 )
791
+ [(UTxOAddress Examples. alwaysSucceedsScriptAddr, outValue)]
792
+ []
793
+ mintedValue
794
+ True
795
+ 100
796
+ state'
769
797
770
- -- Forge a block with multiple multi-asset scripts
771
- void $ Api. withConwayFindLeaderAndSubmit interpreter mockServer $ \ state' -> do
772
- let policy = PolicyID Examples. alwaysMintScriptHash
773
- assets = Map. singleton (Prelude. head Examples. assetNames) 1
774
- mintedValue = MultiAsset $ Map. singleton policy assets
775
- outValue = MaryValue (Coin 20 ) (MultiAsset $ Map. singleton policy assets)
798
+ pure [tx0]
776
799
777
- -- Forge a multi-asset script
778
- tx0 <-
779
- Conway. mkMultiAssetsScriptTx
780
- [UTxOIndex 0 ]
781
- (UTxOIndex 1 )
782
- [(UTxOAddress Examples. alwaysSucceedsScriptAddr, outValue)]
783
- []
784
- mintedValue
785
- True
786
- 100
787
- state'
800
+ -- Wait for it to sync
801
+ assertBlockNoBackoff dbSync 1
802
+ -- Verify multi-assets
803
+ assertEqBackoff dbSync queryMultiAssetCount 0 [] " Unexpected multi-assets"
788
804
789
- pure [tx0]
805
+ cmdlArgs = initCommandLineArgs {claFullMode = False }
790
806
791
- -- Wait for it to sync
792
- assertBlockNoBackoff dbSync 1
793
- -- Verify multi-assets
794
- assertEqBackoff dbSync queryMultiAssetCount 0 [] " Unexpected multi-assets"
795
- where
796
- args =
797
- initCommandLineArgs
798
- { claConfigFilename = " test-db-sync-config-no-multi-assets.json"
799
- , claFullMode = False
800
- }
807
+ mksNodeConfig :: IO SyncNodeConfig
808
+ mksNodeConfig = do
809
+ initConfigFile <- mkSyncNodeConfig cfgDir cmdlArgs
810
+ let dncInsertOptions' = dncInsertOptions initConfigFile
811
+ pure $
812
+ initConfigFile
813
+ { dncInsertOptions = dncInsertOptions' {sioMultiAsset = MultiAssetDisable }
814
+ }
801
815
802
816
testLabel = " conwayConfigMultiAssetsDisabled"
803
817
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
+ }
0 commit comments