Extendend whitelist options

Author: Cmdv

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

@@ -61,6 +61,7 @@ library
   build-depends:        base                            >= 4.14         && < 5
                       , async
                       , aeson
+                      , base16-bytestring
                       , bytestring
                       , cardano-binary
                       , cardano-crypto-class
@@ -166,6 +167,7 @@ test-suite cardano-chain-gen
                         Test.Cardano.Db.Mock.Unit.Conway.Simple
                         Test.Cardano.Db.Mock.Unit.Conway.Stake
                         Test.Cardano.Db.Mock.Unit.Conway.Tx
+                        Test.Cardano.Db.Mock.Unit.Conway.Whitelist
                         Test.Cardano.Db.Mock.UnifiedApi
                         Test.Cardano.Db.Mock.Validate
 

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs

@@ -23,6 +23,7 @@ module Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples (
   alwaysMintScriptHash,
   alwaysMintScriptAddr,
   alwaysMintScriptStake,
+  alwaysMintScriptHashRandomPolicyVal,
   scriptHash,
   assetNames,
   plutusData2,
@@ -47,6 +48,7 @@ import Codec.Serialise
 import Codec.Serialise.Encoding
 import Data.ByteString.Short
 import Data.Maybe
+import Numeric.Natural (Natural)
 import Ouroboros.Consensus.Cardano.Block (StandardAlonzo)
 import qualified PlutusCore.Data as Plutus
 import qualified PlutusLedgerApi.Test.Examples as Plutus
@@ -103,6 +105,15 @@ alwaysMintScriptStake = ScriptHashObj alwaysMintScriptHash
 mkPlutusScriptEra :: AlonzoEraScript era => PlutusBinary -> AlonzoScript era
 mkPlutusScriptEra sh = PlutusScript $ fromJust $ mkBinaryPlutusScript PlutusV1 sh
 
+alwaysMintScriptHashRandomPolicyVal :: Natural -> ScriptHash StandardCrypto
+alwaysMintScriptHashRandomPolicyVal n = scriptHash @StandardAlonzo $ alwaysMintRandomScript n
+
+alwaysMintRandomScript :: AlonzoEraScript era => Natural -> AlonzoScript era
+alwaysMintRandomScript n = mkPlutusScriptEra $ alwaysMintRandomPlutusBinary n
+
+alwaysMintRandomPlutusBinary :: Natural -> PlutusBinary
+alwaysMintRandomPlutusBinary n = PlutusBinary $ Plutus.alwaysFailingNAryFunction n
+
 scriptHash ::
   forall era.
   ( EraCrypto era ~ StandardCrypto

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs

@@ -38,6 +38,7 @@ module Cardano.Mock.Forging.Tx.Conway (
   mkNewConstitutionTx,
   mkDummyRegisterTx,
   mkDummyTxBody,
+  mkDummyTxBodyWithFee,
   mkTxDelegCert,
   mkRegTxCert,
   mkUnRegTxCert,
@@ -589,6 +590,21 @@ mkDummyTxBody =
     mempty
     (Withdrawals mempty)
 
+mkDummyTxBodyWithFee ::
+  Coin ->
+  ConwayTxBody StandardConway
+mkDummyTxBodyWithFee coin' =
+  consTxBody
+    mempty
+    mempty
+    mempty
+    mempty
+    SNothing
+    coin'
+    mempty
+    mempty
+    (Withdrawals mempty)
+
 mkFullTx ::
   Int ->
   Integer ->

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

@@ -11,10 +11,20 @@ module Cardano.Mock.Query (
   queryGovActionCounts,
   queryConstitutionAnchor,
   queryRewardRests,
+  queryMultiAssetMetadataPolicy,
+  queryStakeAddressHashRaw,
+  queryStakeAddressCount,
+  queryCollateralTxOutCount,
+  queryPoolUpdateCount,
+  queryStakeDeRegCount,
+  queryStakeRegCount,
+  countTxOutNonNullStakeAddrIds,
 ) where
 
 import qualified Cardano.Db as Db
-import Cardano.Prelude hiding (from, on)
+import Cardano.Prelude hiding (from, isNothing, on)
+import qualified Data.ByteString.Base16 as Base16
+import Data.ByteString.Short (ShortByteString, toShort)
 import Database.Esqueleto.Experimental
 import Prelude ()
 
@@ -150,3 +160,60 @@ queryRewardRests = do
     pure (reward ^. Db.RewardRestType, reward ^. Db.RewardRestAmount)
 
   pure $ map (bimap unValue (Db.unDbLovelace . unValue)) res
+
+queryMultiAssetMetadataPolicy :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
+queryMultiAssetMetadataPolicy = do
+  res <- selectOne $ do
+    metadataPolicy <- from $ table @Db.MultiAsset
+    pure $ metadataPolicy ^. Db.MultiAssetPolicy
+  pure $ toShort . Base16.encode . unValue <$> res
+
+queryStakeAddressHashRaw :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
+queryStakeAddressHashRaw = do
+  res <- selectOne $ do
+    stakeAddress <- from $ table @Db.StakeAddress
+    pure $ stakeAddress ^. Db.StakeAddressHashRaw
+  pure $ toShort . Base16.encode . unValue <$> res
+
+queryStakeAddressCount :: MonadIO io => ReaderT SqlBackend io Word
+queryStakeAddressCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.StakeAddress)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryCollateralTxOutCount :: MonadIO io => ReaderT SqlBackend io Word
+queryCollateralTxOutCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.CollateralTxOut)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryPoolUpdateCount :: MonadIO io => ReaderT SqlBackend io Word
+queryPoolUpdateCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.PoolUpdate)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryStakeDeRegCount :: MonadIO io => ReaderT SqlBackend io Word
+queryStakeDeRegCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.StakeDeregistration)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryStakeRegCount :: MonadIO io => ReaderT SqlBackend io Word
+queryStakeRegCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.StakeRegistration)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+countTxOutNonNullStakeAddrIds :: (MonadIO m) => SqlPersistT m Word
+countTxOutNonNullStakeAddrIds = do
+  result <- selectOne $ do
+    txOut <- from $ table @Db.TxOut
+    where_ $ not_ (isNothing $ txOut ^. Db.TxOutStakeAddressId)
+    pure countRows
+  pure $ maybe 0 unValue result

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

@@ -16,6 +16,7 @@ import qualified Test.Cardano.Db.Mock.Unit.Conway.Rollback as Rollback
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Simple as Simple
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Stake as Stake
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Tx as Tx
+import qualified Test.Cardano.Db.Mock.Unit.Conway.Whitelist as Whitelist
 import Test.Cardano.Db.Mock.Validate (expectFailSilent)
 import Test.Tasty (TestTree (), testGroup)
 import Test.Tasty.HUnit (Assertion (), testCase)
@@ -42,6 +43,12 @@ unitTests iom knownMigrations =
                 "remove jsonb from schema and add back"
                 Config.configJsonbInSchemaShouldRemoveThenAdd
             ]
+        , testGroup
+            "invalid whitelist hashes"
+            [ testCase "Fail if Shelley stake address hash is invalid" Config.invalidShelleyStkAddrHash
+            , testCase "Fail if multi-asset policies hash is invalid" Config.invalidMultiAssetPoliciesHash
+            , testCase "Fail if Plutus script hash invalid" Config.invalidPlutusScriptHash
+            ]
         , testGroup
             "tx-out"
             [ test "consumed_by_tx_id column check" MigrateConsumedPruneTxOut.txConsumedColumnCheck
@@ -112,7 +119,6 @@ unitTests iom knownMigrations =
         , test "consume utxo same block" Tx.consumeSameBlock
         , test "tx with metadata" Tx.addTxMetadata
         , test "tx with metadata disabled" Tx.addTxMetadataDisabled
-        , test "tx with metadata whitelist" Tx.addTxMetadataWhitelist
         ]
     , testGroup
         "stake addresses"
@@ -174,6 +180,14 @@ unitTests iom knownMigrations =
         , test "swap many multi assets" Plutus.swapMultiAssets
         , test "swap with multi assets disabled" Plutus.swapMultiAssetsDisabled
         ]
+    , testGroup
+        "Whitelist"
+        [ test "add tx with whitelist" Whitelist.addTxMultiAssetsWhitelist
+        , test "tx with metadata whitelist" Whitelist.addTxMetadataWhitelist
+        , test "tx with metadata whitelist multiple" Whitelist.addTxMetadataWhitelistMultiple
+        , test "add simple tx, whitelist tx address" Whitelist.addSimpleTxStakeAddrsWhitelist
+        , test "add full tx, with stake address whitelist" Whitelist.fullTxStakeAddressWhitelist
+        ]
     , testGroup
         "Pools and smash"
         [ test "pool registration" Other.poolReg

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

@@ -8,22 +8,29 @@ module Test.Cardano.Db.Mock.Unit.Conway.Config.Parse (
   wrongConwayGenesisHash,
   insertConfig,
   defaultInsertConfig,
-) where
+  invalidShelleyStkAddrHash,
+  invalidMultiAssetPoliciesHash,
+  invalidPlutusScriptHash,
+)
+where
 
 import Cardano.DbSync.Config
 import Cardano.DbSync.Config.Types
 import Cardano.DbSync.Error
 import Cardano.Prelude hiding (from, isNothing)
 import qualified Data.Aeson as Aeson
 import Data.Default.Class (Default (..))
+import Data.String (String)
+import Data.Text (pack)
 import Test.Cardano.Db.Mock.Config
 import Test.Tasty.HUnit (Assertion (), assertBool, (@?=))
 import Prelude ()
 
 conwayGenesis :: Assertion
 conwayGenesis =
   mkSyncNodeConfig configDir initCommandLineArgs
-    >>= void . mkConfig configDir mutableDir cmdLineArgs
+    >>= void
+      . mkConfig configDir mutableDir cmdLineArgs
   where
     configDir = "config-conway"
     mutableDir = mkMutableDir "conwayConfigSimple"
@@ -108,3 +115,27 @@ insertConfig = do
   dncInsertOptions cfg @?= expected
   where
     configDir = "config-conway-insert-options"
+
+invalidShelleyStkAddrHash :: Assertion
+invalidShelleyStkAddrHash =
+  let invalidJson = "{ \"enable\": true, \"stake_addresses\": " <> invalidHash <> " }"
+      decodedResult :: Either String ShelleyInsertConfig
+      decodedResult = Aeson.eitherDecodeStrict $ encodeUtf8 $ pack invalidJson
+   in assertBool "Decoding should fail for invalid Shelley stake address hash" (isLeft decodedResult)
+
+invalidMultiAssetPoliciesHash :: Assertion
+invalidMultiAssetPoliciesHash =
+  let invalidJson = "{ \"enable\": true, \"policies\": " <> invalidHash <> " }"
+      decodedResult :: Either String MultiAssetConfig
+      decodedResult = Aeson.eitherDecodeStrict $ encodeUtf8 $ pack invalidJson
+   in assertBool "Decoding should fail for invalid MultiAsset policies hash" (isLeft decodedResult)
+
+invalidPlutusScriptHash :: Assertion
+invalidPlutusScriptHash =
+  let invalidJson = "{ \"enable\": true, \"script_hashes\": " <> invalidHash <> " }"
+      decodedResult :: Either String PlutusConfig
+      decodedResult = Aeson.eitherDecodeStrict $ encodeUtf8 $ pack invalidJson
+   in assertBool "Decoding should fail for invalid Plutus script hash" (isLeft decodedResult)
+
+invalidHash :: String
+invalidHash = "[\"\\xe0758b08dea05dabd1cd3510689ebd9efb6a49316acb30eead750e2e9e\"]"

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
@@ -32,6 +33,8 @@ module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
 
 import Cardano.Crypto.Hash.Class (hashToBytes)
 import qualified Cardano.Db as DB
+import Cardano.DbSync.Config (SyncNodeConfig (..))
+import Cardano.DbSync.Config.Types (MultiAssetConfig (..), SyncInsertOptions (..))
 import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), PolicyID (..))
@@ -763,41 +766,49 @@ swapMultiAssets =
     testLabel = "conwaySwapMultiAssets"
 
 swapMultiAssetsDisabled :: IOManager -> [(Text, Text)] -> Assertion
-swapMultiAssetsDisabled =
-  withCustomConfig args Nothing cfgDir testLabel $ \interpreter mockServer dbSync -> do
-    startDBSync dbSync
+swapMultiAssetsDisabled ioManager metadata = do
+  syncNodeConfig <- mksNodeConfig
+  withCustomConfig cmdlArgs (Just syncNodeConfig) cfgDir testLabel action ioManager metadata
+  where
+    action = \interpreter mockServer dbSync -> do
+      startDBSync dbSync
+
+      -- Forge a block with multiple multi-asset scripts
+      void $ Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> do
+        let policy = PolicyID Examples.alwaysMintScriptHash
+            assets = Map.singleton (Prelude.head Examples.assetNames) 1
+            mintedValue = MultiAsset $ Map.singleton policy assets
+            outValue = MaryValue (Coin 20) (MultiAsset $ Map.singleton policy assets)
+
+        -- Forge a multi-asset script
+        tx0 <-
+          Conway.mkMultiAssetsScriptTx
+            [UTxOIndex 0]
+            (UTxOIndex 1)
+            [(UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)]
+            []
+            mintedValue
+            True
+            100
+            state'
 
-    -- Forge a block with multiple multi-asset scripts
-    void $ Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> do
-      let policy = PolicyID Examples.alwaysMintScriptHash
-          assets = Map.singleton (Prelude.head Examples.assetNames) 1
-          mintedValue = MultiAsset $ Map.singleton policy assets
-          outValue = MaryValue (Coin 20) (MultiAsset $ Map.singleton policy assets)
+        pure [tx0]
 
-      -- Forge a multi-asset script
-      tx0 <-
-        Conway.mkMultiAssetsScriptTx
-          [UTxOIndex 0]
-          (UTxOIndex 1)
-          [(UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)]
-          []
-          mintedValue
-          True
-          100
-          state'
+      -- Wait for it to sync
+      assertBlockNoBackoff dbSync 1
+      -- Verify multi-assets
+      assertEqBackoff dbSync queryMultiAssetCount 0 [] "Unexpected multi-assets"
 
-      pure [tx0]
+    cmdlArgs = initCommandLineArgs {claFullMode = False}
 
-    -- Wait for it to sync
-    assertBlockNoBackoff dbSync 1
-    -- Verify multi-assets
-    assertEqBackoff dbSync queryMultiAssetCount 0 [] "Unexpected multi-assets"
-  where
-    args =
-      initCommandLineArgs
-        { claConfigFilename = "test-db-sync-config-no-multi-assets.json"
-        , claFullMode = False
-        }
+    mksNodeConfig :: IO SyncNodeConfig
+    mksNodeConfig = do
+      initConfigFile <- mkSyncNodeConfig cfgDir cmdlArgs
+      let dncInsertOptions' = dncInsertOptions initConfigFile
+      pure $
+        initConfigFile
+          { dncInsertOptions = dncInsertOptions' {sioMultiAsset = MultiAssetDisable}
+          }
 
     testLabel = "conwayConfigMultiAssetsDisabled"
     cfgDir = conwayConfigDir

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

@@ -412,7 +412,7 @@ registerStakeCreds = do
 
 registerStakeCredsNoShelley :: IOManager -> [(Text, Text)] -> Assertion
 registerStakeCredsNoShelley = do
-  withCustomConfig args Nothing cfgDir testLabel $ \interpreter mockServer dbSync -> do
+  withCustomConfigAndDropDB args Nothing cfgDir testLabel $ \interpreter mockServer dbSync -> do
     startDBSync dbSync
 
     -- These should not be saved when shelley is disabled