SCB: Refactoring the frontend State type.

plutus-scb-client/src/MainFrame.purs

@@ -16,7 +16,6 @@ import Control.Monad.State (class MonadState)
 import Control.Monad.State.Extra (zoomStateT)
 import Data.Array (filter)
 import Data.Either (Either(..))
-import Data.Foldable (traverse_)
 import Data.Lens (_1, _2, assign, findOf, modifying, to, traversed, view)
 import Data.Lens.At (at)
 import Data.Lens.Extra (peruse, toSetOf)
@@ -26,7 +25,7 @@ import Data.Maybe (Maybe(..))
 import Data.RawJson (RawJson(..))
 import Data.Set (Set)
 import Data.Set as Set
-import Data.Traversable (for_)
+import Data.Traversable (for_, traverse_)
 import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect, liftEffect)
@@ -46,14 +45,14 @@ import Playground.Types (FunctionSchema(..), _FunctionSchema)
 import Plutus.SCB.Events.Contract (ContractInstanceState(..))
 import Plutus.SCB.Types (ContractExe)
 import Plutus.SCB.Webserver (SPParams_(..), getApiContractByContractinstanceidSchema, getApiFullreport, postApiContractActivate, postApiContractByContractinstanceidEndpointByEndpointname)
-import Plutus.SCB.Webserver.Types (ContractSignatureResponse(..), FullReport, StreamToClient(..), StreamToServer(..))
+import Plutus.SCB.Webserver.Types (ContractReport, ContractSignatureResponse(..), StreamToClient(..), StreamToServer(..))
 import Prim.TypeError (class Warn, Text)
 import Schema (FormSchema)
 import Schema.Types (formArgumentToJson, toArgument)
 import Schema.Types as Schema
 import Servant.PureScript.Ajax (AjaxError)
 import Servant.PureScript.Settings (SPSettings_, defaultSettings)
-import Types (EndpointForm, HAction(..), Output(..), Query(..), State(..), View(..), WebData, _annotatedBlockchain, _chainReport, _chainState, _contractActiveEndpoints, _contractInstanceIdString, _contractReport, _contractSignatures, _contractStates, _crAvailableContracts, _csContract, _csCurrentState, _currentView, _events, _fullReport, _webSocketMessage)
+import Types (EndpointForm, HAction(..), Output(..), Query(..), State(..), View(..), WebData, _annotatedBlockchain, _chainReport, _chainState, _contractActiveEndpoints, _contractInstanceIdString, _contractReport, _contractSignatures, _contractStates, _crAvailableContracts, _csContract, _csCurrentState, _currentView, _events, _webSocketMessage)
 import Validation (_argument)
 import View as View
 import WebSocket.Support as WS
@@ -65,7 +64,9 @@ initialState :: State
 initialState =
   State
     { currentView: ActiveContracts
-    , fullReport: NotAsked
+    , contractReport: NotAsked
+    , chainReport: NotAsked
+    , events: NotAsked
     , chainState: Chain.initialState
     , contractSignatures: Map.empty
     , webSocketMessage: NotAsked
@@ -106,12 +107,12 @@ handleQuery ::
   Query a -> m (Maybe a)
 handleQuery (ReceiveWebSocketMessage (WS.ReceiveMessage msg) next) = do
   case msg of
-    Right (NewChainReport report) -> assign (_fullReport <<< _Success <<< _chainReport) report
+    Right (NewChainReport report) -> assign (_chainReport <<< _Success) report
     Right (NewContractReport report) -> do
-      assign (_fullReport <<< _Success <<< _contractReport) report
+      assign (_contractReport <<< _Success) report
       traverse_ updateFormsForContractInstance
         (view _contractStates report)
-    Right (NewChainEvents events) -> assign (_fullReport <<< _Success <<< _events) events
+    Right (NewChainEvents events) -> assign (_events <<< _Success) events
     Right (Echo _) -> pure unit
     Right (ErrorResponse _) -> pure unit
     Left err -> pure unit
@@ -138,18 +139,23 @@ handleAction (ChangeView view) = do
 handleAction (ActivateContract contract) = void $ runAjax $ postApiContractActivate contract
 
 handleAction LoadFullReport = do
-  assign _fullReport Loading
+  assignFullReportData Loading
   fullReportResult <- runAjax getApiFullreport
-  assign _fullReport fullReportResult
+  assignFullReportData fullReportResult
   for_ fullReportResult
-    ( \fullReport ->
+    ( \report ->
         traverse_ updateFormsForContractInstance
-          (view (_contractReport <<< _contractStates) fullReport)
+          (view (_contractReport <<< _contractStates) report)
     )
+  where
+  assignFullReportData v = do
+    assign _contractReport (view _contractReport <$> v)
+    assign _chainReport (view _chainReport <$> v)
+    assign _events (view _events <$> v)
 
 handleAction (ChainAction subaction) = do
   mAnnotatedBlockchain <-
-    peruse (_fullReport <<< _Success <<< _chainReport <<< _annotatedBlockchain <<< to AnnotatedBlockchain)
+    peruse (_chainReport <<< _Success <<< _annotatedBlockchain <<< to AnnotatedBlockchain)
   let
     wrapper ::
       Warn (Text "The question, 'Should we animate this?' feels like it belongs in the Chain module. Not here.") =>
@@ -218,15 +224,15 @@ updateFormsForContractInstance newContractInstance = do
 createNewEndpointFormsM ::
   forall m.
   Monad m =>
-  m (FullReport ContractExe) ->
+  m (ContractReport ContractExe) ->
   m (ContractInstanceState ContractExe) ->
   m (Maybe (Array EndpointForm))
-createNewEndpointFormsM mFullReport mInstanceState = do
-  fullReport <- mFullReport
+createNewEndpointFormsM mContractReport mInstanceState = do
+  contractReport <- mContractReport
   instanceState <- mInstanceState
   let
     matchingSignature :: Maybe (ContractSignatureResponse ContractExe)
-    matchingSignature = getMatchingSignature instanceState fullReport
+    matchingSignature = getMatchingSignature instanceState contractReport
 
     newForms :: Maybe (Array EndpointForm)
     newForms = createEndpointForms instanceState <$> matchingSignature
@@ -263,12 +269,11 @@ getMatchingSignature ::
   forall t.
   Eq t =>
   ContractInstanceState t ->
-  FullReport t ->
+  ContractReport t ->
   Maybe (ContractSignatureResponse t)
 getMatchingSignature (ContractInstanceState { csContractDefinition }) =
   findOf
-    ( _contractReport
-        <<< _crAvailableContracts
+    ( _crAvailableContracts
         <<< traversed
     )
     isMatch

plutus-scb-client/src/Types.purs

@@ -2,19 +2,19 @@ module Types where
 
 import Prelude
 import Chain.Types as Chain
-import Data.Tuple.Nested (type (/\))
 import Control.Monad.Gen as Gen
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Json.JsonMap (JsonMap)
 import Data.Json.JsonUUID (JsonUUID, _JsonUUID)
-import Data.Lens (Getter', Lens', Traversal', to, traversed)
+import Data.Lens (Getter', Traversal', Lens', to, traversed)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
 import Data.Map (Map)
 import Data.Newtype (class Newtype)
 import Data.NonEmpty ((:|))
 import Data.Symbol (SProxy(..))
+import Data.Tuple.Nested (type (/\))
 import Data.UUID as UUID
 import Foreign (MultipleErrors)
 import Language.Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint, EndpointDescription)
@@ -27,7 +27,7 @@ import Playground.Types (FunctionSchema)
 import Plutus.SCB.Events (ChainEvent)
 import Plutus.SCB.Events.Contract (ContractInstanceId, ContractInstanceState, ContractSCBRequest, PartiallyDecodedResponse, _ContractInstanceState, _UserEndpointRequest)
 import Plutus.SCB.Types (ContractExe)
-import Plutus.SCB.Webserver.Types (ChainReport, ContractReport, ContractSignatureResponse, FullReport, StreamToClient, StreamToServer, _ChainReport, _ContractReport, _ContractSignatureResponse)
+import Plutus.SCB.Webserver.Types (ChainReport, ContractReport, ContractSignatureResponse, StreamToClient, StreamToServer, _ChainReport, _ContractReport, _ContractSignatureResponse)
 import Schema (FormSchema)
 import Schema.Types (FormArgument, FormEvent)
 import Servant.PureScript.Ajax (AjaxError)
@@ -56,7 +56,9 @@ data HAction
 newtype State
   = State
   { currentView :: View
-  , fullReport :: WebData (FullReport ContractExe)
+  , contractReport :: WebData (ContractReport ContractExe)
+  , chainReport :: WebData (ChainReport ContractExe)
+  , events :: WebData (Array (ChainEvent ContractExe))
   , chainState :: Chain.State
   , contractSignatures :: Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm))
   , webSocketMessage :: RemoteData MultipleErrors (StreamToClient ContractExe)
@@ -74,16 +76,13 @@ derive instance genericState :: Generic State _
 _currentView :: Lens' State View
 _currentView = _Newtype <<< prop (SProxy :: SProxy "currentView")
 
-_fullReport :: Lens' State (WebData (FullReport ContractExe))
-_fullReport = _Newtype <<< prop (SProxy :: SProxy "fullReport")
-
-_contractReport :: forall t. Lens' (FullReport t) (ContractReport t)
+_contractReport :: forall s r a. Newtype s { contractReport :: a | r } => Lens' s a
 _contractReport = _Newtype <<< prop (SProxy :: SProxy "contractReport")
 
-_chainReport :: forall t. Lens' (FullReport t) (ChainReport t)
+_chainReport :: forall s r a. Newtype s { chainReport :: a | r } => Lens' s a
 _chainReport = _Newtype <<< prop (SProxy :: SProxy "chainReport")
 
-_events :: forall t. Lens' (FullReport t) (Array (ChainEvent t))
+_events :: forall s r a. Newtype s { events :: a | r } => Lens' s a
 _events = _Newtype <<< prop (SProxy :: SProxy "events")
 
 _chainState :: Lens' State Chain.State

plutus-scb-client/src/View.purs

@@ -5,15 +5,17 @@ import Chain.Types as Chain
 import Data.Lens (traversed, view)
 import Data.Lens.Extra (toArrayOf)
 import Data.Map (Map)
-import Data.Tuple.Nested (type (/\))
+import Data.Tuple (Tuple)
+import Data.Tuple.Nested (type (/\), tuple3, uncurry3)
 import Effect.Aff.Class (class MonadAff)
 import Halogen.HTML (ClassName(..), ComponentHTML, HTML, div, div_, h1, text)
 import Halogen.HTML.Properties (class_)
 import NavTabs (mainTabBar, viewContainer)
+import Plutus.SCB.Events (ChainEvent)
 import Plutus.SCB.Events.Contract (ContractInstanceId, ContractInstanceState)
 import Plutus.SCB.Types (ContractExe)
-import Plutus.SCB.Webserver.Types (FullReport(..))
-import Prelude (($), (<$>), (<<<))
+import Plutus.SCB.Webserver.Types (ChainReport, ContractReport)
+import Prelude (($), (<$>), (<*>), (<<<))
 import Types (EndpointForm, HAction(..), State(..), View(..), WebData, _crAvailableContracts, _csrDefinition, _utxoIndex)
 import View.Blockchain (annotatedBlockchainPane)
 import View.Contracts (contractStatusesPane, installedContractsPane)
@@ -24,13 +26,18 @@ render ::
   forall m slots.
   MonadAff m =>
   State -> ComponentHTML HAction slots m
-render (State { currentView, chainState, fullReport, contractSignatures, webSocketMessage }) =
+render (State { currentView, chainState, contractReport, chainReport, events, contractSignatures, webSocketMessage }) =
   div
     [ class_ $ ClassName "main-frame" ]
     [ container_
         [ mainHeader
         , mainTabBar ChangeView tabs currentView
-        , div_ (webDataPane (fullReportPane currentView chainState contractSignatures) fullReport)
+        , div_
+            $ webDataPane
+                ( uncurry3
+                    (mainPane currentView contractSignatures chainState)
+                )
+                (tuple3 <$> contractReport <*> chainReport <*> events)
         ]
     ]
 
@@ -58,39 +65,68 @@ tabs =
     }
   ]
 
-fullReportPane ::
-  forall p.
+mainPane ::
+  forall p t.
   View ->
+  Map ContractInstanceId (WebData (ContractInstanceState t /\ Array EndpointForm)) ->
   Chain.State ->
-  Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm)) ->
-  FullReport ContractExe ->
+  ContractReport ContractExe ->
+  ChainReport t ->
+  Array (ChainEvent ContractExe) ->
   HTML p HAction
-fullReportPane currentView chainState contractSignatures fullReport@(FullReport { events, contractReport, chainReport }) =
+mainPane currentView contractSignatures chainState contractReport chainReport events =
   row_
-    [ viewContainer currentView ActiveContracts
-        [ row_
-            [ col12_ [ contractStatusesPane contractSignatures ]
-            , col12_
-                [ installedContractsPane
-                    ( toArrayOf
-                        ( _crAvailableContracts
-                            <<< traversed
-                            <<< _csrDefinition
-                        )
-                        contractReport
+    [ activeContractPane currentView contractSignatures contractReport
+    , blockchainPane currentView chainState chainReport
+    , eventLogPane currentView events chainReport
+    ]
+
+activeContractPane ::
+  forall p t.
+  View ->
+  Map ContractInstanceId
+    ( WebData
+        ( Tuple (ContractInstanceState t)
+            ( Array
+                EndpointForm
+            )
+        )
+    ) ->
+  ContractReport ContractExe -> HTML p HAction
+activeContractPane currentView contractSignatures contractReport =
+  viewContainer currentView ActiveContracts
+    [ row_
+        [ col12_ [ contractStatusesPane contractSignatures ]
+        , col12_
+            [ installedContractsPane
+                ( toArrayOf
+                    ( _crAvailableContracts
+                        <<< traversed
+                        <<< _csrDefinition
                     )
-                ]
+                    contractReport
+                )
             ]
         ]
-    , viewContainer currentView Blockchain
-        [ row_
-            [ col12_ [ ChainAction <$> annotatedBlockchainPane chainState chainReport ]
-            ]
+    ]
+
+blockchainPane ::
+  forall p t.
+  View ->
+  Chain.State ->
+  ChainReport t -> HTML p HAction
+blockchainPane currentView chainState chainReport =
+  viewContainer currentView Blockchain
+    [ row_
+        [ col12_ [ ChainAction <$> annotatedBlockchainPane chainState chainReport ]
         ]
-    , viewContainer currentView EventLog
-        [ row_
-            [ col7_ [ eventsPane events ]
-            , col5_ [ utxoIndexPane (view _utxoIndex chainReport) ]
-            ]
+    ]
+
+eventLogPane :: forall p t. View -> Array (ChainEvent ContractExe) -> ChainReport t -> HTML p HAction
+eventLogPane currentView events chainReport =
+  viewContainer currentView EventLog
+    [ row_
+        [ col7_ [ eventsPane events ]
+        , col5_ [ utxoIndexPane (view _utxoIndex chainReport) ]
         ]
     ]