SCP-2377: Add placeholders for contracts/transactions while waiting c…

…onfirmation (part 1 of 2). (#3365)

* WIP adding contract placeholders

* Adding placeholder for pending transaction.

* Review comments.

marlowe-dashboard-client/src/Capability/Marlowe.purs

@@ -2,6 +2,8 @@ module Capability.Marlowe
   ( class ManageMarlowe
   , createWallet
   , followContract
+  , createPendingFollowerApp
+  , followContractWithPendingFollowerApp
   , createContract
   , applyTransactionInput
   , redeem
@@ -75,6 +77,8 @@ class
   (MainFrameLoop m, ManageContract m, ManageMarloweStorage m, ManageWallet m, ManageWebsocket m) <= ManageMarlowe m where
   createWallet :: m (AjaxResponse WalletDetails)
   followContract :: WalletDetails -> MarloweParams -> m (DecodedAjaxResponse (Tuple PlutusAppId ContractHistory))
+  createPendingFollowerApp :: WalletDetails -> m (AjaxResponse PlutusAppId)
+  followContractWithPendingFollowerApp :: WalletDetails -> MarloweParams -> PlutusAppId -> m (DecodedAjaxResponse (Tuple PlutusAppId ContractHistory))
   createContract :: WalletDetails -> Map TokenName PubKeyHash -> Contract -> m (AjaxResponse Unit)
   applyTransactionInput :: WalletDetails -> MarloweParams -> TransactionInput -> m (AjaxResponse Unit)
   redeem :: WalletDetails -> MarloweParams -> TokenName -> m (AjaxResponse Unit)
@@ -113,6 +117,7 @@ instance monadMarloweAppM :: ManageMarlowe AppM where
                 , marloweAppId
                 , walletInfo
                 , assets
+                , previousCompanionAppState: Nothing
                 }
             pure $ createWalletDetails <$> ajaxCompanionAppId <*> ajaxMarloweAppId <*> ajaxAssets
       LocalStorage -> do
@@ -136,6 +141,7 @@ instance monadMarloweAppM :: ManageMarlowe AppM where
             , marloweAppId: PlutusAppId uuid
             , walletInfo
             , assets
+            , previousCompanionAppState: Nothing
             }
         pure $ Right walletDetails
   -- create a MarloweFollower to follow a Marlowe contract on the blockchain, and return its instance ID and initial state
@@ -169,6 +175,37 @@ instance monadMarloweAppM :: ManageMarlowe AppM where
 
           observableState = { chParams: Nothing, chHistory: mempty }
         pure $ Right $ followAppId /\ observableState
+  createPendingFollowerApp walletDetails = do
+    { dataProvider } <- ask
+    case dataProvider of
+      PAB pabType -> do
+        let
+          wallet = view (_walletInfo <<< _wallet) walletDetails
+        case pabType of
+          Plain -> Contract.activateContract (plutusAppPath MarloweFollower) wallet
+          WithMarloweContracts -> Contract.activateContract MarloweFollower wallet
+      LocalStorage -> do
+        uuid <- liftEffect genUUID
+        pure $ Right $ PlutusAppId uuid
+  followContractWithPendingFollowerApp walletDetails marloweParams followAppId = do
+    { dataProvider } <- ask
+    case dataProvider of
+      PAB pabType ->
+        runExceptT do
+          let
+            wallet = view (_walletInfo <<< _wallet) walletDetails
+          void $ withExceptT Left $ ExceptT
+            $ case pabType of
+                Plain -> Contract.invokeEndpoint (plutusAppPath MarloweFollower) followAppId "follow" marloweParams
+                WithMarloweContracts -> Contract.invokeEndpoint MarloweFollower followAppId "follow" marloweParams
+          observableStateJson <-
+            withExceptT Left $ ExceptT
+              $ case pabType of
+                  Plain -> Contract.getContractInstanceObservableState (plutusAppPath MarloweFollower) followAppId
+                  WithMarloweContracts -> Contract.getContractInstanceObservableState MarloweFollower followAppId
+          observableState <- mapExceptT (pure <<< lmap Right <<< unwrap) $ decodeJSON $ unwrap observableStateJson
+          pure $ followAppId /\ observableState
+      LocalStorage -> pure $ Right $ followAppId /\ { chParams: Nothing, chHistory: mempty }
   -- "create" a Marlowe contract on the blockchain
   -- FIXME: if we want users to be able to follow contracts that they don't have roles in, we need this function
   -- to return the MarloweParams of the created contract - but this isn't currently possible in the PAB
@@ -299,6 +336,7 @@ instance monadMarloweAppM :: ManageMarlowe AppM where
                         , marloweAppId: toFront $ view _cicContract marloweApp
                         , walletInfo
                         , assets
+                        , previousCompanionAppState: Nothing
                         }
                 Nothing -> except $ Left $ AjaxError { request: defaultRequest, description: NotFound }
             _ -> except $ Left $ AjaxError { request: defaultRequest, description: NotFound }
@@ -323,6 +361,7 @@ instance monadMarloweAppM :: ManageMarlowe AppM where
                         , marloweAppId: toFront $ view _cicContract marloweApp
                         , walletInfo
                         , assets
+                        , previousCompanionAppState: Nothing
                         }
                 Nothing -> except $ Left $ AjaxError { request: defaultRequest, description: NotFound }
             _ -> except $ Left $ AjaxError { request: defaultRequest, description: NotFound }
@@ -419,6 +458,8 @@ instance monadMarloweAppM :: ManageMarlowe AppM where
 instance monadMarloweHalogenM :: (ManageMarlowe m, ManageWebsocket m) => ManageMarlowe (HalogenM state action slots Msg m) where
   createWallet = lift createWallet
   followContract walletDetails marloweParams = lift $ followContract walletDetails marloweParams
+  createPendingFollowerApp = lift <<< createPendingFollowerApp
+  followContractWithPendingFollowerApp walletDetails marloweParams followAppId = lift $ followContractWithPendingFollowerApp walletDetails marloweParams followAppId
   createContract walletDetails roles contract = do
     result <- lift $ createContract walletDetails roles contract
     callMainFrameAction $ PlayAction $ Play.UpdateFromStorage

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

@@ -1,8 +1,9 @@
 module Contract.Lenses
   ( _tab
   , _executionState
+  , _pendingTransaction
   , _previousSteps
-  , _marloweParams
+  , _mMarloweParams
   , _followerAppId
   , _selectedStep
   , _metadata
@@ -21,7 +22,7 @@ import Data.Symbol (SProxy(..))
 import Marlowe.Execution.Types (ExecutionState, NamedAction)
 import Marlowe.Extended.Metadata (MetaData)
 import Marlowe.PAB (PlutusAppId, MarloweParams)
-import Marlowe.Semantics as Semantic
+import Marlowe.Semantics (Party, TransactionInput)
 import WalletData.Types (WalletNickname)
 
 _tab :: forall a. Lens' { tab :: Tab | a } Tab
@@ -30,11 +31,14 @@ _tab = prop (SProxy :: SProxy "tab")
 _executionState :: Lens' State ExecutionState
 _executionState = prop (SProxy :: SProxy "executionState")
 
+_pendingTransaction :: Lens' State (Maybe TransactionInput)
+_pendingTransaction = prop (SProxy :: SProxy "pendingTransaction")
+
 _previousSteps :: Lens' State (Array PreviousStep)
 _previousSteps = prop (SProxy :: SProxy "previousSteps")
 
-_marloweParams :: Lens' State MarloweParams
-_marloweParams = prop (SProxy :: SProxy "marloweParams")
+_mMarloweParams :: Lens' State (Maybe MarloweParams)
+_mMarloweParams = prop (SProxy :: SProxy "mMarloweParams")
 
 _followerAppId :: Lens' State PlutusAppId
 _followerAppId = prop (SProxy :: SProxy "followerAppId")
@@ -45,10 +49,10 @@ _selectedStep = prop (SProxy :: SProxy "selectedStep")
 _metadata :: Lens' State MetaData
 _metadata = prop (SProxy :: SProxy "metadata")
 
-_participants :: Lens' State (Map Semantic.Party (Maybe WalletNickname))
+_participants :: Lens' State (Map Party (Maybe WalletNickname))
 _participants = prop (SProxy :: SProxy "participants")
 
-_userParties :: Lens' State (Set Semantic.Party)
+_userParties :: Lens' State (Set Party)
 _userParties = prop (SProxy :: SProxy "userParties")
 
 _namedActions :: Lens' State (Array NamedAction)

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

@@ -1,5 +1,6 @@
 module Contract.State
   ( dummyState
+  , mkPlaceholderState
   , mkInitialState
   , updateState
   , handleAction
@@ -12,16 +13,17 @@ module Contract.State
 import Prelude
 import Capability.Marlowe (class ManageMarlowe, applyTransactionInput)
 import Capability.Toast (class Toast, addToast)
-import Contract.Lenses (_executionState, _marloweParams, _namedActions, _previousSteps, _selectedStep, _tab)
+import Contract.Lenses (_executionState, _mMarloweParams, _namedActions, _pendingTransaction, _previousSteps, _selectedStep, _tab, _userParties)
 import Contract.Types (Action(..), Input, PreviousStep, PreviousStepState(..), State, Tab(..), scrollContainerRef)
 import Control.Monad.Reader (class MonadAsk, asks)
 import Data.Array (difference, filter, foldl, index, length, mapMaybe, modifyAt)
 import Data.Either (Either(..))
 import Data.Foldable (foldMap, for_)
 import Data.FoldableWithIndex (foldlWithIndex)
-import Data.Lens (assign, modifying, over, to, toArrayOf, traversed, use, view, (^.))
+import Data.Lens (assign, modifying, over, set, to, toArrayOf, traversed, use, view, (^.))
+import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), isNothing)
 import Data.Newtype (unwrap)
 import Data.Ord (abs)
 import Data.Set (Set)
@@ -35,24 +37,23 @@ import Effect.Aff.AVar as AVar
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Exception.Unsafe (unsafeThrow)
 import Env (Env)
-import Halogen (HalogenM, getHTMLElementRef, gets, liftEffect, subscribe, unsubscribe)
+import Halogen (HalogenM, getHTMLElementRef, liftEffect, subscribe, unsubscribe)
 import Halogen.Query.EventSource (EventSource)
 import Halogen.Query.EventSource as EventSource
 import MainFrame.Types (ChildSlots, Msg)
 import Marlowe.Deinstantiate (findTemplate)
 import Marlowe.Execution.Lenses (_currentContract, _currentState, _pendingTimeouts, _previousState, _previousTransactions)
 import Marlowe.Execution.State (expandBalances, extractNamedActions, initExecution, isClosed, mkTx, nextState, timeoutState)
 import Marlowe.Execution.Types (ExecutionState, NamedAction(..), PreviousState)
-import Marlowe.Extended.Metadata (emptyContractMetadata)
+import Marlowe.Extended.Metadata (MetaData, emptyContractMetadata)
 import Marlowe.HasParties (getParties)
 import Marlowe.PAB (ContractHistory, PlutusAppId(..), MarloweParams)
 import Marlowe.Semantics (Contract(..), Party(..), Slot, SlotInterval(..), TransactionInput(..), _minSlot)
 import Marlowe.Semantics (Input(..), State(..)) as Semantic
-import Plutus.V1.Ledger.Value (CurrencySymbol(..))
 import Toast.Types (ajaxErrorToast, successToast)
 import WalletData.Lenses (_assets, _pubKeyHash, _walletInfo)
 import WalletData.State (adaToken)
-import WalletData.Types (WalletDetails)
+import WalletData.Types (WalletDetails, WalletNickname)
 import Web.DOM.Element (getElementsByClassName)
 import Web.DOM.HTMLCollection as HTMLCollection
 import Web.Dom.ElementExtra (Alignment(..), ScrollBehavior(..), debouncedOnScroll, scrollIntoView, throttledOnScroll)
@@ -65,8 +66,9 @@ dummyState :: State
 dummyState =
   { tab: Tasks
   , executionState: initExecution zero contract
+  , pendingTransaction: Nothing
   , previousSteps: mempty
-  , marloweParams: emptyMarloweParams
+  , mMarloweParams: Nothing
   , followerAppId: emptyPlutusAppId
   , selectedStep: 0
   , metadata: emptyContractMetadata
@@ -79,12 +81,30 @@ dummyState =
 
   emptyPlutusAppId = PlutusAppId UUID.emptyUUID
 
-  emptyMarloweParams = { rolePayoutValidatorHash: mempty, rolesCurrency: CurrencySymbol { unCurrencySymbol: "" } }
-
   emptyMarloweData = { marloweContract: contract, marloweState: emptyMarloweState }
 
   emptyMarloweState = Semantic.State { accounts: mempty, choices: mempty, boundValues: mempty, minSlot: zero }
 
+-- this is for making a placeholder state for the user who created the contract, used for displaying
+-- something before we get the MarloweParams back from the WalletCompanion app
+mkPlaceholderState :: PlutusAppId -> MetaData -> Contract -> State
+mkPlaceholderState followerAppId metaData contract =
+  { tab: Tasks
+  , executionState: initExecution zero contract
+  , pendingTransaction: Nothing
+  , previousSteps: mempty
+  , mMarloweParams: Nothing
+  , followerAppId
+  , selectedStep: 0
+  , metadata: metaData
+  , participants: getParticipants contract
+  , userParties: mempty
+  , namedActions: mempty
+  }
+
+-- this is for making a fully fleshed out state from nothing, used when someone who didn't create the
+-- contract is given a role in it, and gets the MarloweParams at the same time as they hear about
+-- everything else
 mkInitialState :: WalletDetails -> Slot -> PlutusAppId -> ContractHistory -> Maybe State
 mkInitialState walletDetails currentSlot followerAppId { chParams, chHistory } =
   bind chParams \(marloweParams /\ marloweData) ->
@@ -99,26 +119,16 @@ mkInitialState walletDetails currentSlot followerAppId { chParams, chHistory } =
     in
       flip map mTemplate \template ->
         let
-          isRoleParty party = case party of
-            Role _ -> true
-            _ -> false
-
-          -- Note we filter out PK parties here. This is because we don't have a design for displaying
-          -- them anywhere, and because we are currently only using one in a special case (in the Escrow
-          -- with Collateral contract), where it doesn't make much sense to show it to the user anyway.
-          -- If we ever want to use PK parties for other purposes, we will need to rethink this.
-          roleParties :: Array Party
-          roleParties = filter isRoleParty $ Set.toUnfoldable $ getParties contract
-
           initialState =
             { tab: Tasks
             , executionState: initialExecutionState
+            , pendingTransaction: Nothing
             , previousSteps: mempty
-            , marloweParams
+            , mMarloweParams: Just marloweParams
             , followerAppId
             , selectedStep: 0
             , metadata: template.metaData
-            , participants: Map.fromFoldable $ map (\x -> x /\ Nothing) roleParties
+            , participants: getParticipants contract
             , userParties: getUserParties walletDetails marloweParams
             , namedActions: mempty
             }
@@ -130,16 +140,59 @@ mkInitialState walletDetails currentSlot followerAppId { chParams, chHistory } =
             # regenerateStepCards currentSlot
             # selectLastStep
 
-updateState :: Slot -> Array TransactionInput -> State -> State
-updateState currentSlot transactionInputs state =
+-- Note 1: We filter out PK parties from the participants of the contract. This is because
+-- we don't have a design for displaying them anywhere, and because we are currently only
+-- using one in a special case (in the Escrow with Collateral contract), where it doesn't
+-- make much sense to show it to the user anyway. If we ever want to use PK parties for
+-- other purposes, we will need to rethink this.
+-- Note 2: In general there is no way to map parties to wallet nicknames. It is possible
+-- for the user who created the contract and distributed the role tokens, but this
+-- information will be lost when the browser is closed. And other participants don't have
+-- this information in the first place. Also, in the future it could be possible to give
+-- role tokens to other wallets, and we wouldn't know about that either. Still, we're
+-- keeping the `Maybe WalletNickname` in here for now, in case a way of making it generally
+-- available (e.g. through the metadata server) ever becomes apparent.
+getParticipants :: Contract -> Map Party (Maybe WalletNickname)
+getParticipants contract = Map.fromFoldable $ map (\x -> x /\ Nothing) (getRoleParties contract)
+
+getRoleParties :: Contract -> Array Party
+getRoleParties contract = filter isRoleParty $ Set.toUnfoldable $ getParties contract
+  where
+  isRoleParty party = case party of
+    Role _ -> true
+    _ -> false
+
+updateState :: WalletDetails -> MarloweParams -> Slot -> Array TransactionInput -> State -> State
+updateState walletDetails marloweParams currentSlot transactionInputs state =
   let
     previousTransactionInputs = toArrayOf (_executionState <<< _previousTransactions) state
 
     newTransactionInputs = difference transactionInputs previousTransactionInputs
 
+    -- If the `MarloweParams` are `Nothing`, that means this is the first update we've received for
+    -- a placeholder contract, and we'll need to set the `MarloweParams` now and also work out the
+    -- `userParties` (because these depend on the `MarloweParams`).
+    mSetParamsAndParties =
+      if isNothing $ state ^. _mMarloweParams then
+        set _mMarloweParams (Just marloweParams)
+          <<< set _userParties (getUserParties walletDetails marloweParams)
+      else
+        identity
+
+    -- If there are new transaction inputs to apply, we need to clear the `pendingTransaction`. If
+    -- we wanted to be really careful, we could check that the new transaction input matches the
+    -- pending one, but I can't see how it wouldn't (and I don't think it matters anyway).
+    mClearPendingTransaction =
+      if newTransactionInputs /= mempty then
+        set _pendingTransaction Nothing
+      else
+        identity
+
     updateExecutionState = over _executionState (applyTransactionInputs newTransactionInputs)
   in
     state
+      # mSetParamsAndParties
+      # mClearPendingTransaction
       # updateExecutionState
       # regenerateStepCards currentSlot
       # selectLastStep
@@ -168,18 +221,18 @@ handleAction ::
   Input -> Action -> HalogenM State Action ChildSlots Msg m Unit
 handleAction input@{ currentSlot, walletDetails } (ConfirmAction namedAction) = do
   currentExeState <- use _executionState
-  marloweParams <- use _marloweParams
-  let
-    contractInput = toInput namedAction
+  mMarloweParams <- use _mMarloweParams
+  for_ mMarloweParams \marloweParams -> do
+    let
+      contractInput = toInput namedAction
 
-    txInput = mkTx currentSlot (currentExeState ^. _currentContract) (Unfoldable.fromMaybe contractInput)
-  ajaxApplyInputs <- applyTransactionInput walletDetails marloweParams txInput
-  case ajaxApplyInputs of
-    Left ajaxError -> addToast $ ajaxErrorToast "Failed to submit transaction." ajaxError
-    Right _ -> do
-      stepNumber <- gets currentStep
-      handleAction input (MoveToStep stepNumber)
-      addToast $ successToast "Payment received, step completed."
+      txInput = mkTx currentSlot (currentExeState ^. _currentContract) (Unfoldable.fromMaybe contractInput)
+    ajaxApplyInputs <- applyTransactionInput walletDetails marloweParams txInput
+    case ajaxApplyInputs of
+      Left ajaxError -> addToast $ ajaxErrorToast "Failed to submit transaction." ajaxError
+      Right _ -> do
+        assign _pendingTransaction $ Just txInput
+        addToast $ successToast "Transaction submitted, awating confirmation."
 
 handleAction _ (ChangeChoice choiceId chosenNum) = modifying _namedActions (map changeChoice)
   where
@@ -246,6 +299,7 @@ applyTimeout currentSlot state =
     updateExecutionState = over _executionState (timeoutState currentSlot)
   in
     state
+      # set _pendingTransaction Nothing
       # updateExecutionState
       # regenerateStepCards currentSlot
       # selectLastStep

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

@@ -23,9 +23,15 @@ import WalletData.Types (WalletDetails, WalletNickname)
 type State
   = { tab :: Tab -- this is the tab of the current (latest) step - previous steps have their own tabs
     , executionState :: ExecutionState
+    -- When the user submits a transaction, we save it here until we get confirmation from the PAB and
+    -- can advance the contract. This enables us to show immediate feedback to the user while we wait.
+    , pendingTransaction :: Maybe TransactionInput
     , previousSteps :: Array PreviousStep
     , followerAppId :: PlutusAppId
-    , marloweParams :: MarloweParams
+    -- Every contract needs MarloweParams, but this is a Maybe because we want to create "placeholder"
+    -- contracts when a user creates a contract, to show on the page until the blockchain settles and
+    -- we get the MarloweParams back from the PAB (through the MarloweFollower app).
+    , mMarloweParams :: Maybe MarloweParams
     -- Which step is selected. This index is 0 based and should be between [0, previousSteps.length]
     -- (both sides inclusive). This is because the array represent the past steps and the
     -- executionState has the current state and visually we can select any one of them.