Adding wireframe contract setup workflow. (#2773)

* Adding wireframe contract setup workflow.

* Responding to review comments and adding enhanced contract metadata.

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

@@ -1,19 +1,26 @@
-module Contract.State where
+module Contract.State
+  ( defaultState
+  , mkInitialState
+  , handleQuery
+  , handleAction
+  ) where
 
 import Prelude
 import Contract.Types (Action(..), Query(..), Side(..), State, Tab(..), _confirmation, _executionState, _side, _step, _tab)
 import Data.Lens (assign, modifying, use)
 import Data.Maybe (Maybe(..))
 import Data.Unfoldable as Unfoldable
 import Effect.Aff.Class (class MonadAff)
-import Halogen (HalogenM, raise)
-import MainFrame.Types (ChildSlots, Msg(..))
+import Halogen (HalogenM)
+import MainFrame.Types (ChildSlots, Msg)
 import Marlowe.Execution (NamedAction(..), _namedActions, _state, initExecution, merge, mkTx, nextState)
-import Marlowe.Semantics (Contract, Slot, _minSlot)
-import Plutus.PAB.Webserver.Types (StreamToServer(..))
+import Marlowe.Semantics (Contract(..), Slot, _minSlot)
 
-initialState :: Slot -> Contract -> State
-initialState slot contract =
+defaultState :: State
+defaultState = mkInitialState zero Close
+
+mkInitialState :: Slot -> Contract -> State
+mkInitialState slot contract =
   { tab: Tasks
   , executionState: initExecution slot contract
   , side: Overview

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

@@ -4,8 +4,7 @@ module Contract.View
   ) where
 
 import Prelude hiding (div)
-import Contract.Types (Action(..))
-import Css (classNames)
+import Contract.Types (Action(..), State)
 import Data.Foldable (foldr)
 import Data.Lens (view)
 import Data.Map (Map)
@@ -15,17 +14,16 @@ import Halogen.HTML (HTML, button, div, div_, h2_, text)
 import Halogen.HTML.Events (onClick)
 import MainFrame.Types (ContractStatus)
 import Marlowe.Execution (ExecutionStep, NamedAction(..))
-import Marlowe.Semantics (Accounts, ChoiceId(..), Contract, Input(..), Party, TransactionInput(..), _accounts)
+import Marlowe.Semantics (Accounts, ChoiceId(..), Input(..), Party, TransactionInput(..), _accounts)
 
 contractsScreen :: forall p. ContractStatus -> HTML p Action
 contractsScreen contractStatus =
-  div
-    [ classNames [ "p-1" ] ]
+  div_
     [ h2_
         [ text "Dashboard home" ]
     ]
 
-contractDetailsCard :: forall p. Contract -> HTML p Action
+contractDetailsCard :: forall p. State -> HTML p Action
 contractDetailsCard contractInstance =
   div_
     [ h2_

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

@@ -5,12 +5,13 @@ module MainFrame.Lenses
   , _subState
   , _pickupState
   , _walletState
-  , _contractState
   , _screen
   , _card
   , _wallet
   , _menuOpen
   , _webSocketStatus
+  , _templateState
+  , _contractState
   ) where
 
 import Prelude
@@ -22,7 +23,7 @@ import Data.Lens.Record (prop)
 import Data.Symbol (SProxy(..))
 import MainFrame.Types (PickupState, State, WalletState, WebSocketStatus)
 import Marlowe.Semantics (PubKey)
-import Template.Types (Template)
+import Template.Types (State, Template) as Template
 import WalletData.Types (WalletLibrary, WalletNicknameKey)
 
 _wallets :: Lens' State WalletLibrary
@@ -31,28 +32,22 @@ _wallets = prop (SProxy :: SProxy "wallets")
 _newWalletNicknameKey :: Lens' State WalletNicknameKey
 _newWalletNicknameKey = prop (SProxy :: SProxy "newWalletNicknameKey")
 
-_templates :: Lens' State (Array Template)
+_templates :: Lens' State (Array Template.Template)
 _templates = prop (SProxy :: SProxy "templates")
 
 _subState :: Lens' State (Either PickupState WalletState)
 _subState = prop (SProxy :: SProxy "subState")
 
--- This isn't a Traversal' in any meaningful sense (that I can see), but a Traversal'
--- is a Strong Choice Profunctor, so this is a neat type for the occasion.
--- Alternatively: forall a. Strong a => Choice a => Optic' a State PickupState
+_webSocketStatus :: Lens' State WebSocketStatus
+_webSocketStatus = prop (SProxy :: SProxy "webSocketStatus")
+
+------------------------------------------------------------
 _pickupState :: Traversal' State PickupState
 _pickupState = _subState <<< _Left
 
--- As above.
 _walletState :: Traversal' State WalletState
 _walletState = _subState <<< _Right
 
-_contractState :: Lens' State Contract.State
-_contractState = prop (SProxy :: SProxy "contractState")
-
-_webSocketStatus :: Lens' State WebSocketStatus
-_webSocketStatus = prop (SProxy :: SProxy "webSocketStatus")
-
 ------------------------------------------------------------
 _screen :: forall s b. Lens' { screen :: s | b } s
 _screen = prop (SProxy :: SProxy "screen")
@@ -66,3 +61,9 @@ _wallet = prop (SProxy :: SProxy "wallet")
 
 _menuOpen :: Lens' WalletState Boolean
 _menuOpen = prop (SProxy :: SProxy "menuOpen")
+
+_templateState :: Lens' WalletState Template.State
+_templateState = prop (SProxy :: SProxy "templateState")
+
+_contractState :: Lens' WalletState Contract.State
+_contractState = prop (SProxy :: SProxy "contractState")

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

@@ -1,13 +1,12 @@
 module MainFrame.State (mkMainFrame) where
 
 import Prelude
-import Contract.State (handleAction, initialState) as Contract
-import Contract.Types (Action(..)) as Contract
+import Contract.State (handleAction, defaultState) as Contract
 import Contract.Types (_executionState)
 import Control.Monad.Except (runExcept)
 import Data.Either (Either(..))
 import Data.Foldable (for_)
-import Data.Lens (assign, modifying, over, set, use)
+import Data.Lens (Traversal', assign, modifying, over, set, use, view)
 import Data.Lens.Extra (peruse)
 import Data.Map (empty, insert, member)
 import Data.Map.Extra (findIndex)
@@ -17,17 +16,21 @@ import Effect.Aff.Class (class MonadAff)
 import Effect.Random (random)
 import Foreign.Generic (decodeJSON, encodeJSON)
 import Halogen (Component, HalogenM, liftEffect, mkComponent, mkEval, modify_)
-import Halogen.Extra (mapSubmodule)
+import Halogen.Extra (mapMaybeSubmodule)
 import Halogen.HTML (HTML)
 import LocalStorage (getItem, removeItem, setItem)
-import MainFrame.Lenses (_card, _contractState, _menuOpen, _newWalletNicknameKey, _pickupState, _screen, _subState, _templates, _walletState, _wallets, _webSocketStatus)
-import MainFrame.Types (Action(..), ChildSlots, ContractStatus(..), Msg, PickupCard(..), PickupScreen(..), PickupState, Query(..), Screen(..), State, WalletState, WebSocketStatus(..))
+import MainFrame.Lenses (_card, _contractState, _menuOpen, _newWalletNicknameKey, _pickupState, _screen, _templateState, _subState, _templates, _walletState, _wallets, _webSocketStatus)
+import MainFrame.Types (Action(..), Card(..), ChildSlots, ContractStatus(..), Msg, PickupCard(..), PickupScreen(..), PickupState, Query(..), Screen(..), State, WalletState, WebSocketStatus(..))
 import MainFrame.View (render)
 import Marlowe.Execution (_contract)
-import Marlowe.Semantics (Contract(..), PubKey)
+import Marlowe.Extended (fillTemplate, toCore)
+import Marlowe.Semantics (PubKey)
 import Plutus.PAB.Webserver.Types (StreamToClient(..))
 import StaticData (walletLocalStorageKey, walletsLocalStorageKey)
+import Template.Lenses (_extendedContract, _template, _templateContent)
 import Template.Library (templates)
+import Template.State (defaultState, handleAction, mkInitialState) as Template
+import Template.Types (ContractSetupScreen(..))
 import WalletData.Lenses (_key, _nickname)
 import WalletData.Types (WalletDetails)
 import WebSocket.Support as WS
@@ -53,7 +56,6 @@ initialState =
   , newWalletNicknameKey: mempty
   , templates: mempty
   , subState: Left initialPickupState
-  , contractState: Contract.initialState zero Close
   , webSocketStatus: WebSocketClosed Nothing
   }
 
@@ -69,6 +71,8 @@ mkWalletState pubKeyHash =
   , menuOpen: false
   , screen: ContractsScreen Running
   , card: Nothing
+  , templateState: Template.defaultState
+  , contractState: Contract.defaultState
   }
 
 defaultWalletDetails :: WalletDetails
@@ -177,10 +181,48 @@ handleAction AddNewWallet = do
     newWallets <- use _wallets
     liftEffect $ setItem walletsLocalStorageKey $ encodeJSON newWallets
 
--- contract actions
-handleAction (ContractAction contractAction) = do
-  case contractAction of
-    Contract.ClosePanel -> pure unit
-    action -> mapSubmodule _contractState ContractAction $ Contract.handleAction action
+-- template actions
+handleAction (SetTemplate template) = do
+  mCurrentTemplate <- peruse (_walletState <<< _templateState <<< _template)
+  when (mCurrentTemplate /= Just template) $ assign (_walletState <<< _templateState) $ Template.mkInitialState template
+  handleAction $ SetScreen $ ContractSetupScreen ContractRolesScreen
+
+handleAction (TemplateAction templateAction) = Template.handleAction templateAction
 
-handleAction (StartContract contract) = assign (_contractState <<< _executionState <<< _contract) contract
+-- contract actions
+handleAction StartContract = do
+  mTemplateState <- peruse (_walletState <<< _templateState)
+  for_ mTemplateState \templateState ->
+    let
+      extendedContract = view (_template <<< _extendedContract) templateState
+
+      templateContent = view _templateContent templateState
+
+      mContract = toCore $ fillTemplate templateContent extendedContract
+    in
+      for_ mContract \contract -> do
+        assign (_walletState <<< _contractState <<< _executionState <<< _contract) contract
+        handleAction $ SetScreen $ ContractsScreen Running
+        handleAction $ ToggleCard ContractCard
+
+handleAction (ContractAction contractAction) = handleSubAction (_walletState <<< _contractState) ContractAction Contract.defaultState (Contract.handleAction contractAction)
+
+-- there must be a nicer way to get the current state than by manually
+-- piecing together each of its properties, but I haven't found it :(
+handleSubAction ::
+  forall m state' action'.
+  MonadAff m =>
+  Traversal' State state' ->
+  (action' -> Action) ->
+  state' ->
+  HalogenM state' action' ChildSlots Msg m Unit ->
+  HalogenM State Action ChildSlots Msg m Unit
+handleSubAction traversal wrapper submoduleInitialState submoduleHandleAction = do
+  wallets <- use _wallets
+  newWalletNicknameKey <- use _newWalletNicknameKey
+  templates <- use _templates
+  subState <- use _subState
+  webSocketStatus <- use _webSocketStatus
+  let
+    state = { wallets, newWalletNicknameKey, templates, subState, webSocketStatus }
+  mapMaybeSubmodule state traversal wrapper submoduleInitialState submoduleHandleAction

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

@@ -20,9 +20,10 @@ import Contract.Types as Contract
 import Data.Either (Either)
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
-import Marlowe.Semantics (Contract, PubKey)
+import Marlowe.Semantics (PubKey)
 import Plutus.PAB.Webserver.Types (StreamToClient, StreamToServer)
-import Template.Types (Template)
+import Template.Types (ContractSetupScreen, Template)
+import Template.Types (Action, State) as Template
 import WalletData.Types (WalletDetails, WalletLibrary, WalletNicknameKey)
 import Web.Socket.Event.CloseEvent (CloseEvent, reason) as WS
 import WebSocket.Support (FromSocket) as WS
@@ -37,10 +38,6 @@ type State
     , newWalletNicknameKey :: WalletNicknameKey
     , templates :: Array Template
     , subState :: Either PickupState WalletState
-    -- TODO: (work out how to) move contract state into wallet state
-    -- (the puzzle is how to handle contract actions in the mainframe if the
-    -- submodule state is behind an `Either`... :thinking_face:)
-    , contractState :: Contract.State
     , webSocketStatus :: WebSocketStatus
     }
 
@@ -55,6 +52,7 @@ instance showWebSocketStatus :: Show WebSocketStatus where
   show (WebSocketClosed Nothing) = "WebSocketClosed"
   show (WebSocketClosed (Just closeEvent)) = "WebSocketClosed " <> WS.reason closeEvent
 
+-- pickup state --------------------------------------------
 type PickupState
   = { screen :: PickupScreen
     , card :: Maybe PickupCard
@@ -73,17 +71,20 @@ data PickupCard
 
 derive instance eqPickupCard :: Eq PickupCard
 
+-- wallet state --------------------------------------------
 type WalletState
   = { wallet :: PubKey
     , menuOpen :: Boolean
     , screen :: Screen
     , card :: Maybe Card
+    , templateState :: Template.State
+    , contractState :: Contract.State
     }
 
 data Screen
   = ContractsScreen ContractStatus
   | WalletLibraryScreen
-  | ContractSetupScreen Template
+  | ContractSetupScreen ContractSetupScreen
 
 derive instance eqScreen :: Eq Screen
 
@@ -92,7 +93,9 @@ data Card
   | ViewWalletCard WalletNicknameKey WalletDetails
   | PutdownWalletCard
   | TemplateLibraryCard
-  | ContractCard Contract
+  | NewContractForRoleCard
+  | ContractSetupConfirmationCard
+  | ContractCard
 
 derive instance eqCard :: Eq Card
 
@@ -132,9 +135,12 @@ data Action
   | SetNewWalletNickname String
   | SetNewWalletKey PubKey
   | AddNewWallet
+  -- template actions
+  | SetTemplate Template
+  | TemplateAction Template.Action
   -- contract actions
+  | StartContract
   | ContractAction Contract.Action
-  | StartContract Contract
 
 -- | Here we decide which top-level queries to track as GA events, and
 -- how to classify them.
@@ -155,6 +161,9 @@ instance actionIsEvent :: IsEvent Action where
   toEvent (SetNewWalletNickname _) = Nothing
   toEvent (SetNewWalletKey _) = Nothing
   toEvent AddNewWallet = Just $ defaultEvent "AddNewWallet"
+  -- template actions
+  toEvent (SetTemplate _) = Just $ defaultEvent "SetTemplate"
+  toEvent (TemplateAction templateAction) = toEvent templateAction
   -- contract actions
+  toEvent StartContract = Just $ defaultEvent "StartContract"
   toEvent (ContractAction contractAction) = toEvent contractAction
-  toEvent (StartContract _) = Just $ defaultEvent "StartContract"