add whitelist parsing tests

Author: Cmdv

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

@@ -34,6 +34,12 @@ unitTests iom knownMigrations =
         , testCase "mismatched conway genesis hash" Config.wrongConwayGenesisHash
         , testCase "default insert config" Config.defaultInsertConfig
         , testCase "insert config" Config.insertConfig
+        , 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

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"
@@ -106,3 +113,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-db-sync/src/Cardano/DbSync/Config/Types.hs

@@ -68,6 +68,7 @@ import qualified Data.Aeson as Aeson
 import Data.Aeson.Types (Parser, typeMismatch)
 import Data.ByteString.Short (ShortByteString (), fromShort, toShort)
 import Data.Default.Class (Default (..))
+import qualified Data.Text as T
 import Ouroboros.Consensus.Cardano.CanHardFork (TriggerHardFork (..))
 
 newtype LogFileDir = LogFileDir
@@ -474,11 +475,12 @@ instance FromJSON ShelleyInsertConfig where
     enable <- obj .: "enable"
     stakeAddrs <- obj .:? "stake_addresses"
 
-    pure $
-      case (enable, stakeAddrs) of
-        (False, _) -> ShelleyDisable
-        (True, Nothing) -> ShelleyEnable
-        (True, Just addrs) -> ShelleyStakeAddrs (map parseShortByteString addrs)
+    case (enable, stakeAddrs) of
+      (False, _) -> pure ShelleyDisable
+      (True, Nothing) -> pure ShelleyEnable
+      (True, Just addrs) -> do
+        addrsParsed <- traverse parseValidateHash addrs
+        pure $ ShelleyStakeAddrs addrsParsed
 
 instance ToJSON MultiAssetConfig where
   toJSON cfg =
@@ -495,11 +497,12 @@ instance FromJSON MultiAssetConfig where
     enable <- obj .: "enable"
     policies <- obj .:? "policies"
 
-    pure $
-      case (enable, policies) of
-        (False, _) -> MultiAssetDisable
-        (True, Nothing) -> MultiAssetEnable
-        (True, Just ps) -> MultiAssetPolicies (map parseShortByteString ps)
+    case (enable, policies) of
+      (False, _) -> pure MultiAssetDisable
+      (True, Nothing) -> pure MultiAssetEnable
+      (True, Just ps) -> do
+        policiesParsed <- traverse parseValidateHash ps
+        pure $ MultiAssetPolicies policiesParsed
 
 instance ToJSON MetadataConfig where
   toJSON cfg =
@@ -537,11 +540,12 @@ instance FromJSON PlutusConfig where
     enable <- obj .: "enable"
     scriptHashes <- obj .:? "script_hashes"
 
-    pure $
-      case (enable, scriptHashes) of
-        (False, _) -> PlutusDisable
-        (True, Nothing) -> PlutusEnable
-        (True, Just hs) -> PlutusScripts (map parseShortByteString hs)
+    case (enable, scriptHashes) of
+      (False, _) -> pure PlutusDisable
+      (True, Nothing) -> pure PlutusEnable
+      (True, Just hs) -> do
+        hsParsed <- traverse parseValidateHash hs
+        pure $ PlutusScripts hsParsed
 
 instance ToJSON GovernanceConfig where
   toJSON = boolToEnableDisable . isGovernanceEnabled
@@ -601,8 +605,11 @@ enableDisableToBool = \case
   "disable" -> Just False
   _ -> Nothing
 
-parseShortByteString :: Text -> ShortByteString
-parseShortByteString = toShort . encodeUtf8
+parseValidateHash :: Text -> Parser ShortByteString
+parseValidateHash txt =
+  if "\\x" `T.isPrefixOf` txt
+    then fail $ "Invalid Hash: starts with \\x please adjust it:  " <> show txt
+    else pure $ toShort $ encodeUtf8 txt
 
 shortByteStringToJSON :: ShortByteString -> Aeson.Value
 shortByteStringToJSON = toJSON . decodeUtf8 . fromShort