SCP-2166: Disabling god mode and determining roles from wallet assets (…

…#3084)

* Disabling god mode and determining roles from wallet assets.

marlowe-dashboard-client/src/Contract/Lenses.purs

@@ -7,7 +7,7 @@ module Contract.Lenses
   , _selectedStep
   , _metadata
   , _participants
-  , _mActiveUserParty
+  , _userParties
   , _namedActions
   ) where
 
@@ -16,6 +16,7 @@ import Data.Lens (Lens')
 import Data.Lens.Record (prop)
 import Data.Map (Map)
 import Data.Maybe (Maybe)
+import Data.Set (Set)
 import Data.Symbol (SProxy(..))
 import Marlowe.Execution (ExecutionState, NamedAction)
 import Marlowe.Extended.Metadata (MetaData)
@@ -47,8 +48,8 @@ _metadata = prop (SProxy :: SProxy "metadata")
 _participants :: Lens' State (Map Semantic.Party (Maybe WalletNickname))
 _participants = prop (SProxy :: SProxy "participants")
 
-_mActiveUserParty :: Lens' State (Maybe Semantic.Party)
-_mActiveUserParty = prop (SProxy :: SProxy "mActiveUserParty")
+_userParties :: Lens' State (Set Semantic.Party)
+_userParties = prop (SProxy :: SProxy "userParties")
 
 _namedActions :: Lens' State (Array NamedAction)
 _namedActions = prop (SProxy :: SProxy "namedActions")

marlowe-dashboard-client/src/Contract/State.purs

@@ -17,13 +17,14 @@ import Contract.Types (Action(..), PreviousStep, PreviousStepState(..), State, T
 import Control.Monad.Reader (class MonadAsk, asks)
 import Data.Array (difference, foldl, head, index, length, mapMaybe)
 import Data.Either (Either(..))
-import Data.Foldable (for_)
+import Data.Foldable (foldMap, for_)
 import Data.FoldableWithIndex (foldlWithIndex)
 import Data.Lens (assign, modifying, over, to, toArrayOf, traversed, use, view, (^.))
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
 import Data.Ord (abs)
+import Data.Set (Set)
 import Data.Set as Set
 import Data.Traversable (traverse)
 import Data.Tuple.Nested (get1, get2, get3, (/\))
@@ -42,12 +43,13 @@ import Marlowe.Deinstantiate (findTemplate)
 import Marlowe.HasParties (getParties)
 import Marlowe.Execution (ExecutionState, NamedAction(..), PreviousState, _currentContract, _currentState, _pendingTimeouts, _previousState, _previousTransactions, expandBalances, extractNamedActions, initExecution, isClosed, mkTx, nextState, timeoutState)
 import Marlowe.Extended.Metadata (emptyContractMetadata)
-import Marlowe.PAB (ContractInstanceId(..), History)
-import Marlowe.Semantics (Contract(..), Input(..), Party, Slot, SlotInterval(..), Token(..), TransactionInput(..))
+import Marlowe.PAB (ContractInstanceId(..), History, MarloweParams)
+import Marlowe.Semantics (Contract(..), Input(..), Party(..), Slot, SlotInterval(..), Token(..), TransactionInput(..))
 import Marlowe.Semantics as Semantic
 import Marlowe.Slot (currentSlot)
 import Plutus.V1.Ledger.Value (CurrencySymbol(..))
 import Toast.Types (ajaxErrorToast, successToast)
+import WalletData.Lenses (_assets, _pubKeyHash, _walletInfo)
 import WalletData.Types (WalletDetails)
 import Web.DOM.Element (getElementsByClassName)
 import Web.DOM.HTMLCollection as HTMLCollection
@@ -68,7 +70,7 @@ dummyState =
   , selectedStep: 0
   , metadata: emptyContractMetadata
   , participants: mempty
-  , mActiveUserParty: Nothing
+  , userParties: mempty
   , namedActions: mempty
   }
   where
@@ -82,8 +84,8 @@ dummyState =
 
   emptyMarloweState = Semantic.State { accounts: mempty, choices: mempty, boundValues: mempty, minSlot: zero }
 
-mkInitialState :: Slot -> ContractInstanceId -> History -> Maybe State
-mkInitialState currentSlot contractInstanceId history =
+mkInitialState :: WalletDetails -> Slot -> ContractInstanceId -> History -> Maybe State
+mkInitialState walletDetails currentSlot contractInstanceId history =
   let
     marloweParams = get1 $ unwrap history
 
@@ -103,8 +105,8 @@ mkInitialState currentSlot contractInstanceId history =
   in
     flip map mTemplate \template ->
       let
-        participants :: Array Party
-        participants = Set.toUnfoldable $ getParties contract
+        parties :: Array Party
+        parties = Set.toUnfoldable $ getParties contract
 
         initialState =
           { tab: Tasks
@@ -114,8 +116,8 @@ mkInitialState currentSlot contractInstanceId history =
           , contractInstanceId
           , selectedStep: 0
           , metadata: template.metaData
-          , participants: Map.fromFoldable $ map (\x -> x /\ Nothing) participants
-          , mActiveUserParty: Nothing -- FIXME: this should be a function of the walletDetails
+          , participants: Map.fromFoldable $ map (\x -> x /\ Nothing) parties
+          , userParties: getUserParties walletDetails marloweParams
           , namedActions: mempty
           }
 
@@ -142,6 +144,21 @@ updateState currentSlot history state =
       # regenerateStepCards currentSlot
       # selectLastStep
 
+getUserParties :: WalletDetails -> MarloweParams -> Set Party
+getUserParties walletDetails marloweParams =
+  let
+    pubKeyHash = view (_walletInfo <<< _pubKeyHash) walletDetails
+
+    assets = view _assets walletDetails
+
+    currencySymbolString = (unwrap marloweParams.rolesCurrency).unCurrencySymbol
+
+    mCurrencyTokens = Map.lookup currencySymbolString (unwrap assets)
+
+    roleTokens = foldMap (Set.map Role <<< Map.keys <<< Map.filter ((/=) zero)) mCurrencyTokens
+  in
+    Set.insert (PK $ unwrap pubKeyHash) roleTokens
+
 handleAction ::
   forall m.
   MonadAff m =>

marlowe-dashboard-client/src/Contract/Types.purs

@@ -11,6 +11,7 @@ import Prelude
 import Analytics (class IsEvent, defaultEvent)
 import Data.Map (Map)
 import Data.Maybe (Maybe(..))
+import Data.Set (Set)
 import Halogen (RefLabel(..))
 import Marlowe.Execution (ExecutionState, NamedAction)
 import Marlowe.Extended.Metadata (MetaData)
@@ -30,12 +31,7 @@ type State
     , selectedStep :: Int
     , metadata :: MetaData
     , participants :: Map Party (Maybe WalletNickname)
-    -- This field represents the logged-user party in the contract.
-    -- If it's Nothing, then the logged-user is an observant of the contract. That could happen
-    -- if the person who creates the contract does not put him/herself as a participant of the contract
-    -- or if a Role participant sells the role token to another participant
-    -- FIXME: The active party can use multiple roles, change this to (Array Party)
-    , mActiveUserParty :: Maybe Party
+    , userParties :: Set Party
     -- These are the possible actions a user can make in the current step. We store this mainly because
     -- extractNamedActions could potentially be unperformant to compute.
     , namedActions :: Array NamedAction

marlowe-dashboard-client/src/Contract/View.purs

@@ -4,7 +4,7 @@ module Contract.View
   ) where
 
 import Prelude hiding (div)
-import Contract.Lenses (_executionState, _mActiveUserParty, _metadata, _namedActions, _participants, _previousSteps, _selectedStep, _tab)
+import Contract.Lenses (_executionState, _metadata, _namedActions, _participants, _previousSteps, _selectedStep, _tab, _userParties)
 import Contract.State (currentStep, isContractClosed)
 import Contract.Types (Action(..), PreviousStep, PreviousStepState(..), State, Tab(..), scrollContainerRef)
 import Css (applyWhen, classNames, toggleWhen)
@@ -320,7 +320,9 @@ renderPartyPastActions state { inputs, interval, party } =
   let
     participantName = participantWithNickname state party
 
-    isActiveParticipant = (state ^. _mActiveUserParty) == Just party
+    userParties = state ^. _userParties
+
+    isActiveParticipant = Set.member party userParties
 
     fromDescription =
       if isActiveParticipant then
@@ -335,7 +337,7 @@ renderPartyPastActions state { inputs, interval, party } =
       IDeposit intoAccountOf by token value ->
         let
           toDescription =
-            if (state ^. _mActiveUserParty) == Just intoAccountOf then
+            if Set.member intoAccountOf userParties then
               "your"
             else
               if by == intoAccountOf then
@@ -427,13 +429,13 @@ renderContractClose =
 -- then groups by participant and sorts it so that the owner starts first and the rest go
 -- in alphabetical order
 expandAndGroupByRole ::
-  Maybe Party ->
+  Set Party ->
   Set Party ->
   Array NamedAction ->
   Array (Tuple Party (Array NamedAction))
-expandAndGroupByRole mActiveUserParty allParticipants actions =
+expandAndGroupByRole userParties allParticipants actions =
   expandedActions
-    # Array.sortBy currentPartyFirst
+    # Array.sortBy currentPartiesFirst
     # Array.groupBy sameParty
     # map extractGroupedParty
   where
@@ -446,9 +448,9 @@ expandAndGroupByRole mActiveUserParty allParticipants actions =
           Just participant -> [ participant /\ action ]
           Nothing -> Set.toUnfoldable allParticipants <#> \participant -> participant /\ action
 
-  currentPartyFirst (Tuple party1 _) (Tuple party2 _)
-    | Just party1 == mActiveUserParty = LT
-    | Just party2 == mActiveUserParty = GT
+  currentPartiesFirst (Tuple party1 _) (Tuple party2 _)
+    | Set.member party1 userParties = LT
+    | Set.member party2 userParties = GT
     | otherwise = compare party1 party2
 
   sameParty a b = fst a == fst b
@@ -462,11 +464,13 @@ renderTasks state =
   let
     executionState = state ^. _executionState
 
+    userParties = state ^. _userParties
+
     actions = state ^. _namedActions
 
     expandedActions =
       expandAndGroupByRole
-        (state ^. _mActiveUserParty)
+        userParties
         (Map.keys $ state ^. _participants)
         actions
   in
@@ -518,7 +522,9 @@ debugMode = true
 renderAction :: forall p. State -> Party -> NamedAction -> HTML p Action
 renderAction state party namedAction@(MakeDeposit intoAccountOf by token value) =
   let
-    isActiveParticipant = (state ^. _mActiveUserParty) == Just party
+    userParties = state ^. _userParties
+
+    isActiveParticipant = Set.member party userParties
 
     fromDescription =
       if isActiveParticipant then
@@ -528,7 +534,7 @@ renderAction state party namedAction@(MakeDeposit intoAccountOf by token value)
         Role roleName -> capitalize roleName <> " makes"
 
     toDescription =
-      if (state ^. _mActiveUserParty) == Just intoAccountOf then
+      if Set.member intoAccountOf userParties then
         "your"
       else
         if by == intoAccountOf then
@@ -558,7 +564,9 @@ renderAction state party namedAction@(MakeDeposit intoAccountOf by token value)
 
 renderAction state party namedAction@(MakeChoice choiceId bounds mChosenNum) =
   let
-    isActiveParticipant = (state ^. _mActiveUserParty) == Just party
+    userParties = state ^. _userParties
+
+    isActiveParticipant = Set.member party userParties
 
     metadata = state ^. _metadata
 
@@ -631,7 +639,9 @@ renderAction _ _ (Evaluate _) = div [] [ text "FIXME: what should we put here? E
 
 renderAction state party CloseContract =
   let
-    isActiveParticipant = (state ^. _mActiveUserParty) == Just party
+    userParties = state ^. _userParties
+
+    isActiveParticipant = Set.member party userParties
   in
     div_
       -- FIXME: revisit the text

marlowe-dashboard-client/src/ContractHome/State.purs

@@ -32,16 +32,18 @@ import Marlowe.PAB (ContractInstanceId(..), MarloweData, MarloweParams, History(
 import Marlowe.Semantics (ChoiceId(..), Contract, Input(..), Party(..), Slot(..), SlotInterval(..), TransactionInput(..), Token(..))
 import Marlowe.Semantics (emptyState) as Semantic
 import Plutus.V1.Ledger.Value (CurrencySymbol(..))
+import WalletData.State (defaultWalletDetails)
+import WalletData.Types (WalletDetails)
 import WalletData.Validation (parseContractInstanceId)
 
 -- see note [dummyState] in MainFrame.State
 dummyState :: State
-dummyState = mkInitialState zero mempty
+dummyState = mkInitialState defaultWalletDetails zero mempty
 
-mkInitialState :: Slot -> Map ContractInstanceId History -> State
-mkInitialState currentSlot contracts =
+mkInitialState :: WalletDetails -> Slot -> Map ContractInstanceId History -> State
+mkInitialState walletDetails currentSlot contracts =
   { status: Running
-  , contracts: mapMaybeWithKey (Contract.mkInitialState currentSlot) contracts
+  , contracts: mapMaybeWithKey (Contract.mkInitialState walletDetails currentSlot) contracts
   , selectedContractIndex: Nothing
   }
 

marlowe-dashboard-client/src/MainFrame/State.purs

@@ -248,7 +248,7 @@ updateRunningContracts companionState = do
               let
                 currentSlot = view _currentSlot playState
 
-                mContractState = Contract.mkInitialState currentSlot contractInstanceId history
+                mContractState = Contract.mkInitialState walletDetails currentSlot contractInstanceId history
               case mContractState of
                 Just contractState -> do
                   modifying (_playState <<< _allContracts) $ insert contractInstanceId contractState

marlowe-dashboard-client/src/Play/State.purs

@@ -72,7 +72,7 @@ mkInitialState walletLibrary walletDetails contracts currentSlot timezoneOffset
   , currentSlot
   , timezoneOffset
   , templateState: Template.dummyState
-  , contractsState: ContractHome.mkInitialState currentSlot contracts
+  , contractsState: ContractHome.mkInitialState walletDetails currentSlot contracts
   }
 
 handleAction ::