allow whitelist for insertMultiAsset

Author: Cmdv

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs

@@ -84,6 +84,7 @@ import Control.Monad.Extra (mapMaybeM, whenJust)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Monad.Trans.Except.Extra (newExceptT)
 import qualified Data.Aeson as Aeson
+import qualified Data.Binary as Binary
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import Data.Either.Extra (eitherToMaybe)
 import Data.Group (invert)
@@ -1335,29 +1336,32 @@ prepareMaTxMint ::
   MultiAsset StandardCrypto ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.MaTxMint]
 prepareMaTxMint syncEnv _tracer cache txId (MultiAsset mintMap) =
-  -- TODO: VINCE HERE
   concatMapM (lift . prepareOuter) $ Map.toList mintMap
   where
     prepareOuter ::
       (MonadBaseControl IO m, MonadIO m) =>
       (PolicyID StandardCrypto, Map AssetName Integer) ->
       ReaderT SqlBackend m [DB.MaTxMint]
     prepareOuter (policy, aMap) =
-      mapM (prepareInner policy) $ Map.toList aMap
+      mapMaybeM (prepareInner policy) $ Map.toList aMap
 
     prepareInner ::
       (MonadBaseControl IO m, MonadIO m) =>
       PolicyID StandardCrypto ->
       (AssetName, Integer) ->
-      ReaderT SqlBackend m DB.MaTxMint
+      ReaderT SqlBackend m (Maybe DB.MaTxMint)
     prepareInner policy (aname, amount) = do
-      maId <- insertMultiAsset syncEnv cache policy aname
-      pure $
-        DB.MaTxMint
-          { DB.maTxMintIdent = maId
-          , DB.maTxMintQuantity = DB.integerToDbInt65 amount
-          , DB.maTxMintTxId = txId
-          }
+      maIdM <- insertMultiAsset syncEnv cache policy aname
+      case maIdM of
+        Just maId ->
+          pure $
+            Just $
+              DB.MaTxMint
+                { DB.maTxMintIdent = maId
+                , DB.maTxMintQuantity = DB.integerToDbInt65 amount
+                , DB.maTxMintTxId = txId
+                }
+        Nothing -> pure Nothing
 
 prepareMaTxOuts ::
   (MonadBaseControl IO m, MonadIO m) =>
@@ -1374,39 +1378,63 @@ prepareMaTxOuts syncEnv _tracer cache maMap =
       (PolicyID StandardCrypto, Map AssetName Integer) ->
       ReaderT SqlBackend m [MissingMaTxOut]
     prepareOuter (policy, aMap) =
-      mapM (prepareInner policy) $ Map.toList aMap
+      mapMaybeM (prepareInner policy) $ Map.toList aMap
 
     prepareInner ::
       (MonadBaseControl IO m, MonadIO m) =>
       PolicyID StandardCrypto ->
       (AssetName, Integer) ->
-      ReaderT SqlBackend m MissingMaTxOut
+      ReaderT SqlBackend m (Maybe MissingMaTxOut)
     prepareInner policy (aname, amount) = do
-      maId <- insertMultiAsset syncEnv cache policy aname
-      pure $
-        MissingMaTxOut
-          { mmtoIdent = maId
-          , mmtoQuantity = DbWord64 (fromIntegral amount)
-          }
+      maIdM <- insertMultiAsset syncEnv cache policy aname
+      case maIdM of
+        Just maId ->
+          pure $
+            Just $
+              MissingMaTxOut
+                { mmtoIdent = maId
+                , mmtoQuantity = DbWord64 (fromIntegral amount)
+                }
+        Nothing -> pure Nothing
+
+-- concatMapMaybe :: Monad m => (Maybe a -> m [b]) -> [Maybe a] -> m [b]
+-- concatMapMaybe f xs = do
+--   ys <- traverse f' xs
+--   pure (concat ys)
+--   where
+--     f' (Just x) = f (Just x)
+--     f' Nothing = pure []
 
 insertMultiAsset ::
   (MonadBaseControl IO m, MonadIO m) =>
   SyncEnv ->
   Cache ->
   PolicyID StandardCrypto ->
   AssetName ->
-  ReaderT SqlBackend m DB.MultiAssetId
-insertMultiAsset _syncEnv cache policy aName = do
+  ReaderT SqlBackend m (Maybe DB.MultiAssetId)
+insertMultiAsset syncEnv cache policy aName = do
   mId <- queryMAWithCache cache policy aName
   case mId of
-    Right maId -> pure maId
-    Left (policyBs, assetNameBs) ->
-      DB.insertMultiAssetUnchecked $
-        DB.MultiAsset
-          { DB.multiAssetPolicy = policyBs
-          , DB.multiAssetName = assetNameBs
-          , DB.multiAssetFingerprint = DB.unAssetFingerprint (DB.mkAssetFingerprint policyBs assetNameBs)
-          }
+    Right maId -> pure $ Just maId
+    Left (policyBs, assetNameBs) -> do
+      -- check if current policyBs matches with any values in MYPolicies whitelist given by user
+      case ioWhitelistMAPolicies $ soptInsertOptions $ envOptions syncEnv of
+        Strict.Just whiteListWord64 -> do
+          let whiteListBS = map (LBS.toStrict . Binary.encode) whiteListWord64
+          if policyBs `elem` whiteListBS
+            then insertIntoDB policyBs assetNameBs
+            else pure Nothing
+        Strict.Nothing -> insertIntoDB policyBs assetNameBs
+  where
+    insertIntoDB policyBs assetNameBs = do
+      mid <-
+        DB.insertMultiAssetUnchecked $
+          DB.MultiAsset
+            { DB.multiAssetPolicy = policyBs
+            , DB.multiAssetName = assetNameBs
+            , DB.multiAssetFingerprint = DB.unAssetFingerprint (DB.mkAssetFingerprint policyBs assetNameBs)
+            }
+      pure $ Just mid
 
 insertScript ::
   (MonadBaseControl IO m, MonadIO m) =>