scp-2089: Marlowe Dashboard Client: implement balances in contracts (#…

…2960)

* Implement balances in the running contracts

* Applied PR feedback

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

@@ -17,8 +17,10 @@ import Control.Monad.Reader (class MonadAsk)
 import Data.Array (length)
 import Data.Lens (assign, modifying, over, to, toArrayOf, traversed, use, view, (^.))
 import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.RawJson (RawJson(..))
+import Data.Set as Set
 import Data.Unfoldable as Unfoldable
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
@@ -28,11 +30,11 @@ import Foreign.Generic (encode)
 import Foreign.JSON (unsafeStringify)
 import Halogen (HalogenM, liftEffect, modify_)
 import MainFrame.Types (ChildSlots, Msg)
-import Marlowe.Execution (NamedAction(..), _currentContract, _pendingTimeouts, _previousTransactions, extractNamedActions, initExecution, isClosed, mkTx, nextState, timeoutState)
+import Marlowe.Execution (NamedAction(..), PreviousState, _currentContract, _currentState, _pendingTimeouts, _previousState, expandBalances, extractNamedActions, initExecution, isClosed, mkTx, nextState, timeoutState)
 import Marlowe.Extended (TemplateContent, fillTemplate, resolveRelativeTimes, toCore)
 import Marlowe.Extended as Extended
 import Marlowe.Extended.Metadata (MetaData, emptyContractMetadata)
-import Marlowe.Semantics (Contract(..), Input(..), Slot, SlotInterval(..), TransactionInput(..))
+import Marlowe.Semantics (Contract(..), Input(..), Slot, SlotInterval(..), Token(..), TransactionInput(..))
 import Marlowe.Semantics as Semantic
 import Marlowe.Slot (currentSlot)
 import WalletData.Types (Nickname)
@@ -115,16 +117,16 @@ handleQuery (ApplyTx tx next) = do
   modify_ $ applyTx slot tx
   pure $ Just next
 
-transactionsToStep :: TransactionInput -> PreviousStep
-transactionsToStep txInput =
+transactionsToStep :: State -> PreviousState -> PreviousStep
+transactionsToStep { participants } { txInput, state } =
   let
     TransactionInput { interval: SlotInterval minSlot maxSlot, inputs } = txInput
 
-    -- FIXME: We need to ask for all participants and all tokens and check the current
-    --        balance to complete this
-    balances = mempty
+    -- TODO: When we add support for multiple tokens we should extract the possible tokens from the
+    --       contract, store it in ContractState and pass them here.
+    balances = expandBalances (Set.toUnfoldable $ Map.keys participants) [ Token "" "" ] state
 
-    state =
+    stepState =
       -- For the moment the only way to get an empty transaction is if there was a timeout,
       -- but later on there could be other reasons to move a contract forward, and we should
       -- compare with the contract to see the reason.
@@ -134,15 +136,15 @@ transactionsToStep txInput =
         TransactionStep txInput
   in
     { balances
-    , state
+    , state: stepState
     }
 
-timeoutToStep :: Slot -> PreviousStep
-timeoutToStep slot =
+timeoutToStep :: State -> Slot -> PreviousStep
+timeoutToStep { participants, executionState } slot =
   let
-    -- FIXME: We need to ask for all participants and all tokens and check the current
-    --        balance to complete this
-    balances = mempty
+    currentContractState = executionState ^. _currentState
+
+    balances = expandBalances (Set.toUnfoldable $ Map.keys participants) [ Token "" "" ] currentContractState
   in
     { balances
     , state: TimeoutStep slot
@@ -152,10 +154,10 @@ regenerateStepCards :: Slot -> State -> State
 regenerateStepCards currentSlot state =
   let
     confirmedSteps :: Array PreviousStep
-    confirmedSteps = toArrayOf (_executionState <<< _previousTransactions <<< to transactionsToStep) state
+    confirmedSteps = toArrayOf (_executionState <<< _previousState <<< traversed <<< to (transactionsToStep state)) state
 
     pendingTimeoutSteps :: Array PreviousStep
-    pendingTimeoutSteps = toArrayOf (_executionState <<< _pendingTimeouts <<< traversed <<< to timeoutToStep) state
+    pendingTimeoutSteps = toArrayOf (_executionState <<< _pendingTimeouts <<< traversed <<< to (timeoutToStep state)) state
 
     previousSteps = confirmedSteps <> pendingTimeoutSteps
 

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

@@ -12,7 +12,7 @@ import Css as Css
 import Data.Array (foldr, intercalate)
 import Data.Array as Array
 import Data.Array.NonEmpty (NonEmptyArray)
-import Data.Array.NonEmpty as NEA
+import Data.Array.NonEmpty as NonEmptyArray
 import Data.BigInteger (BigInteger, fromInt, fromString, toNumber)
 import Data.Foldable (foldMap)
 import Data.Formatter.Number (Formatter(..), format)
@@ -29,9 +29,9 @@ import Data.Tuple.Nested ((/\))
 import Halogen.HTML (HTML, a, button, div, div_, h1, h2, h3, input, p, span, span_, sup_, text)
 import Halogen.HTML.Events.Extra (onClick_, onValueInput_)
 import Halogen.HTML.Properties (InputType(..), enabled, href, placeholder, target, type_, value)
-import Marlowe.Execution (NamedAction(..), _mNextTimeout, getActionParticipant)
+import Marlowe.Execution (NamedAction(..), _currentState, _mNextTimeout, expandBalances, getActionParticipant)
 import Marlowe.Extended (contractTypeName)
-import Marlowe.Semantics (Bound(..), ChoiceId(..), Input(..), Party(..), Slot, SlotInterval, Token(..), TransactionInput(..), getEncompassBound)
+import Marlowe.Semantics (Bound(..), ChoiceId(..), Input(..), Party(..), Slot, SlotInterval, Token(..), TransactionInput(..), Accounts, getEncompassBound)
 import Marlowe.Slot (secondsDiff, slotToDateTime)
 import Material.Icons (Icon(..), icon)
 import TimeHelpers (formatDate, formatTime, humanizeDuration, humanizeInterval)
@@ -260,10 +260,7 @@ renderPastStep state stepNumber step =
 
     renderBody Tasks { state: TimeoutStep timeoutSlot } = renderTimeout stepNumber timeoutSlot
 
-    -- FIXME: The state of renderBalances is incorrect, once we implement that function correctly
-    --        this code should be the following:
-    -- renderBody Balances { balances } = renderBalances balances
-    renderBody Balances _ = renderBalances state
+    renderBody Balances { balances } = renderBalances state balances
   in
     renderContractCard stepNumber state
       [ div [ classNames [ "py-2.5", "px-4", "flex", "items-center", "border-b", "border-lightgray" ] ]
@@ -301,11 +298,11 @@ groupTransactionInputByParticipant (TransactionInput { inputs, interval }) =
   mergeInputsFromSameParty ::
     NonEmptyArray { inputs :: Array Input, party :: Party } ->
     InputsByParty
-  mergeInputsFromSameParty nea =
+  mergeInputsFromSameParty elements =
     foldr
       (\elem accu -> accu { inputs = elem.inputs <> accu.inputs })
-      (NEA.head nea # \{ party } -> { inputs: [], party, interval })
-      nea
+      (NonEmptyArray.head elements # \{ party } -> { inputs: [], party, interval })
+      elements
 
 renderPastActions :: forall p a. State -> TransactionInput -> HTML p a
 renderPastActions state txInput =
@@ -384,6 +381,12 @@ renderCurrentStep currentSlot state =
 
     mNextTimeout = state ^. (_executionState <<< _mNextTimeout)
 
+    participants = state ^. _participants
+
+    currentState = state ^. (_executionState <<< _currentState)
+
+    balances = expandBalances (Set.toUnfoldable $ Map.keys participants) [ Token "" "" ] currentState
+
     timeoutStr =
       maybe "timed out"
         (\nextTimeout -> humanizeDuration $ secondsDiff nextTimeout currentSlot)
@@ -403,7 +406,7 @@ renderCurrentStep currentSlot state =
           [ case currentTab /\ contractIsClosed of
               Tasks /\ false -> renderTasks state
               Tasks /\ true -> renderContractClose
-              Balances /\ _ -> renderBalances state
+              Balances /\ _ -> renderBalances state balances
           ]
       ]
 
@@ -452,8 +455,8 @@ expandAndGroupByRole mActiveUserParty allParticipants actions =
   sameParty a b = fst a == fst b
 
   extractGroupedParty :: NonEmptyArray (Tuple Party NamedAction) -> Tuple Party (Array NamedAction)
-  extractGroupedParty group = case NEA.unzip group of
-    tokens /\ actions' -> NEA.head tokens /\ NEA.toArray actions'
+  extractGroupedParty group = case NonEmptyArray.unzip group of
+    tokens /\ actions' -> NonEmptyArray.head tokens /\ NonEmptyArray.toArray actions'
 
 renderTasks :: forall p. State -> HTML p Action
 renderTasks state =
@@ -669,17 +672,13 @@ currency (Token "" "dollar") value = "$ " <> formatBigInteger value
 
 currency (Token _ name) value = formatBigInteger value <> " " <> name
 
-renderBalances :: forall p a. State -> HTML p a
-renderBalances state =
+renderBalances :: forall p a. State -> Accounts -> HTML p a
+renderBalances state accounts =
   let
-    -- accounts :: Array (Tuple (Tuple Party Token) BigInteger)
-    -- accounts = Map.toUnfoldable $ state ^. (_executionState <<< _state <<< _accounts)
-    -- FIXME: What should we show if a participant doesn't have balance yet?
-    -- FIXME: We fake the accounts for development until we fix the semantics
-    accounts' =
-      [ (Role "alice" /\ Token "" "") /\ (fromInt 2500)
-      , (Role "bob" /\ Token "" "") /\ (fromInt 10)
-      ]
+    -- TODO: Right now we only have one type of Token (ada), but when we support multiple tokens we may want to group by
+    --       participant and show the different tokens for each participant.
+    accounts' :: Array (Tuple (Tuple Party Token) BigInteger)
+    accounts' = Map.toUnfoldable accounts
   in
     div [ classNames [ "text-xs" ] ]
       ( append

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

@@ -90,14 +90,14 @@ filledContract2 (Slot currentSlot) = do
               (SlotInterval (Slot currentSlot) (Slot currentSlot))
           , inputs:
               List.singleton
-                $ IDeposit (Role "Investor") (Role "Investor") (Token "" "") (fromInt 1000)
+                $ IDeposit (Role "Seller") (Role "Seller") (Token "" "") (fromInt 1000)
           }
       ]
 
     nextState' :: Contract.State -> TransactionInput -> Contract.State
     nextState' state txInput = applyTx (Slot currentSlot) txInput state
   contract <- toCore $ fillTemplate templateContent EscrowWithCollateral.extendedContract
-  initialState <- pure $ Contract.mkInitialState "dummy contract 2" zero EscrowWithCollateral.metaData participants (Just $ Role "Alice") contract
+  initialState <- pure $ Contract.mkInitialState "dummy contract 2" zero EscrowWithCollateral.metaData participants (Just $ Role "Buyer") contract
   pure $ foldl nextState' initialState transactions
 
 filledContract3 :: Slot -> Maybe Contract.State
@@ -146,7 +146,7 @@ handleAction (SelectView view) = assign _status view
 
 handleAction (OpenContract ix) = assign _selectedContractIndex $ Just ix
 
-handleAction (AdvanceTimeoutedContracts currentSlot) =
+handleAction (AdvanceTimedOutContracts currentSlot) =
   modify_
     $ over
         (_contracts <<< traversed <<< filtered (\contract -> contract.executionState.mNextTimeout == Just currentSlot))

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

@@ -4,7 +4,7 @@ import Prelude
 import Analytics (class IsEvent, defaultEvent)
 import Contract.Types (State) as Contract
 import Data.Maybe (Maybe(..))
-import Marlowe.Semantics (Slot(..))
+import Marlowe.Semantics (Slot)
 
 data ContractStatus
   = Running
@@ -29,10 +29,10 @@ data Action
   = ToggleTemplateLibraryCard
   | SelectView ContractStatus
   | OpenContract Int
-  | AdvanceTimeoutedContracts Slot
+  | AdvanceTimedOutContracts Slot
 
 instance actionIsEvent :: IsEvent Action where
   toEvent ToggleTemplateLibraryCard = Just $ defaultEvent "ToggleTemplateLibraryCard"
   toEvent (SelectView _) = Just $ defaultEvent "SelectView"
   toEvent (OpenContract _) = Just $ defaultEvent "OpenContract"
-  toEvent (AdvanceTimeoutedContracts _) = Nothing
+  toEvent (AdvanceTimedOutContracts _) = Nothing

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

@@ -3,14 +3,15 @@ module Marlowe.Execution where
 import Prelude
 import Data.Array as Array
 import Data.BigInteger (BigInteger, fromInt)
-import Data.Lens (Lens', Traversal', _Just, traversed, view)
+import Data.Lens (Lens', Traversal', _Just, traversed, view, (^.))
 import Data.Lens.Record (prop)
 import Data.List (List)
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..), fromMaybe')
+import Data.Maybe (Maybe(..), fromMaybe, fromMaybe')
 import Data.Symbol (SProxy(..))
-import Marlowe.Semantics (AccountId, Action(..), Bound, Case(..), ChoiceId(..), ChosenNum, Contract(..), Input, Observation, Party, Payment, ReduceResult(..), Slot(..), SlotInterval(..), State, Timeouts(..), Token, TransactionInput(..), TransactionOutput(..), ValueId, _boundValues, _minSlot, computeTransaction, emptyState, evalValue, makeEnvironment, reduceContractUntilQuiescent, timeouts)
+import Data.Tuple.Nested ((/\))
+import Marlowe.Semantics (AccountId, Accounts, Action(..), Bound, Case(..), ChoiceId(..), ChosenNum, Contract(..), Input, Observation, Party, Payment, ReduceResult(..), Slot(..), SlotInterval(..), State, Timeouts(..), Token, TransactionInput(..), TransactionOutput(..), ValueId, _accounts, _boundValues, _minSlot, computeTransaction, emptyState, evalValue, makeEnvironment, reduceContractUntilQuiescent, timeouts)
 
 -- This represents a previous step in the execution. The state property corresponds to the state before the
 -- txInput was applied and it's saved as an early optimization to calculate the balances at each step.
@@ -264,3 +265,19 @@ extractNamedActions _ { mPendingTimeouts: Just { contract: Close } } = [ CloseCo
 extractNamedActions currentSlot { mPendingTimeouts: Just { contract, state } } = extractActionsFromContract currentSlot state contract
 
 extractNamedActions currentSlot { current: { state, contract } } = extractActionsFromContract currentSlot state contract
+
+-- This function expands the balances inside the Semantic.State to all participants and tokens, using zero if the participant
+-- does not have balance for that token.
+expandBalances :: Array Party -> Array Token -> State -> Accounts
+expandBalances participants tokens state =
+  let
+    stateAccounts = state ^. _accounts
+  in
+    Map.fromFoldable do
+      party <- participants
+      tokens
+        <#> \token ->
+            let
+              key = party /\ token
+            in
+              key /\ (fromMaybe zero $ Map.lookup key stateAccounts)

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

@@ -92,7 +92,7 @@ handleAction (ToggleCard card) = do
     _ -> handleAction $ SetCard $ Just card
 
 handleAction (SetCurrentSlot currentSlot) = do
-  toContractHome $ ContractHome.handleAction $ ContractHome.AdvanceTimeoutedContracts currentSlot
+  toContractHome $ ContractHome.handleAction $ ContractHome.AdvanceTimedOutContracts currentSlot
   modify_
     $ set (_playState <<< _currentSlot) currentSlot