Skip to content

Commit 41a1fce

Browse files
committed
remove case logic and make code more idiomatic
1 parent d4e3660 commit 41a1fce

File tree

2 files changed

+15
-27
lines changed

2 files changed

+15
-27
lines changed

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

+1-2
Original file line numberDiff line numberDiff line change
@@ -245,8 +245,7 @@ extractSyncOptions snp aop =
245245
, ioUseLedger = useLedger
246246
, ioShelley = enpHasShelley snp
247247
, ioRewards = True
248-
, -- TODO: cmdv: this is where we plug configs
249-
ioMultiAssets = MultiAssetDisable
248+
, ioMultiAssets = MultiAssetDisable
250249
, ioMetadata = MetadataDisable
251250
, ioPlutusExtra = PlutusDisable
252251
, ioOffChainPoolData = enpHasOffChainPoolData snp

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

+14-25
Original file line numberDiff line numberDiff line change
@@ -96,48 +96,37 @@ mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath)
9696
mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) </> fp
9797

9898
-- 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
10099
plutusMultiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
101100
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))
101+
plutusWhitelistCheck syncEnv txOuts || multiAssetWhitelistCheck syncEnv txOuts
107102

108103
plutusWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
109104
plutusWhitelistCheck syncEnv txOuts = do
110105
-- first check the config option
111106
case ioPlutusExtra iopts of
112107
PlutusEnable -> True
113-
PlutusDisable -> False
108+
PlutusDisable -> True
114109
PlutusWhitelistScripts plutusWhitelist -> plutuswhitelistCheck plutusWhitelist
115110
where
116111
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
112+
plutuswhitelistCheck :: NonEmpty ByteString -> Bool
113+
plutuswhitelistCheck whitelist =
114+
any (\txOut -> isScriptHashWhitelisted whitelist txOut || isAddressWhitelisted whitelist txOut) txOuts
115+
-- check if the script hash is in the whitelist
116+
isScriptHashWhitelisted :: NonEmpty ByteString -> Generic.TxOut -> Bool
117+
isScriptHashWhitelisted whitelist txOut =
118+
maybe False ((`elem` whitelist) . Generic.txScriptHash) (Generic.txOutScript txOut)
119+
-- check if the address is in the whitelist
120+
isAddressWhitelisted :: NonEmpty ByteString -> Generic.TxOut -> Bool
121+
isAddressWhitelisted whitelist txOut =
122+
maybe False (`elem` whitelist) (Generic.maybePaymentCred $ Generic.txOutAddress txOut)
134123

135124
multiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
136125
multiAssetWhitelistCheck syncEnv txOuts = do
137126
let iopts = soptInsertOptions $ envOptions syncEnv
138127
case ioMultiAssets iopts of
139128
MultiAssetEnable -> True
140-
MultiAssetDisable -> False
129+
MultiAssetDisable -> True
141130
MultiAssetWhitelistPolicies multiAssetWhitelist ->
142131
or multiAssetwhitelistCheck
143132
where

0 commit comments

Comments
 (0)