SCB: Refactoring the websocket-handling.

plutus-scb-client/src/Main.purs

@@ -9,7 +9,6 @@ import Effect.Unsafe (unsafePerformEffect)
 import Halogen.Aff (awaitBody, runHalogenAff)
 import Halogen.VDom.Driver (runUI)
 import MainFrame (initialMainFrame)
-import Plutus.SCB.Types (ContractExe)
 import Plutus.SCB.Webserver.Types (StreamToClient)
 import Types (HAction(..), Output(..), Query(..))
 import WebSocket.Support (mkSocket, Output) as WS
@@ -22,7 +21,7 @@ main = do
     body <- awaitBody
     driver <- runUI initialMainFrame Init body
     let
-      handleWebSocket :: WS.Output (StreamToClient ContractExe) -> Aff Unit
+      handleWebSocket :: WS.Output StreamToClient -> Aff Unit
       handleWebSocket msg = void $ driver.query $ ReceiveWebSocketMessage msg unit
     void $ forkAff
       $ runProcess

plutus-scb-client/src/MainFrame.purs

@@ -14,9 +14,9 @@ import Clipboard (class MonadClipboard)
 import Control.Monad.Reader (runReaderT)
 import Control.Monad.State (class MonadState)
 import Control.Monad.State.Extra (zoomStateT)
-import Data.Array (filter)
+import Data.Array (filter, find)
 import Data.Either (Either(..))
-import Data.Lens (_1, _2, assign, findOf, modifying, to, traversed, use, view)
+import Data.Lens (_1, _2, assign, modifying, to, use, view)
 import Data.Lens.At (at)
 import Data.Lens.Extra (peruse, toSetOf)
 import Data.Lens.Index (ix)
@@ -36,21 +36,21 @@ import Language.Plutus.Contract.Effects.ExposeEndpoint (EndpointDescription)
 import Ledger.Ada (Ada(..))
 import Ledger.Extra (adaToValue)
 import Ledger.Value (Value)
-import MonadApp (class MonadApp, activateContract, getFullReport, invokeEndpoint, log, runHalogenApp, sendWebSocketMessage)
+import MonadApp (class MonadApp, activateContract, getFullReport, invokeEndpoint, log, runHalogenApp)
 import Network.RemoteData (RemoteData(..), _Success)
 import Network.RemoteData as RemoteData
 import Playground.Lenses (_endpointDescription, _schema)
 import Playground.Types (FunctionSchema(..), _FunctionSchema)
 import Plutus.SCB.Events.Contract (ContractInstanceState(..))
 import Plutus.SCB.Types (ContractExe)
 import Plutus.SCB.Webserver (SPParams_(..))
-import Plutus.SCB.Webserver.Types (ContractReport, ContractSignatureResponse(..), StreamToClient(..), StreamToServer(..))
+import Plutus.SCB.Webserver.Types (ContractSignatureResponse(..), StreamToClient(..))
 import Prim.TypeError (class Warn, Text)
 import Schema (FormSchema)
 import Schema.Types (formArgumentToJson, toArgument)
 import Schema.Types as Schema
 import Servant.PureScript.Settings (SPSettings_, defaultSettings)
-import Types (EndpointForm, HAction(..), Output, Query(..), State(..), View(..), WebData, _annotatedBlockchain, _chainReport, _chainState, _contractActiveEndpoints, _contractReport, _contractSignatures, _contractStates, _crAvailableContracts, _csContract, _csCurrentState, _currentView, _events, _webSocketMessage)
+import Types (EndpointForm, HAction(..), Output, Query(..), State(..), View(..), WebData, _annotatedBlockchain, _chainReport, _chainState, _contractActiveEndpoints, _contractReport, _contractSignatures, _contractStates, _crActiveContractStates, _crAvailableContracts, _csContract, _csCurrentState, _currentView, _events, _webSocketMessage)
 import Validation (_argument)
 import View as View
 import WebSocket.Support as WS
@@ -62,11 +62,11 @@ initialState :: State
 initialState =
   State
     { currentView: ActiveContracts
-    , contractReport: NotAsked
+    , contractSignatures: NotAsked
     , chainReport: NotAsked
     , events: NotAsked
     , chainState: Chain.initialState
-    , contractSignatures: Map.empty
+    , contractStates: Map.empty
     , webSocketMessage: NotAsked
     }
 
@@ -105,11 +105,10 @@ handleQuery (ReceiveWebSocketMessage (WS.ReceiveMessage msg) next) = do
   case msg of
     Right (NewChainReport report) -> assign (_chainReport <<< _Success) report
     Right (NewContractReport report) -> do
-      assign (_contractReport <<< _Success) report
+      assign (_contractSignatures <<< _Success) (view _crAvailableContracts report)
       traverse_ updateFormsForContractInstance
-        (view _contractStates report)
+        (view _crActiveContractStates report)
     Right (NewChainEvents events) -> assign (_events <<< _Success) events
-    Right (Echo _) -> pure unit
     Right (ErrorResponse _) -> pure unit
     Left err -> pure unit
   assign _webSocketMessage $ RemoteData.fromEither msg
@@ -128,9 +127,7 @@ handleAction ::
   HAction -> m Unit
 handleAction Init = handleAction LoadFullReport
 
-handleAction (ChangeView view) = do
-  sendWebSocketMessage $ Ping $ show view
-  assign _currentView view
+handleAction (ChangeView view) = assign _currentView view
 
 handleAction (ActivateContract contract) = activateContract contract
 
@@ -141,11 +138,11 @@ handleAction LoadFullReport = do
   for_ fullReportResult
     ( \report ->
         traverse_ updateFormsForContractInstance
-          (view (_contractReport <<< _contractStates) report)
+          (view (_contractReport <<< _crActiveContractStates) report)
     )
   where
   assignFullReportData v = do
-    assign _contractReport (view _contractReport <$> v)
+    assign _contractSignatures (view (_contractReport <<< _crAvailableContracts) <$> v)
     assign _chainReport (view _chainReport <$> v)
     assign _events (view _events <$> v)
 
@@ -165,7 +162,7 @@ handleAction (ChainAction subaction) = do
 
 handleAction (ChangeContractEndpointCall contractInstanceId endpointIndex subaction) = do
   modifying
-    ( _contractSignatures
+    ( _contractStates
         <<< ix contractInstanceId
         <<< _Success
         <<< _2
@@ -183,7 +180,7 @@ handleAction (InvokeContractEndpoint contractInstanceId endpointForm) = do
     encodedForm = RawJson <<< encodeJSON <$> formArgumentToJson (view _argument endpointForm)
   for_ encodedForm
     $ \argument -> do
-        assign (_contractSignatures <<< at contractInstanceId) (Just Loading)
+        assign (_contractStates <<< at contractInstanceId) (Just Loading)
         invokeEndpoint argument contractInstanceId endpointDescription
 
 updateFormsForContractInstance ::
@@ -195,28 +192,28 @@ updateFormsForContractInstance newContractInstance = do
     csContractId = view _csContract newContractInstance
   oldContractInstance :: Maybe (ContractInstanceState ContractExe) <-
     peruse
-      ( _contractSignatures
+      ( _contractStates
           <<< ix csContractId
           <<< _Success
           <<< _1
       )
   when (oldContractInstance /= Just newContractInstance)
     $ do
-        contractReport :: WebData (ContractReport ContractExe) <- use _contractReport
+        contractSignatures <- use _contractSignatures
         let
           newForms :: Maybe (WebData (Array EndpointForm))
-          newForms = sequence $ createNewEndpointForms <$> contractReport <*> pure newContractInstance
-        assign (_contractSignatures <<< at csContractId)
+          newForms = sequence $ createNewEndpointForms <$> contractSignatures <*> pure newContractInstance
+        assign (_contractStates <<< at csContractId)
           (map (Tuple newContractInstance) <$> newForms)
 
 createNewEndpointForms ::
-  ContractReport ContractExe ->
+  Array (ContractSignatureResponse ContractExe) ->
   ContractInstanceState ContractExe ->
   Maybe (Array EndpointForm)
-createNewEndpointForms contractReport instanceState =
+createNewEndpointForms contractSignatures instanceState =
   let
     matchingSignature :: Maybe (ContractSignatureResponse ContractExe)
-    matchingSignature = getMatchingSignature instanceState contractReport
+    matchingSignature = getMatchingSignature instanceState contractSignatures
   in
     createEndpointForms instanceState <$> matchingSignature
 
@@ -251,13 +248,8 @@ getMatchingSignature ::
   forall t.
   Eq t =>
   ContractInstanceState t ->
-  ContractReport t ->
+  Array (ContractSignatureResponse t) ->
   Maybe (ContractSignatureResponse t)
-getMatchingSignature (ContractInstanceState { csContractDefinition }) =
-  findOf
-    ( _crAvailableContracts
-        <<< traversed
-    )
-    isMatch
+getMatchingSignature (ContractInstanceState { csContractDefinition }) = find isMatch
   where
   isMatch (ContractSignatureResponse { csrDefinition }) = csrDefinition == csContractDefinition

plutus-scb-client/src/MonadApp.purs

@@ -31,7 +31,7 @@ class
   getFullReport :: m (WebData (FullReport ContractExe))
   invokeEndpoint :: RawJson -> ContractInstanceId -> EndpointDescription -> m (WebData (ContractInstanceState ContractExe))
   activateContract :: ContractExe -> m Unit
-  sendWebSocketMessage :: StreamToServer ContractExe -> m Unit
+  sendWebSocketMessage :: StreamToServer -> m Unit
   log :: String -> m Unit
 
 newtype HalogenApp m a

plutus-scb-client/src/Types.purs

@@ -36,10 +36,10 @@ import Wallet.Rollup.Types (AnnotatedTx)
 import WebSocket.Support as WS
 
 data Query a
-  = ReceiveWebSocketMessage (WS.Output (StreamToClient ContractExe)) a
+  = ReceiveWebSocketMessage (WS.Output StreamToClient) a
 
 data Output
-  = SendWebSocketMessage (WS.Input (StreamToServer ContractExe))
+  = SendWebSocketMessage (WS.Input StreamToServer)
 
 type WebData
   = RemoteData AjaxError
@@ -56,12 +56,12 @@ data HAction
 newtype State
   = State
   { currentView :: View
-  , contractReport :: WebData (ContractReport ContractExe)
+  , contractSignatures :: WebData (Array (ContractSignatureResponse 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)
+  , contractStates :: Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm))
+  , webSocketMessage :: RemoteData MultipleErrors StreamToClient
   }
 
 type EndpointForm
@@ -76,8 +76,8 @@ derive instance genericState :: Generic State _
 _currentView :: Lens' State View
 _currentView = _Newtype <<< prop (SProxy :: SProxy "currentView")
 
-_contractReport :: forall s r a. Newtype s { contractReport :: a | r } => Lens' s a
-_contractReport = _Newtype <<< prop (SProxy :: SProxy "contractReport")
+_contractSignatures :: forall s r a. Newtype s { contractSignatures :: a | r } => Lens' s a
+_contractSignatures = _Newtype <<< prop (SProxy :: SProxy "contractSignatures")
 
 _chainReport :: forall s r a. Newtype s { chainReport :: a | r } => Lens' s a
 _chainReport = _Newtype <<< prop (SProxy :: SProxy "chainReport")
@@ -88,8 +88,8 @@ _events = _Newtype <<< prop (SProxy :: SProxy "events")
 _chainState :: Lens' State Chain.State
 _chainState = _Newtype <<< prop (SProxy :: SProxy "chainState")
 
-_contractSignatures :: Lens' State (Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm)))
-_contractSignatures = _Newtype <<< prop (SProxy :: SProxy "contractSignatures")
+_contractStates :: Lens' State (Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm)))
+_contractStates = _Newtype <<< prop (SProxy :: SProxy "contractStates")
 
 _annotatedBlockchain :: forall t. Lens' (ChainReport t) (Array (Array AnnotatedTx))
 _annotatedBlockchain = _ChainReport <<< prop (SProxy :: SProxy "annotatedBlockchain")
@@ -100,6 +100,9 @@ _transactionMap = _ChainReport <<< prop (SProxy :: SProxy "transactionMap")
 _webSocketMessage :: forall s a r. Newtype s { webSocketMessage :: a | r } => Lens' s a
 _webSocketMessage = _Newtype <<< prop (SProxy :: SProxy "webSocketMessage")
 
+_contractReport :: forall s a r. Newtype s { contractReport :: a | r } => Lens' s a
+_contractReport = _Newtype <<< prop (SProxy :: SProxy "contractReport")
+
 _utxoIndex :: forall t. Lens' (ChainReport t) UtxoIndex
 _utxoIndex = _ChainReport <<< prop (SProxy :: SProxy "utxoIndex")
 
@@ -112,9 +115,6 @@ _crActiveContractStates = _ContractReport <<< prop (SProxy :: SProxy "crActiveCo
 _csrDefinition :: forall t. Lens' (ContractSignatureResponse t) t
 _csrDefinition = _ContractSignatureResponse <<< prop (SProxy :: SProxy "csrDefinition")
 
-_contractStates :: forall t. Lens' (ContractReport t) (Array (ContractInstanceState t))
-_contractStates = _ContractReport <<< prop (SProxy :: SProxy "crActiveContractStates")
-
 _csContract :: forall t. Lens' (ContractInstanceState t) ContractInstanceId
 _csContract = _Newtype <<< prop (SProxy :: SProxy "csContract")
 

plutus-scb-client/src/View.purs

@@ -14,7 +14,7 @@ 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 (ChainReport, ContractReport)
+import Plutus.SCB.Webserver.Types (ChainReport, ContractReport, ContractSignatureResponse(..))
 import Prelude (($), (<$>), (<*>), (<<<))
 import Types (EndpointForm, HAction(..), State(..), View(..), WebData, _crAvailableContracts, _csrDefinition, _utxoIndex)
 import View.Blockchain (annotatedBlockchainPane)
@@ -26,7 +26,7 @@ render ::
   forall m slots.
   MonadAff m =>
   State -> ComponentHTML HAction slots m
-render (State { currentView, chainState, contractReport, chainReport, events, contractSignatures, webSocketMessage }) =
+render (State { currentView, chainState, contractSignatures, chainReport, events, contractStates, webSocketMessage }) =
   div
     [ class_ $ ClassName "main-frame" ]
     [ container_
@@ -35,9 +35,9 @@ render (State { currentView, chainState, contractReport, chainReport, events, co
         , div_
             $ webDataPane
                 ( uncurry3
-                    (mainPane currentView contractSignatures chainState)
+                    (mainPane currentView contractStates chainState)
                 )
-                (tuple3 <$> contractReport <*> chainReport <*> events)
+                (tuple3 <$> contractSignatures <*> chainReport <*> events)
         ]
     ]
 
@@ -70,13 +70,13 @@ mainPane ::
   View ->
   Map ContractInstanceId (WebData (ContractInstanceState t /\ Array EndpointForm)) ->
   Chain.State ->
-  ContractReport ContractExe ->
+  Array (ContractSignatureResponse ContractExe) ->
   ChainReport t ->
   Array (ChainEvent ContractExe) ->
   HTML p HAction
-mainPane currentView contractSignatures chainState contractReport chainReport events =
+mainPane currentView contractStates chainState contractSignatures chainReport events =
   row_
-    [ activeContractPane currentView contractSignatures contractReport
+    [ activeContractPane currentView contractStates contractSignatures
     , blockchainPane currentView chainState chainReport
     , eventLogPane currentView events chainReport
     ]
@@ -92,19 +92,18 @@ activeContractPane ::
             )
         )
     ) ->
-  ContractReport ContractExe -> HTML p HAction
-activeContractPane currentView contractSignatures contractReport =
+  Array (ContractSignatureResponse ContractExe) -> HTML p HAction
+activeContractPane currentView contractStates contractSignatures =
   viewContainer currentView ActiveContracts
     [ row_
-        [ col12_ [ contractStatusesPane contractSignatures ]
+        [ col12_ [ contractStatusesPane contractStates ]
         , col12_
             [ installedContractsPane
                 ( toArrayOf
-                    ( _crAvailableContracts
-                        <<< traversed
+                    ( traversed
                         <<< _csrDefinition
                     )
-                    contractReport
+                    contractSignatures
                 )
             ]
         ]

plutus-scb/app/PSGenerator.hs

@@ -94,8 +94,8 @@ myTypes =
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @(ContractReport A))
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @(ChainEvent A))
     , (order <*> (genericShow <*> mkSumType)) (Proxy @ContractInstanceId)
-    , (equal <*> (genericShow <*> mkSumType)) (Proxy @(StreamToServer A))
-    , (equal <*> (genericShow <*> mkSumType)) (Proxy @(StreamToClient A))
+    , (equal <*> (genericShow <*> mkSumType)) (Proxy @StreamToServer)
+    , (equal <*> (genericShow <*> mkSumType)) (Proxy @StreamToClient)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @(ContractInstanceState A))
     , (equal <*> (genericShow <*> mkSumType))
           (Proxy @(ContractSignatureResponse A))

plutus-scb/src/Plutus/SCB/Webserver/Types.hs

@@ -16,6 +16,7 @@ import           Ledger                    (PubKeyHash, Tx, TxId)
 import           Ledger.Index              (UtxoIndex)
 import           Playground.Types          (FunctionSchema)
 import           Plutus.SCB.Events         (ChainEvent, ContractInstanceState)
+import           Plutus.SCB.Types          (ContractExe)
 import           Schema                    (FormSchema)
 import           Wallet.Emulator.Wallet    (Wallet)
 import           Wallet.Rollup.Types       (AnnotatedTx)
@@ -55,16 +56,15 @@ data ContractSignatureResponse t =
     deriving (Show, Eq, Generic)
     deriving anyclass (FromJSON, ToJSON)
 
-newtype StreamToServer t =
-    Ping Text
+data StreamToServer =
+    Ping
     deriving (Show, Eq, Generic)
-    deriving newtype (FromJSON, ToJSON)
+    deriving anyclass (FromJSON, ToJSON)
 
-data StreamToClient t
-    = NewChainReport (ChainReport t)
-    | NewContractReport (ContractReport t)
-    | NewChainEvents [ChainEvent t]
-    | Echo Text
+data StreamToClient
+    = NewChainReport (ChainReport ContractExe)
+    | NewContractReport (ContractReport ContractExe)
+    | NewChainEvents [ChainEvent ContractExe]
     | ErrorResponse Text
     deriving (Show, Eq, Generic)
     deriving anyclass (FromJSON, ToJSON)