Merge pull request #4 from input-output-hk/PLT-6090

PLT-6090: Filter contracts by address
input-output-hk · Jul 4, 2023 · e2d09a8 · e2d09a8
2 parents 4cce37e + ec2c0c1
commit e2d09a8
Show file tree

Hide file tree

Showing 2 changed files with 64 additions and 8 deletions.
diff --git a/src/Component/App.purs b/src/Component/App.purs
@@ -2,12 +2,14 @@ module Component.App where
 
 import Prelude
 
+import CardanoMultiplatformLib (bech32ToString)
 import Component.Assets.Svgs (marloweLogoUrl)
 import Component.ConnectWallet (mkConnectWallet, walletInfo)
 import Component.ConnectWallet as ConnectWallet
 import Component.ContractList (mkContractList)
 import Component.Footer (footer)
 import Component.Footer as Footer
+import Component.InputHelper (addressesInContract)
 import Component.LandingPage (mkLandingPage)
 import Component.MessageHub (mkMessageBox, mkMessagePreview)
 import Component.Modal (Size(..), mkModal)
@@ -348,7 +350,7 @@ updateAppContractInfoMap :: AppContractInfoMap -> Maybe WalletContext -> Contrac
 updateAppContractInfoMap (AppContractInfoMap { walletContext: prevWalletContext, map: prev }) walletContext updates = do
   let
     walletChanged = prevWalletContext /= walletContext
-    usedAddresses = fromMaybe [] $ _.usedAddresses <<< un WalletContext <$> walletContext
+    (usedAddresses :: Array String) = map bech32ToString $ fromMaybe [] $ _.usedAddresses <<< un WalletContext <$> walletContext
 
     map = Map.catMaybes $ updates <#> \{ contract: { resource: contractHeader@(Runtime.ContractHeader { contractId, block, roleTokenMintingPolicyId, tags }), links: endpoints }, contractState, transactions } -> do
       let
@@ -364,24 +366,32 @@ updateAppContractInfoMap (AppContractInfoMap { walletContext: prevWalletContext,
             , initialState: V1.emptyState -- FIXME: No initial state on the API LEVEL?
             }
 
-      case contractId `Map.lookup` prev of
-        Just (ContractInfo contractInfo) -> do
+      let
+        keepContract =
+          case marloweInfo of
+            Just (MarloweInfo { initialContract })
+              | (not $ Array.null $ Array.intersect usedAddresses (addressesInContract initialContract)) -> Just true
+            Just _ -> Just false
+            _ -> Nothing
+
+      case contractId `Map.lookup` prev, keepContract of
+        _, Just false -> Nothing
+        Just (ContractInfo contractInfo), Just true -> do
           pure $ ContractInfo $ contractInfo
             { marloweInfo = marloweInfo
             , _runtime
                 { contractHeader = contractHeader
                 , transactions = transactions
                 }
             }
-        Nothing -> do
-          let
-            Runtime.ContractHeader { contractId } = contractHeader
+        Nothing, _ -> do
+          let Runtime.ContractHeader { contractId } = contractHeader
           pure $ ContractInfo $
             { contractId
             , endpoints
             , marloweInfo
             , tags
             , _runtime: { contractHeader, transactions }
             }
+        _,_ -> Nothing
   AppContractInfoMap { walletContext, map }
-
diff --git a/src/Component/InputHelper.purs b/src/Component/InputHelper.purs
@@ -17,7 +17,7 @@ import Data.Tuple.Nested (type (/\), (/\))
 import Language.Marlowe.Core.V1.Folds (MapStep(..), foldMapContract)
 import Language.Marlowe.Core.V1.Semantics (applyCases, evalObservation, reduceContractStep) as V1
 import Language.Marlowe.Core.V1.Semantics (evalObservation, evalValue, reduceContractUntilQuiescent)
-import Language.Marlowe.Core.V1.Semantics.Types (AccountId, Action(..), Bound, Case(..), ChoiceId(..), Contract(..), Environment(..), Observation(..), Party(..), Payee(..), State, TimeInterval(..), Token, TokenName, Value(..))
+import Language.Marlowe.Core.V1.Semantics.Types (AccountId, Action(..), Bound, Case(..), ChoiceId(..), Contract(..), Environment(..), Observation(..), Party(..), Payee(..), State, TimeInterval(..), Token, TokenName, Value(..), Address)
 import Language.Marlowe.Core.V1.Semantics.Types (ApplyResult(..), Contract, Environment(..), Input(..), InputContent(..), ReduceResult(..), ReduceStepResult(..), State, TimeInterval) as V1
 
 data DepositInput = DepositInput AccountId Party Token BigInt.BigInt (Maybe Contract)
@@ -142,6 +142,52 @@ rolesInContract = Array.nub <<< foldMapContract
   rolesContract (Let _ _ _) = []
   rolesContract (Assert _ _) = []
 
+addressesInContract :: Contract -> Array Address
+addressesInContract = Array.nub <<< foldMapContract
+  ( MapStep
+      { mapCase: addressesCases
+      , mapContract: addressesContract
+      , mapObservation: addressesObservation
+      , mapValue: addressesValue
+      }
+  )
+  where
+  addressesObservation :: Observation -> Array TokenName
+  addressesObservation (ChoseSomething (ChoiceId _ (Address t))) = [ t ]
+  addressesObservation _ = []
+
+  addressesValue :: Value -> Array TokenName
+  addressesValue (AvailableMoney (Address t) _) = [ t ]
+  addressesValue (ChoiceValue (ChoiceId _ (Address t))) = [ t ]
+  addressesValue _ = []
+
+  addressesCases :: Case -> Array TokenName
+  addressesCases (Case (Deposit (Address t1) (Address t2) _ _) _) = [ t1, t2 ]
+  addressesCases (Case (Deposit (Address t1) _ _ _) _) = [ t1 ]
+  addressesCases (Case (Deposit _ (Address t2) _ _) _) = [ t2 ]
+  addressesCases (Case (Deposit _ _ _ _) _) = []
+  addressesCases (Case (Choice (ChoiceId _ (Address t)) _) _) = [ t ]
+  addressesCases (Case (Choice _ _) _) = []
+  addressesCases (Case (Notify _) _) = []
+  addressesCases (MerkleizedCase (Deposit (Address t1) (Address t2) _ _) _) = [ t1, t2 ]
+  addressesCases (MerkleizedCase (Deposit (Address t1) _ _ _) _) = [ t1 ]
+  addressesCases (MerkleizedCase (Deposit _ (Address t2) _ _) _) = [ t2 ]
+  addressesCases (MerkleizedCase (Deposit _ _ _ _) _) = []
+  addressesCases (MerkleizedCase (Choice (ChoiceId _ (Address t)) _) _) = [ t ]
+  addressesCases (MerkleizedCase (Choice _ _) _) = []
+  addressesCases (MerkleizedCase (Notify _) _) = []
+
+  addressesContract :: Contract -> Array TokenName
+  addressesContract Close = []
+  addressesContract (When _ _ _) = []
+  addressesContract (Pay (Address t1) (Party (Address t2)) _ _ _) = [ t1, t2 ]
+  addressesContract (Pay (Address t) _ _ _ _) = [ t ]
+  addressesContract (Pay _ (Party (Address t)) _ _ _) = [ t ]
+  addressesContract (Pay _ _ _ _ _) = []
+  addressesContract (If _ _ _) = []
+  addressesContract (Let _ _ _) = []
+  addressesContract (Assert _ _) = []
+
 -- computePath :: [InputContent /\ TimeInterval] → Contract → State → [Maybe Int]
 -- computePath inputs contract state = foldr step