Skip to content

Commit 85527d3

Browse files
CmdvCmdv
committed
refine the whitelist logic
1 parent 602414f commit 85527d3

File tree

2 files changed

+70
-42
lines changed

2 files changed

+70
-42
lines changed

Diff for: ‎cardano-db-sync/src/Cardano/DbSync/Config.hs

+58-22
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ module Cardano.DbSync.Config (
2020
readCardanoGenesisConfig,
2121
readSyncNodeConfig,
2222
configureLogging,
23-
plutusWhitelistCheckTxOut,
23+
plutusMultiAssetWhitelistCheck,
2424
) where
2525

2626
import qualified Cardano.BM.Configuration.Model as Logging
@@ -33,7 +33,10 @@ import Cardano.DbSync.Config.Node (NodeConfig (..), parseNodeConfig, parseSyncPr
3333
import Cardano.DbSync.Config.Shelley
3434
import Cardano.DbSync.Config.Types
3535
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
36+
import Cardano.Ledger.Crypto (StandardCrypto)
37+
import Cardano.Ledger.Mary.Value (PolicyID (..))
3638
import Cardano.Prelude
39+
import Data.Map (keys)
3740
import System.FilePath (takeDirectory, (</>))
3841

3942
configureLogging :: SyncNodeConfig -> Text -> IO (Trace IO Text)
@@ -92,27 +95,60 @@ coalesceConfig pcfg ncfg adjustGenesisPath = do
9295
mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath)
9396
mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) </> fp
9497

95-
-- do a whitelist check against a list of TxOut and if one matches we keep them all
96-
plutusWhitelistCheckTxOut :: SyncEnv -> [Generic.TxOut] -> Bool
97-
plutusWhitelistCheckTxOut syncEnv txOuts = do
98-
let iopts = soptInsertOptions $ envOptions syncEnv
98+
-- check both whitelist but also checking plutus Maybes first
99+
-- TODO: cmdv: unsure if this is correct because if plutusMaybeCheck fails then no multiasset whitelist is not checked
100+
plutusMultiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
101+
plutusMultiAssetWhitelistCheck syncEnv txOuts =
102+
plutusMaybeCheck txOuts && (plutusWhitelistCheck syncEnv txOuts || multiAssetWhitelistCheck syncEnv txOuts)
103+
104+
plutusMaybeCheck :: [Generic.TxOut] -> Bool
105+
plutusMaybeCheck =
106+
any (\txOut -> isJust (Generic.txOutScript txOut) || isJust (Generic.maybePaymentCred $ Generic.txOutAddress txOut))
107+
108+
plutusWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
109+
plutusWhitelistCheck syncEnv txOuts = do
110+
-- first check the config option
99111
case ioPlutusExtra iopts of
100112
PlutusEnable -> True
101113
PlutusDisable -> False
102-
PlutusWhitelistScripts whitelist -> do
103-
-- we map over our txOuts and check if txOutAddress OR txOutScript are in the whitelist
104-
let whitelistCheck =
105-
( \txOut ->
106-
case (Generic.txOutScript txOut, Generic.maybePaymentCred $ Generic.txOutAddress txOut) of
107-
(Just script, _) ->
108-
if Generic.txScriptHash script `elem` whitelist
109-
then Just txOut
110-
else Nothing
111-
(_, Just address) ->
112-
if address `elem` whitelist
113-
then Just txOut
114-
else Nothing
115-
(Nothing, Nothing) -> Nothing
116-
)
117-
<$> txOuts
118-
any isJust whitelistCheck
114+
PlutusWhitelistScripts plutusWhitelist -> plutuswhitelistCheck plutusWhitelist
115+
where
116+
iopts = soptInsertOptions $ envOptions syncEnv
117+
plutuswhitelistCheck whitelist = do
118+
any
119+
( isJust
120+
. ( \txOut -> do
121+
case (Generic.txOutScript txOut, Generic.maybePaymentCred $ Generic.txOutAddress txOut) of
122+
(Just script, _) ->
123+
if Generic.txScriptHash script `elem` whitelist
124+
then Just txOut
125+
else Nothing
126+
(_, Just address) ->
127+
if address `elem` whitelist
128+
then Just txOut
129+
else Nothing
130+
(Nothing, Nothing) -> Nothing
131+
)
132+
)
133+
txOuts
134+
135+
multiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
136+
multiAssetWhitelistCheck syncEnv txOuts = do
137+
let iopts = soptInsertOptions $ envOptions syncEnv
138+
case ioMultiAssets iopts of
139+
MultiAssetEnable -> True
140+
MultiAssetDisable -> False
141+
MultiAssetWhitelistPolicies multiAssetWhitelist ->
142+
or multiAssetwhitelistCheck
143+
where
144+
-- txOutMaValue is a Map and we want to check if any of the keys match our whitelist
145+
multiAssetwhitelistCheck :: [Bool]
146+
multiAssetwhitelistCheck =
147+
( \txout ->
148+
any (checkMAValueMap multiAssetWhitelist) (keys $ Generic.txOutMaValue txout)
149+
)
150+
<$> txOuts
151+
152+
checkMAValueMap :: NonEmpty ByteString -> PolicyID StandardCrypto -> Bool
153+
checkMAValueMap maWhitelist policyId =
154+
Generic.unScriptHash (policyID policyId) `elem` maWhitelist

Diff for: ‎cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs

+12-20
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ import Cardano.DbSync.Cache (
4343
import Cardano.DbSync.Cache.Epoch (writeEpochBlockDiffToCache)
4444
import Cardano.DbSync.Cache.Types (Cache (..), CacheNew (..), EpochBlockDiff (..))
4545

46-
import Cardano.DbSync.Config (plutusWhitelistCheckTxOut)
46+
import Cardano.DbSync.Config (plutusMultiAssetWhitelistCheck)
4747
import Cardano.DbSync.Config.Types (MetadataConfig (..), MultiAssetConfig (..), PlutusConfig (..), isMetadataEnableOrWhiteList, isPlutusEnableOrWhitelist)
4848
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
4949
import Cardano.DbSync.Era.Shelley.Generic.Metadata (
@@ -324,8 +324,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
324324
then do
325325
!txOutsGrouped <- do
326326
let txOuts = Generic.txOutputs tx
327-
-- we do a plutus whitelist check
328-
if plutusWhitelistCheckTxOut syncEnv txOuts
327+
if plutusMultiAssetWhitelistCheck syncEnv txOuts
329328
then mapM (prepareTxOut tracer iopts cache (txId, txHash)) txOuts
330329
else pure mempty
331330

@@ -339,7 +338,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
339338
!txOutsGrouped <- do
340339
let txOuts = Generic.txOutputs tx
341340
-- we do a plutus whitelist check
342-
if plutusWhitelistCheckTxOut syncEnv txOuts
341+
if plutusMultiAssetWhitelistCheck syncEnv txOuts
343342
then mapM (prepareTxOut tracer iopts cache (txId, txHash)) txOuts
344343
else pure mempty
345344

@@ -380,7 +379,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
380379
MetadataDisable -> pure mempty
381380
MetadataEnable -> prepareMaTxMint tracer cache Nothing txId $ Generic.txMint tx
382381
MetadataWhitelistKeys whitelist -> prepareMaTxMint tracer cache (Just whitelist) txId $ Generic.txMint tx
383-
-- TODO: cmdv do whitelist check here maybe?
382+
384383
when (isPlutusEnableOrWhitelist $ ioPlutusExtra iopts) $
385384
mapM_ (lift . insertScript tracer txId) $
386385
Generic.txScripts tx
@@ -408,7 +407,7 @@ prepareTxOut ::
408407
(DB.TxId, ByteString) ->
409408
Generic.TxOut ->
410409
ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut])
411-
prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do
410+
prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr value maMap mScript dt) = do
412411
case ioPlutusExtra iopts of
413412
-- can skip to part2 as mDatumId & mScriptId aren't needed
414413
PlutusDisable -> buildExtendedTxOutPart2 Nothing Nothing
@@ -419,8 +418,8 @@ prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw
419418
(MonadBaseControl IO m, MonadIO m) =>
420419
ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut])
421420
buildExtendedTxOutPart1 = do
422-
mDatumId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId
423-
mScriptId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing $ whenMaybe mScript $ lift . insertScript tracer txId
421+
mDatumId <- Generic.whenInlineDatum dt $ insertDatum tracer cache txId
422+
mScriptId <- whenMaybe mScript $ lift . insertScript tracer txId
424423
buildExtendedTxOutPart2 mDatumId mScriptId
425424

426425
buildExtendedTxOutPart2 ::
@@ -435,7 +434,6 @@ prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw
435434
{ DB.txOutTxId = txId
436435
, DB.txOutIndex = index
437436
, DB.txOutAddress = Generic.renderAddress addr
438-
, DB.txOutAddressRaw = addrRaw
439437
, DB.txOutAddressHasScript = hasScript
440438
, DB.txOutPaymentCred = Generic.maybePaymentCred addr
441439
, DB.txOutStakeAddressId = mSaId
@@ -447,14 +445,9 @@ prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw
447445
let !eutxo = ExtendedTxOut txHash txOut
448446
case ioMultiAssets iopts of
449447
MultiAssetDisable -> pure (eutxo, mempty)
450-
-- prepareMaTxOuts with NO multi asset whitelist check
451-
MultiAssetEnable -> do
448+
_ -> do
452449
!maTxOuts <- prepareMaTxOuts tracer cache Nothing maMap
453450
pure (eutxo, maTxOuts)
454-
-- prepareMaTxOuts with a multiasset whitelist check
455-
MultiAssetWhitelistPolicies whitelist -> do
456-
!maTxOuts <- prepareMaTxOuts tracer cache (Just whitelist) maMap
457-
pure (eutxo, maTxOuts)
458451

459452
hasScript :: Bool
460453
hasScript = maybe False Generic.hasCredScript (Generic.getPaymentCred addr)
@@ -467,7 +460,7 @@ insertCollateralTxOut ::
467460
(DB.TxId, ByteString) ->
468461
Generic.TxOut ->
469462
ExceptT SyncNodeError (ReaderT SqlBackend m) ()
470-
insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do
463+
insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index addr value maMap mScript dt) = do
471464
case ioPlutusExtra inOpts of
472465
PlutusDisable -> do
473466
_ <- insertColTxOutPart2 Nothing Nothing
@@ -487,8 +480,8 @@ insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index a
487480
(Nothing, Nothing) -> void $ insertColTxOutPart2 Nothing Nothing
488481
where
489482
insertColTxOutPart1 = do
490-
mDatumId <- whenFalseEmpty (isPlutusEnableOrWhitelist iopts) Nothing $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId
491-
mScriptId <- whenFalseEmpty (isPlutusEnableOrWhitelist iopts) Nothing $ whenMaybe mScript $ lift . insertScript tracer txId
483+
mDatumId <- Generic.whenInlineDatum dt $ insertDatum tracer cache txId
484+
mScriptId <- whenMaybe mScript $ lift . insertScript tracer txId
492485
insertColTxOutPart2 mDatumId mScriptId
493486
pure ()
494487

@@ -501,7 +494,6 @@ insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index a
501494
{ DB.collateralTxOutTxId = txId
502495
, DB.collateralTxOutIndex = index
503496
, DB.collateralTxOutAddress = Generic.renderAddress addr
504-
, DB.collateralTxOutAddressRaw = addrRaw
505497
, DB.collateralTxOutAddressHasScript = hasScript
506498
, DB.collateralTxOutPaymentCred = Generic.maybePaymentCred addr
507499
, DB.collateralTxOutStakeAddressId = mSaId
@@ -1465,8 +1457,8 @@ insertMultiAsset cache mWhitelist policy aName = do
14651457
Right maId -> pure $ Just maId
14661458
Left (policyBs, assetNameBs) ->
14671459
case mWhitelist of
1460+
-- we want to check the whitelist at the begining
14681461
Just whitelist ->
1469-
--
14701462
if policyBs `elem` whitelist
14711463
then Just <$> insertAssettIntoDB policyBs assetNameBs
14721464
else pure Nothing

0 commit comments

Comments
 (0)