From fd2c297e9916981042e370359ebf0370e363372f Mon Sep 17 00:00:00 2001
From: Kris Jenkins <kris.jenkins@tweag.io>
Date: Mon, 15 Jun 2020 16:49:12 +0100
Subject: [PATCH] SCB: Streaming JSON data via websockets.

...for improved UX, and to ensure we see updates from other systems
(roughly) as they happen.
---
 marlowe-playground-client/package.json        |   2 +-
 marlowe-playground-client/src/Main.purs       |  32 +--
 marlowe-playground-client/src/MainFrame.purs  |  23 +-
 .../src/Reachability.purs                     |   9 +-
 marlowe-playground-client/src/Simulation.purs |   6 +-
 .../src/Simulation/Types.purs                 |   5 +-
 marlowe-playground-client/src/Types.purs      |   8 +-
 marlowe-playground-client/src/Websockets.purs |  52 ----
 marlowe-playground-server/app/PSGenerator.hs  |  14 +-
 nix/stack.materialized/plutus-scb.nix         |   8 +-
 plutus-playground-client/spago-packages.nix   |  26 +-
 plutus-playground-client/spago.dhall          |   3 +
 plutus-scb-client/spago-packages.nix          |  24 ++
 plutus-scb-client/spago.dhall                 |   3 +
 plutus-scb-client/src/Main.purs               |  22 +-
 plutus-scb-client/src/MainFrame.purs          | 142 +++++++----
 plutus-scb-client/src/Types.purs              |  21 +-
 plutus-scb-client/src/View.purs               |  11 +-
 plutus-scb-client/src/View/Contracts.purs     |  24 +-
 plutus-scb-client/src/View/Events.purs        |   7 +-
 plutus-scb-client/webpack.config.js           |   4 +
 plutus-scb/app/PSGenerator.hs                 |   7 +-
 plutus-scb/plutus-scb.cabal                   |   8 +-
 plutus-scb/src/Control/Monad/Freer/Delay.hs   |  27 ++
 .../src/Control/Monad/Freer/WebSocket.hs      |  41 +++
 plutus-scb/src/Plutus/SCB/App.hs              | 148 ++++++-----
 plutus-scb/src/Plutus/SCB/Core.hs             |  36 +--
 plutus-scb/src/Plutus/SCB/Effects/EventLog.hs | 137 +++++-----
 plutus-scb/src/Plutus/SCB/Webserver/API.hs    |   4 +
 .../src/Plutus/SCB/Webserver/Handler.hs       | 206 +++++++++++++++
 plutus-scb/src/Plutus/SCB/Webserver/Server.hs | 234 +++---------------
 plutus-scb/src/Plutus/SCB/Webserver/Types.hs  |  48 +++-
 .../src/Plutus/SCB/Webserver/WebSocket.hs     | 144 +++++++++++
 web-common/src/Control/Coroutine/Extra.purs   |  10 +
 web-common/src/WebSocket/Support.purs         | 103 ++++++++
 35 files changed, 1042 insertions(+), 557 deletions(-)
 delete mode 100644 marlowe-playground-client/src/Websockets.purs
 create mode 100644 plutus-scb/src/Control/Monad/Freer/Delay.hs
 create mode 100644 plutus-scb/src/Control/Monad/Freer/WebSocket.hs
 create mode 100644 plutus-scb/src/Plutus/SCB/Webserver/Handler.hs
 create mode 100644 plutus-scb/src/Plutus/SCB/Webserver/WebSocket.hs
 create mode 100644 web-common/src/Control/Coroutine/Extra.purs
 create mode 100644 web-common/src/WebSocket/Support.purs

diff --git a/marlowe-playground-client/package.json b/marlowe-playground-client/package.json
index e6299042313..fc396d575ec 100644
--- a/marlowe-playground-client/package.json
+++ b/marlowe-playground-client/package.json
@@ -7,7 +7,7 @@
     "webpack:server": "webpack-dev-server --progress --inline --hot --mode=development --display verbose",
     "webpack:server:debug": "DEBUG=purs-loader* DEBUG_DEPTH=100 webpack-dev-server --progress --inline --hot",
     "purs:compile": "spago build",
-    "purs:ide": "purs ide server --log-level=debug 'src/**/*.purs' 'generated/**/*.purs' 'test/**/*.purs' '../web-common/**/*.purs'",
+    "purs:ide": "purs ide server --port 4243 --log-level=debug 'src/**/*.purs' 'generated/**/*.purs' 'test/**/*.purs' '../web-common/**/*.purs'",
     "test": "NODE_OPTIONS=\"--max-old-space-size=8192\" webpack --config webpack.test.config.js --mode=development && node --max-old-space-size=8192 dist/test.js",
     "docs": "spago docs",
     "repl": "spago repl"
diff --git a/marlowe-playground-client/src/Main.purs b/marlowe-playground-client/src/Main.purs
index 6db4421698b..7089a5d935a 100644
--- a/marlowe-playground-client/src/Main.purs
+++ b/marlowe-playground-client/src/Main.purs
@@ -5,6 +5,7 @@ import Control.Coroutine (Consumer, Process, connect, consumer, runProcess, ($$)
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Aff (forkAff, Aff)
+import Control.Coroutine.Extra (mapConsumer)
 import Effect.Class (liftEffect)
 import Effect.Console (log)
 import Effect.Unsafe (unsafePerformEffect)
@@ -16,11 +17,10 @@ import LocalStorage as LocalStorage
 import MainFrame (mkMainFrame)
 import Marlowe (SPParams_(SPParams_))
 import Servant.PureScript.Settings (SPSettingsDecodeJson_(..), SPSettingsEncodeJson_(..), SPSettings_(..), defaultSettings)
-import Web.HTML as W
-import Web.HTML.Location as WL
-import Web.HTML.Window as WW
-import Web.Socket.WebSocket as WS
-import Websockets (wsConsumer, wsProducer, wsSender)
+import WebSocket (WebSocketResponseMessage)
+import Types (HQuery(..), Message(..))
+import WebSocket.Support (wsConsumer, wsProducer, wsSender, mkSocket)
+import WebSocket.Support as WS
 
 ajaxSettings :: SPSettings_ SPParams_
 ajaxSettings = SPSettings_ $ (settings { decodeJson = decodeJson, encodeJson = encodeJson })
@@ -36,25 +36,19 @@ ajaxSettings = SPSettings_ $ (settings { decodeJson = decodeJson, encodeJson = e
 main ::
   Effect Unit
 main = do
-  window <- W.window
-  location <- WW.location window
-  protocol <- WL.protocol location
-  hostname <- WL.hostname location
-  port <- WL.port location
-  let
-    wsProtocol = case protocol of
-      "https:" -> "wss"
-      _ -> "ws"
-
-    wsPath = wsProtocol <> "://" <> hostname <> ":" <> port <> "/api/ws"
-  socket <- WS.create wsPath []
+  socket <- mkSocket "/api/ws"
   let
     mainFrame = mkMainFrame ajaxSettings
   runHalogenAff do
     body <- awaitBody
     driver <- runUI mainFrame unit body
-    driver.subscribe $ wsSender socket driver.query
-    void $ forkAff $ runProcess (wsProducer socket $$ wsConsumer driver.query)
+    let
+      handleWebSocket :: WS.Output WebSocketResponseMessage -> Aff Unit
+      handleWebSocket msg = void $ driver.query $ ReceiveWebSocketMessage msg unit
+    driver.subscribe
+      $ mapConsumer (case _ of (WebSocketMessage msg) -> WS.SendMessage msg)
+      $ wsSender handleWebSocket socket
+    void $ forkAff $ runProcess (wsProducer socket $$ wsConsumer handleWebSocket)
     forkAff $ runProcess watchLocalStorageProcess
 
 watchLocalStorageProcess :: Process Aff Unit
diff --git a/marlowe-playground-client/src/MainFrame.purs b/marlowe-playground-client/src/MainFrame.purs
index baedfda228f..f25ed279e25 100644
--- a/marlowe-playground-client/src/MainFrame.purs
+++ b/marlowe-playground-client/src/MainFrame.purs
@@ -8,6 +8,7 @@ import Data.Either (Either(..))
 import Data.Json.JsonEither (JsonEither(..))
 import Data.Lens (assign, to, use, view, (^.))
 import Data.Map as Map
+import WebSocket.Support as WS
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (unwrap)
 import Data.String as String
@@ -86,18 +87,14 @@ handleQuery ::
   forall m a.
   HQuery a ->
   HalogenM FrontendState HAction ChildSlots Message m (Maybe a)
-handleQuery (ReceiveWebsocketMessage msg next) = do
-  let
-    msgDecoded =
-      unwrap <<< runExceptT
-        $ do
-            f <- parseJSON msg
-            decode f
-  void
-    $ case msgDecoded of
-        Left err -> query _simulationSlot unit (ST.WebsocketResponse (Failure (show msg)) unit)
-        Right (OtherError err) -> query _simulationSlot unit ((ST.WebsocketResponse $ Failure err) unit)
-        Right (CheckForWarningsResult result) -> query _simulationSlot unit ((ST.WebsocketResponse $ Success result) unit)
+handleQuery (ReceiveWebSocketMessage msg next) = do
+  void $ query _simulationSlot unit
+    $ flip ST.WebSocketResponse unit
+    $ case msg of
+        WS.WebSocketClosed -> Failure "Connection lost."
+        WS.ReceiveMessage (Left err) -> Failure (show msg)
+        WS.ReceiveMessage (Right (OtherError err)) -> Failure err
+        WS.ReceiveMessage (Right (CheckForWarningsResult result)) -> Success result
   pure $ Just next
 
 handleAction ::
@@ -111,7 +108,7 @@ handleAction _ (HandleSimulationMessage (ST.BlocklyCodeSet source)) = do
   assign _view BlocklyEditor
   void $ query _blocklySlot unit (Blockly.Resize unit)
 
-handleAction _ (HandleSimulationMessage (ST.WebsocketMessage msg)) = H.raise (WebsocketMessage msg)
+handleAction _ (HandleSimulationMessage (ST.WebSocketMessage msg)) = H.raise (WebSocketMessage msg)
 
 handleAction _ (HandleWalletMessage Wallet.SendContractToWallet) = do
   mContract <- query _simulationSlot unit (request ST.GetCurrentContract)
diff --git a/marlowe-playground-client/src/Reachability.purs b/marlowe-playground-client/src/Reachability.purs
index bc9c31215cb..13f23f3a7f4 100644
--- a/marlowe-playground-client/src/Reachability.purs
+++ b/marlowe-playground-client/src/Reachability.purs
@@ -3,15 +3,14 @@ module Reachability (startReachabilityAnalysis, updateWithResponse) where
 import Data.Function (flip)
 import Data.List (List(..), concatMap, foldl, fromFoldable, length, reverse, snoc, toUnfoldable)
 import Data.Tuple.Nested (type (/\), (/\))
-import Foreign.Generic (encode, encodeJSON)
-import Global.Unsafe (unsafeStringify)
+import Foreign.Generic (encodeJSON)
 import Halogen (HalogenM)
 import Halogen as H
 import Marlowe.Semantics (AccountId, Case(..), Contract(..), Observation(..), Payee, Timeout, Token, Value, ValueId)
 import Marlowe.Semantics as S
 import Marlowe.Symbolic.Types.Response (Result(..))
 import Network.RemoteData (RemoteData(..))
-import Prelude (Unit, bind, discard, map, pure, unit, ($), (<<<), (+), (/=))
+import Prelude (Unit, bind, discard, map, pure, unit, ($), (+), (/=))
 import Simulation.Types (Action, ChildSlots, ContractPathStep(..), ContractPath, Message(..), ReachabilityAnalysisData(..), State)
 import WebSocket (WebSocketRequestMessage(..))
 
@@ -110,9 +109,7 @@ zipperToContractPath :: ContractZipper -> ContractPath
 zipperToContractPath zipper = zipperToContractPathAux zipper Nil
 
 checkContractForReachability :: forall m. String -> String -> HalogenM State Action ChildSlots Message m Unit
-checkContractForReachability contract state = H.raise (WebsocketMessage msgString)
-  where
-  msgString = unsafeStringify <<< encode $ CheckForWarnings (encodeJSON true) contract state
+checkContractForReachability contract state = H.raise $ WebSocketMessage $ CheckForWarnings (encodeJSON true) contract state
 
 expandSubproblem :: ContractZipper -> (ContractPath /\ Contract)
 expandSubproblem z = zipperToContractPath z /\ closeZipperContract z (Assert FalseObs Close)
diff --git a/marlowe-playground-client/src/Simulation.purs b/marlowe-playground-client/src/Simulation.purs
index baca7d36343..8ee3478c85b 100644
--- a/marlowe-playground-client/src/Simulation.purs
+++ b/marlowe-playground-client/src/Simulation.purs
@@ -113,7 +113,7 @@ handleQuery (ResetContract next) = do
   resetContract
   pure (Just next)
 
-handleQuery (WebsocketResponse response next) = do
+handleQuery (WebSocketResponse response next) = do
   analysisState <- use _analysisState
   case analysisState of
     NoneAsked -> pure (Just next) -- Unrequested response
@@ -283,9 +283,7 @@ handleAction _ AnalyseContract = do
       assign _analysisState (WarningAnalysis Loading)
   where
   checkContractForWarnings contract state = do
-    let
-      msgString = unsafeStringify <<< encode $ CheckForWarnings (encodeJSON false) contract state
-    H.raise (WebsocketMessage msgString)
+    H.raise $ WebSocketMessage $ CheckForWarnings (encodeJSON false) contract state
 
 handleAction _ AnalyseReachabilityContract = do
   currContract <- use _currentContract
diff --git a/marlowe-playground-client/src/Simulation/Types.purs b/marlowe-playground-client/src/Simulation/Types.purs
index bd2440b6311..c67733621d5 100644
--- a/marlowe-playground-client/src/Simulation/Types.purs
+++ b/marlowe-playground-client/src/Simulation/Types.purs
@@ -10,6 +10,7 @@ import Data.Either (Either(..))
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Lens (Lens', to, view)
+import WebSocket (WebSocketRequestMessage)
 import Data.Lens.NonEmptyList (_Head)
 import Data.Lens.Record (prop)
 import Data.List.NonEmpty as NEL
@@ -234,13 +235,13 @@ data Query a
   = SetEditorText String a
   | ResizeEditor a
   | ResetContract a
-  | WebsocketResponse (RemoteData String Result) a
+  | WebSocketResponse (RemoteData String Result) a
   | HasStarted (Boolean -> a)
   | GetCurrentContract (String -> a)
 
 data Message
   = BlocklyCodeSet String
-  | WebsocketMessage String
+  | WebSocketMessage WebSocketRequestMessage
 
 type ChildSlots
   = ( editorSlot :: H.Slot Monaco.Query Monaco.Message Unit
diff --git a/marlowe-playground-client/src/Types.purs b/marlowe-playground-client/src/Types.purs
index b845440caee..37df175d76c 100644
--- a/marlowe-playground-client/src/Types.purs
+++ b/marlowe-playground-client/src/Types.purs
@@ -3,7 +3,9 @@ module Types where
 import API (RunResult)
 import Analytics (class IsEvent, defaultEvent)
 import Blockly.Types (BlocklyState)
+import Data.Either (Either)
 import Data.Generic.Rep (class Generic)
+import Foreign (MultipleErrors)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Json.JsonEither (JsonEither)
 import Data.Lens (Lens', (^.))
@@ -25,13 +27,15 @@ import Prelude (class Eq, class Show, Unit, eq, show, (<<<), ($))
 import Servant.PureScript.Ajax (AjaxError)
 import Simulation.Types as Simulation
 import Wallet as Wallet
+import WebSocket.Support as WS
+import WebSocket (WebSocketResponseMessage, WebSocketRequestMessage)
 
 ------------------------------------------------------------
 data HQuery a
-  = ReceiveWebsocketMessage String a
+  = ReceiveWebSocketMessage (WS.Output WebSocketResponseMessage) a
 
 data Message
-  = WebsocketMessage String
+  = WebSocketMessage WebSocketRequestMessage
 
 data HAction
   -- Haskell Editor
diff --git a/marlowe-playground-client/src/Websockets.purs b/marlowe-playground-client/src/Websockets.purs
deleted file mode 100644
index d4d1461ddcf..00000000000
--- a/marlowe-playground-client/src/Websockets.purs
+++ /dev/null
@@ -1,52 +0,0 @@
-module Websockets where
-
-import Prelude
-import Control.Coroutine (Producer, Consumer)
-import Control.Coroutine as CR
-import Control.Coroutine.Aff (emit, produce)
-import Control.Monad.Except (runExcept)
-import Data.Either (hush)
-import Data.Foldable (for_)
-import Data.Maybe (Maybe(..))
-import Effect.Aff (Aff)
-import Effect.Class (liftEffect)
-import Foreign (Foreign, F, readString)
-import Types (HQuery(..), Message(..))
-import Web.Event.EventTarget (addEventListener, eventListener)
-import Web.Socket.Event.EventTypes (onMessage)
-import Web.Socket.Event.MessageEvent as MessageEvent
-import Web.Socket.ReadyState as WSRS
-import Web.Socket.WebSocket (WebSocket)
-import Web.Socket.WebSocket as WS
-
-wsProducer :: WebSocket -> Producer String Aff Unit
-wsProducer socket =
-  produce \emitter -> do
-    listener <-
-      eventListener \ev -> do
-        for_ (MessageEvent.fromEvent ev) \msgEvent ->
-          for_ (readHelper readString (MessageEvent.data_ msgEvent)) \msg ->
-            emit emitter msg
-    addEventListener onMessage listener false (WS.toEventTarget socket)
-  where
-  readHelper :: forall a. (Foreign -> F a) -> Foreign -> Maybe a
-  readHelper reader = hush <<< runExcept <<< reader
-
-wsConsumer :: (forall a. HQuery a -> Aff (Maybe a)) -> Consumer String Aff Unit
-wsConsumer query =
-  CR.consumer \msg -> do
-    void $ query $ ReceiveWebsocketMessage msg unit
-    pure Nothing
-
-wsSender :: WebSocket -> (forall a. HQuery a -> Aff (Maybe a)) -> Consumer Message Aff Unit
-wsSender socket query =
-  CR.consumer
-    $ \msg -> do
-        case msg of
-          WebsocketMessage contents -> do
-            state <- liftEffect $ WS.readyState socket
-            if state == WSRS.Open then
-              void $ liftEffect $ WS.sendString socket contents
-            else
-              void $ query $ ReceiveWebsocketMessage "websocket not open" unit
-        pure Nothing
diff --git a/marlowe-playground-server/app/PSGenerator.hs b/marlowe-playground-server/app/PSGenerator.hs
index 8bfe657b65e..9394ff57d10 100644
--- a/marlowe-playground-server/app/PSGenerator.hs
+++ b/marlowe-playground-server/app/PSGenerator.hs
@@ -37,10 +37,10 @@ import           Language.Haskell.Interpreter                     (CompilationEr
                                                                    InterpreterResult, SourceCode, Warning)
 import qualified Language.Marlowe.ACTUS.Definitions.ContractTerms as CT
 import           Language.Marlowe.Pretty                          (pretty)
-import           Language.PureScript.Bridge                       (BridgePart, Language (Haskell), PSType, SumType,
-                                                                   TypeInfo (TypeInfo), buildBridge, mkSumType,
-                                                                   psTypeParameters, typeModule, typeName,
-                                                                   writePSTypesWith, (^==))
+import           Language.PureScript.Bridge                       (BridgePart, Language (Haskell), Language (Haskell),
+                                                                   PSType, SumType, TypeInfo (TypeInfo), buildBridge,
+                                                                   genericShow, mkSumType, psTypeParameters, typeModule,
+                                                                   typeName, writePSTypesWith, writePSTypesWith, (^==))
 import           Language.PureScript.Bridge.Builder               (BridgeData)
 import           Language.PureScript.Bridge.CodeGenSwitches       (ForeignOptions (ForeignOptions), defaultSwitch,
                                                                    genForeign)
@@ -109,7 +109,7 @@ myTypes =
     , mkSumType (Proxy @Warning)
     , mkSumType (Proxy @(InterpreterResult A))
     , mkSumType (Proxy @MSRes.Response)
-    , mkSumType (Proxy @MSRes.Result)
+    , (genericShow <*> mkSumType) (Proxy @MSRes.Result)
     , mkSumType (Proxy @MSReq.Request)
     , mkSumType (Proxy @DT.Day)
     , mkSumType (Proxy @CT.ContractTerms)
@@ -127,8 +127,8 @@ myTypes =
     , mkSumType (Proxy @CT.FEB)
     , mkSumType (Proxy @CT.ContractRole)
     , mkSumType (Proxy @CT.ContractType)
-    , mkSumType (Proxy @WebSocketRequestMessage)
-    , mkSumType (Proxy @WebSocketResponseMessage)
+    , (genericShow <*> mkSumType) (Proxy @WebSocketRequestMessage)
+    , (genericShow <*> mkSumType) (Proxy @WebSocketResponseMessage)
     ]
 
 mySettings :: Settings
diff --git a/nix/stack.materialized/plutus-scb.nix b/nix/stack.materialized/plutus-scb.nix
index 200066655e4..7c857ba054e 100644
--- a/nix/stack.materialized/plutus-scb.nix
+++ b/nix/stack.materialized/plutus-scb.nix
@@ -85,6 +85,7 @@
           (hsPkgs."servant-server" or (errorHandler.buildDepError "servant-server"))
           (hsPkgs."typed-protocols" or (errorHandler.buildDepError "typed-protocols"))
           (hsPkgs."typed-protocols-examples" or (errorHandler.buildDepError "typed-protocols-examples"))
+          (hsPkgs."servant-websockets" or (errorHandler.buildDepError "servant-websockets"))
           (hsPkgs."stm" or (errorHandler.buildDepError "stm"))
           (hsPkgs."text" or (errorHandler.buildDepError "text"))
           (hsPkgs."time-units" or (errorHandler.buildDepError "time-units"))
@@ -95,6 +96,7 @@
           (hsPkgs."vector" or (errorHandler.buildDepError "vector"))
           (hsPkgs."warp" or (errorHandler.buildDepError "warp"))
           (hsPkgs."Win32-network" or (errorHandler.buildDepError "Win32-network"))
+          (hsPkgs."websockets" or (errorHandler.buildDepError "websockets"))
           (hsPkgs."yaml" or (errorHandler.buildDepError "yaml"))
           (hsPkgs."mwc-random" or (errorHandler.buildDepError "mwc-random"))
           (hsPkgs."primitive" or (errorHandler.buildDepError "primitive"))
@@ -127,8 +129,10 @@
           "Cardano/Wallet/Mock"
           "Cardano/Wallet/Server"
           "Cardano/Wallet/Types"
+          "Control/Monad/Freer/Delay"
           "Control/Monad/Freer/Extra/Log"
           "Control/Monad/Freer/Extra/State"
+          "Control/Monad/Freer/WebSocket"
           "Control/Concurrent/Availability"
           "Data/Time/Units/Extra"
           "Plutus/SCB/App"
@@ -146,9 +150,11 @@
           "Plutus/SCB/Effects/EventLog"
           "Plutus/SCB/Effects/MultiAgent"
           "Plutus/SCB/Effects/UUID"
-          "Plutus/SCB/Webserver/Types"
           "Plutus/SCB/Webserver/API"
+          "Plutus/SCB/Webserver/Handler"
           "Plutus/SCB/Webserver/Server"
+          "Plutus/SCB/Webserver/Types"
+          "Plutus/SCB/Webserver/WebSocket"
           "Plutus/SCB/Events"
           "Plutus/SCB/Events/Contract"
           "Plutus/SCB/Events/Node"
diff --git a/plutus-playground-client/spago-packages.nix b/plutus-playground-client/spago-packages.nix
index 4c4f959fbb1..8632186d237 100644
--- a/plutus-playground-client/spago-packages.nix
+++ b/plutus-playground-client/spago-packages.nix
@@ -41,6 +41,18 @@ let
         installPhase = "ln -s $src $out";
       };
 
+    "aff-coroutines" = pkgs.stdenv.mkDerivation {
+        name = "aff-coroutines";
+        version = "v7.0.0";
+        src = pkgs.fetchgit {
+          url = "https://github.com/purescript-contrib/purescript-aff-coroutines.git";
+          rev = "f2f410f3cc9030487ddadf9ffdaab75ba508bde9";
+          sha256 = "1cbly4m2na5kf3halj68rjy5khydb71gzz0ry323z5h1i0fna2g9";
+        };
+        phases = "installPhase";
+        installPhase = "ln -s $src $out";
+      };
+
     "affjax" = pkgs.stdenv.mkDerivation {
         name = "affjax";
         version = "v10.0.0";
@@ -1197,7 +1209,7 @@ let
         name = "unsafe-reference";
         version = "v3.0.1";
         src = pkgs.fetchgit {
-          url = "https://github.com/purescript-contrib/purescript-unsafe-reference";
+          url = "https://github.com/purescript-contrib/purescript-unsafe-reference.git";
           rev = "79d7de7b9351346a73e6c060d80532c95ba1c7c1";
           sha256 = "0q758dz59qz0li4s3w1qcg921xp5i5rh6i1l611iv7rr8cbj11al";
         };
@@ -1277,6 +1289,18 @@ let
         installPhase = "ln -s $src $out";
       };
 
+    "web-socket" = pkgs.stdenv.mkDerivation {
+        name = "web-socket";
+        version = "v2.0.0";
+        src = pkgs.fetchgit {
+          url = "https://github.com/purescript-web/purescript-web-socket.git";
+          rev = "00f4ab583efb6fc60e0517d782d2ba2a89d8ec66";
+          sha256 = "0kp4rmrqmsjmih7nw7dl75d36pny3ikafnhnfchpc834ap9451zh";
+        };
+        phases = "installPhase";
+        installPhase = "ln -s $src $out";
+      };
+
     "web-storage" = pkgs.stdenv.mkDerivation {
         name = "web-storage";
         version = "v3.0.0";
diff --git a/plutus-playground-client/spago.dhall b/plutus-playground-client/spago.dhall
index 91090c69c54..9709151513f 100644
--- a/plutus-playground-client/spago.dhall
+++ b/plutus-playground-client/spago.dhall
@@ -10,6 +10,8 @@ You can edit this file as you like.
   , "aff"
   , "bigints"
   , "console"
+  , "coroutines"
+  , "aff-coroutines"
   , "debug"
   , "effect"
   , "halogen"
@@ -25,6 +27,7 @@ You can edit this file as you like.
   , "test-unit"
   , "undefinable"
   , "uuid"
+  , "web-socket"
   ]
 , packages = ./packages.dhall
 , sources =
diff --git a/plutus-scb-client/spago-packages.nix b/plutus-scb-client/spago-packages.nix
index ace2141d989..ddd1894ec5e 100644
--- a/plutus-scb-client/spago-packages.nix
+++ b/plutus-scb-client/spago-packages.nix
@@ -17,6 +17,18 @@ let
         installPhase = "ln -s $src $out";
       };
 
+    "aff-coroutines" = pkgs.stdenv.mkDerivation {
+        name = "aff-coroutines";
+        version = "v7.0.0";
+        src = pkgs.fetchgit {
+          url = "https://github.com/purescript-contrib/purescript-aff-coroutines.git";
+          rev = "f2f410f3cc9030487ddadf9ffdaab75ba508bde9";
+          sha256 = "1cbly4m2na5kf3halj68rjy5khydb71gzz0ry323z5h1i0fna2g9";
+        };
+        phases = "installPhase";
+        installPhase = "ln -s $src $out";
+      };
+
     "affjax" = pkgs.stdenv.mkDerivation {
         name = "affjax";
         version = "v10.0.0";
@@ -1181,6 +1193,18 @@ let
         installPhase = "ln -s $src $out";
       };
 
+    "web-socket" = pkgs.stdenv.mkDerivation {
+        name = "web-socket";
+        version = "v2.0.0";
+        src = pkgs.fetchgit {
+          url = "https://github.com/purescript-web/purescript-web-socket.git";
+          rev = "00f4ab583efb6fc60e0517d782d2ba2a89d8ec66";
+          sha256 = "0kp4rmrqmsjmih7nw7dl75d36pny3ikafnhnfchpc834ap9451zh";
+        };
+        phases = "installPhase";
+        installPhase = "ln -s $src $out";
+      };
+
     "web-storage" = pkgs.stdenv.mkDerivation {
         name = "web-storage";
         version = "v3.0.0";
diff --git a/plutus-scb-client/spago.dhall b/plutus-scb-client/spago.dhall
index 9da77ca3191..4d79a59ca85 100644
--- a/plutus-scb-client/spago.dhall
+++ b/plutus-scb-client/spago.dhall
@@ -7,6 +7,8 @@ You can edit this file as you like.
   [ "prelude"
   , "aff"
   , "console"
+  , "coroutines"
+  , "aff-coroutines"
   , "debug"
   , "effect"
   , "halogen"
@@ -22,6 +24,7 @@ You can edit this file as you like.
   , "undefinable"
   , "uuid"
   , "newtype"
+  , "web-socket"
   ]
 , packages = ./packages.dhall
 , sources =
diff --git a/plutus-scb-client/src/Main.purs b/plutus-scb-client/src/Main.purs
index a0e7c1729e6..87cb714db07 100644
--- a/plutus-scb-client/src/Main.purs
+++ b/plutus-scb-client/src/Main.purs
@@ -1,19 +1,37 @@
 module Main where
 
 import Prelude
+import Control.Coroutine (connect, runProcess)
+import Control.Coroutine.Extra (mapConsumer)
 import Effect (Effect)
+import Effect.Aff (Aff, forkAff)
 import Effect.Unsafe (unsafePerformEffect)
 import Halogen.Aff (awaitBody, runHalogenAff)
 import Halogen.VDom.Driver (runUI)
 import MainFrame (initialMainFrame)
-import Types (HAction(..))
+import Plutus.SCB.Types (ContractExe)
+import Plutus.SCB.Webserver.Types (StreamToClient)
+import Types (HAction(..), Output(..), Query(..))
+import WebSocket.Support (mkSocket, Output) as WS
+import WebSocket.Support (wsConsumer, wsProducer, wsSender)
 
 main :: Effect Unit
 main = do
+  socket <- WS.mkSocket "/ws"
   runHalogenAff do
     body <- awaitBody
     driver <- runUI initialMainFrame Init body
-    pure unit
+    let
+      handleWebSocket :: WS.Output (StreamToClient ContractExe) -> Aff Unit
+      handleWebSocket msg = void $ driver.query $ ReceiveWebSocketMessage msg unit
+    void $ forkAff
+      $ runProcess
+      $ connect
+          (wsProducer socket)
+          (wsConsumer handleWebSocket)
+    driver.subscribe
+      $ mapConsumer (case _ of (SendWebSocketMessage msg) -> msg)
+      $ wsSender handleWebSocket socket
 
 onLoad :: Unit
 onLoad = unsafePerformEffect main
diff --git a/plutus-scb-client/src/MainFrame.purs b/plutus-scb-client/src/MainFrame.purs
index 76a9107face..7ab49eee30e 100644
--- a/plutus-scb-client/src/MainFrame.purs
+++ b/plutus-scb-client/src/MainFrame.purs
@@ -4,8 +4,8 @@ module MainFrame
   , initialState
   ) where
 
-import Prelude
-import Animation (class MonadAnimate, animate)
+import Prelude hiding (div)
+import Animation (animate)
 import Chain.Eval (handleAction) as Chain
 import Chain.Types (Action(..), AnnotatedBlockchain(..), _chainFocusAppearing)
 import Chain.Types (initialState) as Chain
@@ -15,21 +15,24 @@ import Control.Monad.Reader (class MonadAsk, runReaderT)
 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 (assign, findOf, modifying, to, traversed, use, view)
+import Data.Lens (_1, _2, assign, findOf, modifying, to, traversed, view)
 import Data.Lens.At (at)
-import Data.Lens.Extra (peruse, toSetOf, toArrayOf)
+import Data.Lens.Extra (peruse, toSetOf)
 import Data.Lens.Index (ix)
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.RawJson (RawJson(..))
 import Data.Set (Set)
 import Data.Set as Set
-import Data.Traversable (for_, sequence)
+import Data.Traversable (for_)
+import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
-import Effect.Class (class MonadEffect)
+import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Console (log)
 import Foreign.Generic (encodeJSON)
-import Halogen (Component, hoist)
+import Halogen (Component, HalogenM, hoist, raise)
 import Halogen as H
 import Halogen.HTML (HTML)
 import Language.Plutus.Contract.Effects.ExposeEndpoint (EndpointDescription)
@@ -43,15 +46,17 @@ 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)
+import Plutus.SCB.Webserver.Types (ContractSignatureResponse(..), FullReport, 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(..), Query, State(..), View(..), WebData, _annotatedBlockchain, _chainReport, _chainState, _contractActiveEndpoints, _contractInstanceIdString, _contractReport, _contractSignatures, _contractStates, _crAvailableContracts, _csCurrentState, _currentView, _fullReport)
+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 Validation (_argument)
 import View as View
+import WebSocket.Support as WS
 
 initialValue :: Value
 initialValue = adaToValue $ Lovelace { getLovelace: 0 }
@@ -63,6 +68,7 @@ initialState =
     , fullReport: NotAsked
     , chainState: Chain.initialState
     , contractSignatures: Map.empty
+    , webSocketMessage: NotAsked
     }
 
 ------------------------------------------------------------
@@ -73,7 +79,7 @@ initialMainFrame ::
   forall m.
   MonadAff m =>
   MonadClipboard m =>
-  Component HTML Query HAction Void m
+  Component HTML Query HAction Output m
 initialMainFrame =
   hoist (flip runReaderT ajaxSettings)
     $ H.mkComponent
@@ -81,30 +87,55 @@ initialMainFrame =
         , render: View.render
         , eval:
           H.mkEval
-            { handleAction: handleAction
-            , handleQuery: const $ pure Nothing
+            { handleAction
+            , handleQuery
             , initialize: Just Init
             , receive: const Nothing
             , finalize: Nothing
             }
         }
 
-handleAction ::
-  forall m.
+handleQuery ::
+  forall m a.
+  Warn (Text "Handle WebSocket errors.") =>
+  Warn (Text "Handle WebSocket disconnections.") =>
+  MonadAff m =>
+  MonadAsk (SPSettings_ SPParams_) m =>
   MonadState State m =>
+  MonadEffect m =>
+  Query a -> m (Maybe a)
+handleQuery (ReceiveWebSocketMessage (WS.ReceiveMessage msg) next) = do
+  case msg of
+    Right (NewChainReport report) -> assign (_fullReport <<< _Success <<< _chainReport) report
+    Right (NewContractReport report) -> do
+      assign (_fullReport <<< _Success <<< _contractReport) report
+      traverse_ updateFormsForContractInstance
+        (view _contractStates report)
+    Right (NewChainEvents events) -> assign (_fullReport <<< _Success <<< _events) events
+    Right (Echo _) -> pure unit
+    Right (ErrorResponse _) -> pure unit
+    Left err -> pure unit
+  assign _webSocketMessage $ RemoteData.fromEither msg
+  pure $ Just next
+
+handleQuery (ReceiveWebSocketMessage WS.WebSocketClosed next) = do
+  liftEffect $ log "Closed"
+  pure $ Just next
+
+handleAction ::
+  forall action slots m.
   MonadAff m =>
-  MonadAnimate m State =>
   MonadClipboard m =>
   MonadAsk (SPSettings_ SPParams_) m =>
   MonadEffect m =>
-  HAction -> m Unit
+  HAction -> HalogenM State action slots Output m Unit
 handleAction Init = handleAction LoadFullReport
 
-handleAction (ChangeView view) = assign _currentView view
+handleAction (ChangeView view) = do
+  sendWebSocketMessage $ Ping $ show view
+  assign _currentView view
 
-handleAction (ActivateContract contract) = do
-  result <- runAjax $ postApiContractActivate contract
-  handleAction LoadFullReport
+handleAction (ActivateContract contract) = void $ runAjax $ postApiContractActivate contract
 
 handleAction LoadFullReport = do
   assign _fullReport Loading
@@ -112,21 +143,17 @@ handleAction LoadFullReport = do
   assign _fullReport fullReportResult
   for_ fullReportResult
     ( \fullReport ->
-        traverse_
-          ( \contractInstance@(ContractInstanceState { csContract, csCurrentState }) -> do
-              let
-                uuid = view _contractInstanceIdString csContract
-              contractSchema <- runAjax $ getApiContractByContractinstanceidSchema uuid
-              assign (_contractSignatures <<< at csContract)
-                (Just $ createEndpointForms contractInstance <$> contractSchema)
-          )
-          (toArrayOf (_contractReport <<< _contractStates <<< traversed) fullReport)
+        traverse_ updateFormsForContractInstance
+          (view (_contractReport <<< _contractStates) fullReport)
     )
 
 handleAction (ChainAction subaction) = do
   mAnnotatedBlockchain <-
     peruse (_fullReport <<< _Success <<< _chainReport <<< _annotatedBlockchain <<< to AnnotatedBlockchain)
   let
+    wrapper ::
+      Warn (Text "The question, 'Should we animate this?' feels like it belongs in the Chain module. Not here.") =>
+      HalogenM State action slots Output m Unit -> HalogenM State action slots Output m Unit
     wrapper = case subaction of
       (FocusTx _) -> animate (_chainState <<< _chainFocusAppearing)
       _ -> identity
@@ -139,6 +166,7 @@ handleAction (ChangeContractEndpointCall contractInstanceId endpointIndex subact
     ( _contractSignatures
         <<< ix contractInstanceId
         <<< _Success
+        <<< _2
         <<< ix endpointIndex
         <<< _argument
     )
@@ -153,22 +181,39 @@ handleAction (InvokeContractEndpoint contractInstanceId endpointForm) = do
     encodedForm = RawJson <<< encodeJSON <$> formArgumentToJson (view _argument endpointForm)
   for_ encodedForm
     $ \argument -> do
-        instanceStateResult <-
-          runAjax
-            $ let
-                instanceId = view _contractInstanceIdString contractInstanceId
-
-                endpoint = view _getEndpointDescription endpointDescription
-              in
-                postApiContractByContractinstanceidEndpointByEndpointname argument instanceId endpoint
-        fullReportResult <- use _fullReport
+        assign (_contractSignatures <<< at contractInstanceId) (Just Loading)
+        runAjax
+          $ let
+              instanceId = view _contractInstanceIdString contractInstanceId
+
+              endpoint = view _getEndpointDescription endpointDescription
+            in
+              postApiContractByContractinstanceidEndpointByEndpointname argument instanceId endpoint
+
+updateFormsForContractInstance ::
+  forall m.
+  Warn (Text "TODO We shouldn't have to go to the backend every time for this data. Contract schemas don't change during the lifetime of the contract.") =>
+  MonadAsk (SPSettings_ SPParams_) m =>
+  MonadAff m =>
+  MonadState State m =>
+  ContractInstanceState ContractExe -> m Unit
+updateFormsForContractInstance newContractInstance = do
+  let
+    csContractId = view _csContract newContractInstance
+  oldContractInstance :: Maybe (ContractInstanceState ContractExe) <-
+    peruse
+      ( _contractSignatures
+          <<< ix csContractId
+          <<< _Success
+          <<< _1
+      )
+  when (oldContractInstance /= Just newContractInstance)
+    $ do
         let
-          newForms :: WebData (Maybe (Array EndpointForm))
-          newForms = createNewEndpointFormsM fullReportResult instanceStateResult
-        assign (_contractSignatures <<< at contractInstanceId) (sequence newForms)
-        case instanceStateResult of
-          Success _ -> handleAction LoadFullReport
-          _ -> pure unit
+          uuid = view (_csContract <<< _contractInstanceIdString) newContractInstance
+        contractSchema <- runAjax $ getApiContractByContractinstanceidSchema uuid
+        assign (_contractSignatures <<< at csContractId)
+          (Just (Tuple newContractInstance <$> (createEndpointForms newContractInstance <$> contractSchema)))
 
 createNewEndpointFormsM ::
   forall m.
@@ -214,9 +259,6 @@ createEndpointForms contractState = signatureToForms
     , schema
     }
 
-runAjax :: forall m a. Functor m => ExceptT AjaxError m a -> m (WebData a)
-runAjax action = RemoteData.fromEither <$> runExceptT action
-
 getMatchingSignature ::
   forall t.
   Eq t =>
@@ -232,3 +274,9 @@ getMatchingSignature (ContractInstanceState { csContractDefinition }) =
     isMatch
   where
   isMatch (ContractSignatureResponse { csrDefinition }) = csrDefinition == csContractDefinition
+
+runAjax :: forall m a. Functor m => ExceptT AjaxError m a -> m (WebData a)
+runAjax action = RemoteData.fromEither <$> runExceptT action
+
+sendWebSocketMessage :: forall state action slots m. StreamToServer ContractExe -> HalogenM state action slots Output m Unit
+sendWebSocketMessage msg = raise $ SendWebSocketMessage $ WS.SendMessage msg
diff --git a/plutus-scb-client/src/Types.purs b/plutus-scb-client/src/Types.purs
index 610982cd82c..d5e6279f3bc 100644
--- a/plutus-scb-client/src/Types.purs
+++ b/plutus-scb-client/src/Types.purs
@@ -2,6 +2,7 @@ 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)
@@ -15,6 +16,7 @@ import Data.Newtype (class Newtype)
 import Data.NonEmpty ((:|))
 import Data.Symbol (SProxy(..))
 import Data.UUID as UUID
+import Foreign (MultipleErrors)
 import Language.Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint, EndpointDescription)
 import Language.Plutus.Contract.Resumable (Request)
 import Ledger.Index (UtxoIndex)
@@ -22,16 +24,22 @@ import Ledger.Tx (Tx)
 import Ledger.TxId (TxId)
 import Network.RemoteData (RemoteData)
 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, _ChainReport, _ContractReport, _ContractSignatureResponse)
+import Plutus.SCB.Webserver.Types (ChainReport, ContractReport, ContractSignatureResponse, FullReport, StreamToClient, StreamToServer, _ChainReport, _ContractReport, _ContractSignatureResponse)
 import Schema (FormSchema)
 import Schema.Types (FormArgument, FormEvent)
 import Servant.PureScript.Ajax (AjaxError)
 import Test.QuickCheck (class Arbitrary)
 import Wallet.Rollup.Types (AnnotatedTx)
+import WebSocket.Support as WS
 
 data Query a
+  = ReceiveWebSocketMessage (WS.Output (StreamToClient ContractExe)) a
+
+data Output
+  = SendWebSocketMessage (WS.Input (StreamToServer ContractExe))
 
 type WebData
   = RemoteData AjaxError
@@ -50,7 +58,8 @@ newtype State
   { currentView :: View
   , fullReport :: WebData (FullReport ContractExe)
   , chainState :: Chain.State
-  , contractSignatures :: Map ContractInstanceId (WebData (Array EndpointForm))
+  , contractSignatures :: Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm))
+  , webSocketMessage :: RemoteData MultipleErrors (StreamToClient ContractExe)
   }
 
 type EndpointForm
@@ -74,10 +83,13 @@ _contractReport = _Newtype <<< prop (SProxy :: SProxy "contractReport")
 _chainReport :: forall t. Lens' (FullReport t) (ChainReport t)
 _chainReport = _Newtype <<< prop (SProxy :: SProxy "chainReport")
 
+_events :: forall t. Lens' (FullReport t) (Array (ChainEvent t))
+_events = _Newtype <<< prop (SProxy :: SProxy "events")
+
 _chainState :: Lens' State Chain.State
 _chainState = _Newtype <<< prop (SProxy :: SProxy "chainState")
 
-_contractSignatures :: Lens' State (Map ContractInstanceId (WebData (Array EndpointForm)))
+_contractSignatures :: Lens' State (Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm)))
 _contractSignatures = _Newtype <<< prop (SProxy :: SProxy "contractSignatures")
 
 _annotatedBlockchain :: forall t. Lens' (ChainReport t) (Array (Array AnnotatedTx))
@@ -86,6 +98,9 @@ _annotatedBlockchain = _ChainReport <<< prop (SProxy :: SProxy "annotatedBlockch
 _transactionMap :: forall t. Lens' (ChainReport t) (JsonMap TxId Tx)
 _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")
+
 _utxoIndex :: forall t. Lens' (ChainReport t) UtxoIndex
 _utxoIndex = _ChainReport <<< prop (SProxy :: SProxy "utxoIndex")
 
diff --git a/plutus-scb-client/src/View.purs b/plutus-scb-client/src/View.purs
index d5253892699..108e9484ed0 100644
--- a/plutus-scb-client/src/View.purs
+++ b/plutus-scb-client/src/View.purs
@@ -5,15 +5,16 @@ 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 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.Contract (ContractInstanceId)
+import Plutus.SCB.Events.Contract (ContractInstanceId, ContractInstanceState)
 import Plutus.SCB.Types (ContractExe)
 import Plutus.SCB.Webserver.Types (FullReport(..))
 import Prelude (($), (<$>), (<<<))
-import Types (EndpointForm, HAction(..), State(State), View(..), WebData, _crAvailableContracts, _csrDefinition, _utxoIndex)
+import Types (EndpointForm, HAction(..), State(..), View(..), WebData, _crAvailableContracts, _csrDefinition, _utxoIndex)
 import View.Blockchain (annotatedBlockchainPane)
 import View.Contracts (contractStatusesPane, installedContractsPane)
 import View.Events (eventsPane, utxoIndexPane)
@@ -23,7 +24,7 @@ render ::
   forall m slots.
   MonadAff m =>
   State -> ComponentHTML HAction slots m
-render (State { currentView, chainState, fullReport, contractSignatures }) =
+render (State { currentView, chainState, fullReport, contractSignatures, webSocketMessage }) =
   div
     [ class_ $ ClassName "main-frame" ]
     [ container_
@@ -61,14 +62,14 @@ fullReportPane ::
   forall p.
   View ->
   Chain.State ->
-  Map ContractInstanceId (WebData (Array EndpointForm)) ->
+  Map ContractInstanceId (WebData (ContractInstanceState ContractExe /\ Array EndpointForm)) ->
   FullReport ContractExe ->
   HTML p HAction
 fullReportPane currentView chainState contractSignatures fullReport@(FullReport { events, contractReport, chainReport }) =
   row_
     [ viewContainer currentView ActiveContracts
         [ row_
-            [ col12_ [ contractStatusesPane contractSignatures contractReport ]
+            [ col12_ [ contractStatusesPane contractSignatures ]
             , col12_
                 [ installedContractsPane
                     ( toArrayOf
diff --git a/plutus-scb-client/src/View/Contracts.purs b/plutus-scb-client/src/View/Contracts.purs
index a8df17929a2..a1ea4545c29 100644
--- a/plutus-scb-client/src/View/Contracts.purs
+++ b/plutus-scb-client/src/View/Contracts.purs
@@ -5,20 +5,21 @@ import Bootstrap (btn, btnBlock, btnPrimary, btnSmall, cardBody_, cardFooter_, c
 import Bootstrap as Bootstrap
 import Data.Array (mapWithIndex, null)
 import Data.Foldable.Extra (interleave)
-import Data.Lens (view)
+import Data.Lens (_1, filtered, toArrayOf, traversed, view)
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested (type (/\), (/\))
 import Halogen.HTML (HTML, br_, button, div_, h2_, h3_, table, tbody_, td_, text, th, th_, thead_, tr_)
 import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Properties (classes, colSpan)
 import Language.Plutus.Contract.Resumable (IterationID(..), Request(..), RequestID(..))
+import Network.RemoteData (_Success)
 import Playground.Lenses (_endpointDescription, _getEndpointDescription, _schema)
 import Playground.Schema (actionArgumentForm)
 import Playground.Types (_FunctionSchema)
 import Plutus.SCB.Events.Contract (ContractInstanceId, ContractInstanceState)
 import Plutus.SCB.Types (ContractExe)
-import Plutus.SCB.Webserver.Types (ContractReport(..))
 import Schema.Types (FormEvent)
 import Types (EndpointForm, HAction(..), WebData, _contractInstanceIdString, _contractPath, _csContract, _csCurrentState, _hooks)
 import Validation (_argument)
@@ -59,25 +60,27 @@ installedContractPane installedContract =
 
 contractStatusesPane ::
   forall p t.
-  Map ContractInstanceId (WebData (Array EndpointForm)) ->
-  ContractReport t ->
+  Map ContractInstanceId (WebData (ContractInstanceState t /\ Array EndpointForm)) ->
   HTML p HAction
-contractStatusesPane contractSignatures (ContractReport { crActiveContractStates }) =
+contractStatusesPane contractSignatures =
   card_
     [ cardHeader_
         [ h2_ [ text "Active Contracts" ]
         ]
     , cardBody_
-        [ if null crActiveContractStates then
+        [ if null contractStates then
             text "You do not have any active contracts."
           else
-            div_ (contractStatusPane contractSignatures <$> crActiveContractStates)
+            div_ (contractStatusPane contractSignatures <$> contractStates)
         ]
     ]
+  where
+  contractStates :: Array (ContractInstanceState t)
+  contractStates = toArrayOf (traversed <<< _Success <<< _1) contractSignatures
 
 contractStatusPane ::
   forall p t.
-  Map ContractInstanceId (WebData (Array EndpointForm)) ->
+  Map ContractInstanceId (WebData (ContractInstanceState t /\ Array EndpointForm)) ->
   ContractInstanceState t -> HTML p HAction
 contractStatusPane contractSignatures contractInstance =
   div_
@@ -86,7 +89,7 @@ contractStatusPane contractSignatures contractInstance =
         ( case Map.lookup contractInstanceId contractSignatures of
             Just remoteData ->
               webDataPane
-                ( \endpointForms ->
+                ( \(_ /\ endpointForms) ->
                     row_
                       ( mapWithIndex
                           (\index endpointForm -> actionCard contractInstanceId (ChangeContractEndpointCall contractInstanceId index) endpointForm)
@@ -129,6 +132,9 @@ contractRequestView contractInstance =
       , td_ [ text $ show rqRequest ]
       ]
 
+hasActiveRequests :: forall t. ContractInstanceState t -> Boolean
+hasActiveRequests contractInstance = not $ null $ view (_csCurrentState <<< _hooks) contractInstance
+
 actionCard :: forall p. ContractInstanceId -> (FormEvent -> HAction) -> EndpointForm -> HTML p HAction
 actionCard contractInstanceId wrapper endpointForm =
   col4_
diff --git a/plutus-scb-client/src/View/Events.purs b/plutus-scb-client/src/View/Events.purs
index 0f9650488bc..b95abdcfd8f 100644
--- a/plutus-scb-client/src/View/Events.purs
+++ b/plutus-scb-client/src/View/Events.purs
@@ -1,4 +1,7 @@
-module View.Events (eventsPane, utxoIndexPane) where
+module View.Events
+  ( eventsPane
+  , utxoIndexPane
+  ) where
 
 import Prelude
 import Bootstrap (alertDanger_, badgePrimary_, cardBody_, cardHeader_, card_, nbsp)
@@ -53,7 +56,7 @@ eventsPane events =
     , cardBody_ [ div_ (countedEventPane <$> countConsecutive events) ]
     ]
 
-countedEventPane :: forall p i. Int /\ ChainEvent ContractExe -> HTML p i
+countedEventPane :: forall t p i. Render t => Int /\ ChainEvent t -> HTML p i
 countedEventPane (count /\ event) =
   div_
     [ preWrap_
diff --git a/plutus-scb-client/webpack.config.js b/plutus-scb-client/webpack.config.js
index 806387dbe07..21e5fe0499a 100644
--- a/plutus-scb-client/webpack.config.js
+++ b/plutus-scb-client/webpack.config.js
@@ -33,6 +33,10 @@ module.exports = {
         proxy: {
             "/api": {
                 target: 'http://localhost:8080'
+            },
+            "/ws": {
+                target: 'ws://localhost:8080',
+                ws: true
             }
         }
     },
diff --git a/plutus-scb/app/PSGenerator.hs b/plutus-scb/app/PSGenerator.hs
index eb5965404a6..d0f2130fa22 100644
--- a/plutus-scb/app/PSGenerator.hs
+++ b/plutus-scb/app/PSGenerator.hs
@@ -51,9 +51,10 @@ import           Plutus.SCB.MockApp                                (defaultWalle
 import qualified Plutus.SCB.MockApp                                as MockApp
 import           Plutus.SCB.Types                                  (ContractExe)
 import qualified Plutus.SCB.Webserver.API                          as API
-import qualified Plutus.SCB.Webserver.Server                       as Webserver
+import qualified Plutus.SCB.Webserver.Handler                      as Webserver
 import           Plutus.SCB.Webserver.Types                        (ChainReport, ContractReport,
-                                                                    ContractSignatureResponse, FullReport)
+                                                                    ContractSignatureResponse, FullReport,
+                                                                    StreamToClient, StreamToServer)
 import qualified PSGenerator.Common
 import           Servant.PureScript                                (HasBridge, Settings, apiModuleName, defaultBridge,
                                                                     defaultSettings, languageBridge,
@@ -93,6 +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 @(ContractInstanceState A))
     , (equal <*> (genericShow <*> mkSumType))
           (Proxy @(ContractSignatureResponse A))
diff --git a/plutus-scb/plutus-scb.cabal b/plutus-scb/plutus-scb.cabal
index 644c5d8ccc3..0f31750fb71 100644
--- a/plutus-scb/plutus-scb.cabal
+++ b/plutus-scb/plutus-scb.cabal
@@ -69,8 +69,10 @@ library
         Cardano.Wallet.Mock
         Cardano.Wallet.Server
         Cardano.Wallet.Types
+        Control.Monad.Freer.Delay
         Control.Monad.Freer.Extra.Log
         Control.Monad.Freer.Extra.State
+        Control.Monad.Freer.WebSocket
         Control.Concurrent.Availability
         Data.Time.Units.Extra
         Plutus.SCB.App
@@ -88,9 +90,11 @@ library
         Plutus.SCB.Effects.EventLog
         Plutus.SCB.Effects.MultiAgent
         Plutus.SCB.Effects.UUID
-        Plutus.SCB.Webserver.Types
         Plutus.SCB.Webserver.API
+        Plutus.SCB.Webserver.Handler
         Plutus.SCB.Webserver.Server
+        Plutus.SCB.Webserver.Types
+        Plutus.SCB.Webserver.WebSocket
         Plutus.SCB.Events
         Plutus.SCB.Events.Contract
         Plutus.SCB.Events.Node
@@ -158,6 +162,7 @@ library
         servant-server -any,
         typed-protocols -any,
         typed-protocols-examples -any,
+        servant-websockets -any,
         stm -any,
         text -any,
         time-units -any,
@@ -168,6 +173,7 @@ library
         vector -any,
         warp -any,
         Win32-network -any,
+        websockets -any,
         yaml -any,
         freer-simple -any,
         mwc-random -any,
diff --git a/plutus-scb/src/Control/Monad/Freer/Delay.hs b/plutus-scb/src/Control/Monad/Freer/Delay.hs
new file mode 100644
index 00000000000..02897c16067
--- /dev/null
+++ b/plutus-scb/src/Control/Monad/Freer/Delay.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs            #-}
+{-# LANGUAGE LambdaCase       #-}
+{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE TypeOperators    #-}
+
+module Control.Monad.Freer.Delay where
+
+import           Control.Concurrent     (threadDelay)
+import           Control.Monad.Freer    (Eff, LastMember, type (~>), interpret)
+import           Control.Monad.Freer.TH (makeEffect)
+import           Control.Monad.IO.Class (MonadIO, liftIO)
+import           Data.Time.Units        (TimeUnit, toMicroseconds)
+
+data DelayEffect r where
+    DelayThread :: TimeUnit a => a -> DelayEffect ()
+
+makeEffect ''DelayEffect
+
+handleDelayEffect ::
+       forall effs m. (LastMember m effs, MonadIO m)
+    => Eff (DelayEffect ': effs) ~> Eff effs
+handleDelayEffect =
+    interpret $ \case
+        DelayThread t ->
+            liftIO . threadDelay . fromIntegral . toMicroseconds $ t
diff --git a/plutus-scb/src/Control/Monad/Freer/WebSocket.hs b/plutus-scb/src/Control/Monad/Freer/WebSocket.hs
new file mode 100644
index 00000000000..4e0359aae21
--- /dev/null
+++ b/plutus-scb/src/Control/Monad/Freer/WebSocket.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs            #-}
+{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE TypeOperators    #-}
+
+module Control.Monad.Freer.WebSocket where
+
+import           Control.Monad.Freer           (Eff, LastMember, type (~>), interpret)
+import           Control.Monad.Freer.TH        (makeEffect)
+import           Control.Monad.IO.Class        (MonadIO, liftIO)
+import           Data.Aeson                    (FromJSON, ToJSON)
+import qualified Data.Aeson                    as JSON
+import           Data.UUID                     (UUID)
+import           Data.UUID.V4                  (nextRandom)
+import qualified Network.WebSockets            as WS
+import           Network.WebSockets.Connection (Connection, PendingConnection, receiveData)
+
+data WebSocketEffect r where
+    AcceptConnection :: PendingConnection -> WebSocketEffect (UUID, Connection)
+    ReceiveJSON :: FromJSON a => Connection -> WebSocketEffect (Either String a)
+    SendJSON :: ToJSON a => Connection -> a -> WebSocketEffect ()
+
+makeEffect ''WebSocketEffect
+
+handleWebSocket ::
+       forall effs m. (LastMember m effs, MonadIO m)
+    => Eff (WebSocketEffect ': effs) ~> Eff effs
+handleWebSocket =
+    interpret $ \eff ->
+        liftIO $
+        case eff of
+            AcceptConnection pendingConnection -> do
+                connection <- WS.acceptRequest pendingConnection
+                uuid <- nextRandom
+                pure (uuid, connection)
+            ReceiveJSON connection -> do
+                msg <- receiveData connection
+                pure $ JSON.eitherDecode msg
+            SendJSON connection value ->
+                WS.sendTextData connection $ JSON.encode value
diff --git a/plutus-scb/src/Plutus/SCB/App.hs b/plutus-scb/src/Plutus/SCB/App.hs
index 82d37fc9426..fdcfe323b92 100644
--- a/plutus-scb/src/Plutus/SCB/App.hs
+++ b/plutus-scb/src/Plutus/SCB/App.hs
@@ -33,6 +33,7 @@ import           Control.Monad.Freer.Extra.Log    (LogMsg, handleWriterLog, logD
 import           Control.Monad.Freer.Log          (LogMessage, LogObserve, handleObserveLog, renderLogMessages)
 import qualified Control.Monad.Freer.Log          as Log
 import           Control.Monad.Freer.Reader       (Reader, asks, runReader)
+import           Control.Monad.Freer.WebSocket    (WebSocketEffect, handleWebSocket)
 import           Control.Monad.Freer.Writer       (Writer)
 import           Control.Monad.IO.Class           (MonadIO, liftIO)
 import           Control.Monad.IO.Unlift          (MonadUnliftIO)
@@ -41,7 +42,6 @@ import           Control.Monad.Logger             (LogLevel, LoggingT (..), Mona
 import           Data.Aeson                       (FromJSON, eitherDecode)
 import qualified Data.Aeson                       as JSON
 import qualified Data.Aeson.Encode.Pretty         as JSON
-import qualified Data.ByteString.Lazy.Char8       as LBS
 import qualified Data.ByteString.Lazy.Char8       as BSL8
 import           Data.String                      (IsString (fromString))
 import qualified Data.Text                        as Text
@@ -61,6 +61,7 @@ import           Plutus.SCB.Effects.UUID          (UUIDEffect, handleUUIDEffect)
 import           Plutus.SCB.Events                (ChainEvent)
 import           Plutus.SCB.Types                 (Config (Config), ContractExe (..), SCBError (..), chainIndexConfig,
                                                    dbConfig, nodeServerConfig, signingProcessConfig, walletServerConfig)
+import           Plutus.SCB.Webserver.Types       (WebSocketLogMsg)
 import           Servant.Client                   (ClientEnv, ClientError, mkClientEnv)
 import           System.Exit                      (ExitCode (ExitFailure, ExitSuccess))
 import           System.Process                   (readProcessWithExitCode)
@@ -96,96 +97,113 @@ type AppBackend m =
          , ChainIndexEffect
          , Error ClientError
          , EventLogEffect (ChainEvent ContractExe)
+         , WebSocketEffect
          , Error SCBError
          , Writer [Wallet.Emulator.Wallet.WalletEvent]
          , LogMsg Wallet.Emulator.Wallet.WalletEvent
          , LogMsg ContractExeLogMsg
          , LogMsg (ContractInstanceMsg ContractExe)
+         , LogMsg WebSocketLogMsg
          , LogMsg UnStringifyJSONLog
          , LogMsg (CoreMsg ContractExe)
          , LogObserve (LogMessage Text.Text)
          , LogMsg Text.Text
          , Reader Connection
+         , Reader Config
          , Reader Env
          , m
          ]
 
 runAppBackend ::
-    forall m a.
-    ( MonadIO m
-    , MonadLogger m
-    , MonadUnliftIO m
-    )
-    => Env
+       forall m a. (MonadIO m, MonadLogger m, MonadUnliftIO m)
+    => Config
     -> Eff (AppBackend m) a
     -> m (Either SCBError a)
-runAppBackend e@Env{dbConnection, nodeClientEnv, walletClientEnv, signingProcessEnv, chainIndexEnv} =
-    runM
-    . runReader e
-    . runReader dbConnection
-    . runStderrLog
-    . handleObserveLog
-    . renderLogMessages
-    . renderLogMessages
-    . renderLogMessages
-    . renderLogMessages
-    . renderLogMessages
-    . handleWriterLog (\_ -> Log.Info)
-    . runError
-    . handleEventLogSql
-    . handleChainIndex
-    . handleContractEffectApp
-    . handleUUIDEffect
-    . handleSigningProcess
-    . handleNodeClient
-    . handleWallet
-    . handleNodeFollower
-    . handleRandomTxClient nodeClientEnv
-    where
+runAppBackend config eff = do
+    env@Env { dbConnection
+            , nodeClientEnv
+            , walletClientEnv
+            , signingProcessEnv
+            , chainIndexEnv
+            } <- mkEnv config
+    let
         handleChainIndex :: Eff (ChainIndexEffect ': Error ClientError ': _) a -> Eff _ a
         handleChainIndex =
-            flip handleError (throwError . ChainIndexError)
-            . handleChainIndexClient chainIndexEnv
-
-        handleSigningProcess :: Eff (SigningProcessEffect ': Error ClientError ': _) a -> Eff _ a
+            flip handleError (throwError . ChainIndexError) .
+            handleChainIndexClient chainIndexEnv
+        handleSigningProcess ::
+               Eff (SigningProcessEffect ': Error ClientError ': _) a -> Eff _ a
         handleSigningProcess =
-            flip handleError (throwError . SigningProcessError)
-            . SigningProcessClient.handleSigningProcessClient signingProcessEnv
-
-        handleNodeClient :: Eff (NodeClientEffect ': Error ClientError ': _) a -> Eff _ a
+            flip handleError (throwError . SigningProcessError) .
+            SigningProcessClient.handleSigningProcessClient signingProcessEnv
+        handleNodeClient ::
+               Eff (NodeClientEffect ': Error ClientError ': _) a -> Eff _ a
         handleNodeClient =
-            flip handleError (throwError . NodeClientError)
-            . handleNodeClientClient nodeClientEnv
-
-        handleNodeFollower :: Eff (NodeFollowerEffect ': Error ClientError ': _) a -> Eff _ a
+            flip handleError (throwError . NodeClientError) .
+            handleNodeClientClient nodeClientEnv
+        handleNodeFollower ::
+               Eff (NodeFollowerEffect ': Error ClientError ': _) a -> Eff _ a
         handleNodeFollower =
-            flip handleError (throwError . NodeClientError)
-            . handleNodeFollowerClient nodeClientEnv
-
-        handleWallet :: Eff (WalletEffect ': Error WalletAPIError ': Error ClientError ': _) a -> Eff _ a
+            flip handleError (throwError . NodeClientError) .
+            handleNodeFollowerClient nodeClientEnv
+        handleWallet ::
+               Eff (WalletEffect ': Error WalletAPIError ': Error ClientError ': _) a
+            -> Eff _ a
         handleWallet =
-            flip handleError (throwError . WalletClientError)
-            . flip handleError (throwError . WalletError)
-            . WalletClient.handleWalletClient walletClientEnv
-
+            flip handleError (throwError . WalletClientError) .
+            flip handleError (throwError . WalletError) .
+            WalletClient.handleWalletClient walletClientEnv
+    runM
+     . runReader env
+     . runReader config
+     . runReader dbConnection
+     . runStderrLog
+     . handleObserveLog
+     . renderLogMessages
+     . renderLogMessages
+     . renderLogMessages
+     . renderLogMessages
+     . renderLogMessages
+     . renderLogMessages
+     . handleWriterLog (\_ -> Log.Info)
+     . runError
+     . handleWebSocket
+     . handleEventLogSql
+     . handleChainIndex
+     . handleContractEffectApp
+     . handleUUIDEffect
+     . handleSigningProcess
+     . handleNodeClient
+     . handleWallet
+     . handleNodeFollower
+     . handleRandomTxClient nodeClientEnv $ eff
 
 type App a = Eff (AppBackend (LoggingT IO)) a
 
-runApp :: LogLevel -> Config -> App a -> IO (Either SCBError a)
-runApp minLogLevel Config {dbConfig, nodeServerConfig, walletServerConfig, signingProcessConfig, chainIndexConfig} action =
-    runStdoutLoggingT $ filterLogger (\_ logLevel -> logLevel >= minLogLevel) $ do
-        walletClientEnv <- mkEnv (WalletServer.baseUrl walletServerConfig)
-        nodeClientEnv <- mkEnv (NodeServer.mscBaseUrl nodeServerConfig)
-        signingProcessEnv <- mkEnv (SigningProcess.spBaseUrl signingProcessConfig)
-        chainIndexEnv <- mkEnv (ChainIndex.ciBaseUrl chainIndexConfig)
-        dbConnection <- dbConnect dbConfig
-        let env = Env {..}
-        runAppBackend @(LoggingT IO) env action
+mkEnv :: (MonadUnliftIO m, MonadLogger m) => Config -> m Env
+mkEnv Config { dbConfig
+             , nodeServerConfig
+             , walletServerConfig
+             , signingProcessConfig
+             , chainIndexConfig
+             } = do
+    walletClientEnv <- clientEnv (WalletServer.baseUrl walletServerConfig)
+    nodeClientEnv <- clientEnv (NodeServer.mscBaseUrl nodeServerConfig)
+    signingProcessEnv <-
+        clientEnv (SigningProcess.spBaseUrl signingProcessConfig)
+    chainIndexEnv <- clientEnv (ChainIndex.ciBaseUrl chainIndexConfig)
+    dbConnection <- dbConnect dbConfig
+    pure Env {..}
   where
-    mkEnv baseUrl =
-            mkClientEnv
-                <$> liftIO (newManager defaultManagerSettings)
-                <*> pure baseUrl
+    clientEnv baseUrl =
+        mkClientEnv <$> liftIO (newManager defaultManagerSettings) <*>
+        pure baseUrl
+
+runApp :: LogLevel -> Config -> App a -> IO (Either SCBError a)
+runApp minLogLevel config action =
+    runStdoutLoggingT $
+    filterLogger (\_ logLevel -> logLevel >= minLogLevel) $
+    runAppBackend @(LoggingT IO) config action
 
 data ContractExeLogMsg =
     InvokeContractMsg
@@ -280,7 +298,7 @@ parseStringifiedJSON ::
 parseStringifiedJSON v = case v of
     JSON.String s -> do
         logDebug ParseStringifiedJSONAttempt
-        let s' = JSON.decode @JSON.Value $ LBS.fromStrict $ Text.encodeUtf8 s
+        let s' = JSON.decode @JSON.Value $ BSL8.fromStrict $ Text.encodeUtf8 s
         case s' of
             Nothing -> do
                 logDebug ParseStringifiedJSONFailed
diff --git a/plutus-scb/src/Plutus/SCB/Core.hs b/plutus-scb/src/Plutus/SCB/Core.hs
index da63e1b0c86..46f89cf93fe 100644
--- a/plutus-scb/src/Plutus/SCB/Core.hs
+++ b/plutus-scb/src/Plutus/SCB/Core.hs
@@ -27,12 +27,10 @@ module Plutus.SCB.Core
     , refreshProjection
     , runCommand
     , runGlobalQuery
-    , addProcessBus
     , Source(..)
     , toUUID
     -- * Effects
     , ContractEffects
-    , SCBEffects
     , CoreMsg(..)
     -- * Contract messages
     , processAllContractInboxes
@@ -41,11 +39,10 @@ module Plutus.SCB.Core
     , callContractEndpoint
     ) where
 
-import           Cardano.Node.RandomTx            (GenRandomTx)
 import           Control.Monad                    (void)
 import           Control.Monad.Freer              (Eff, Member)
-import           Control.Monad.Freer.Error
-import           Control.Monad.Freer.Extra.Log
+import           Control.Monad.Freer.Error        (Error)
+import           Control.Monad.Freer.Extra.Log    (LogMsg, logInfo)
 import           Control.Monad.IO.Unlift          (MonadUnliftIO)
 import           Control.Monad.Logger             (MonadLogger)
 import qualified Control.Monad.Logger             as MonadLogger
@@ -57,21 +54,17 @@ import           Database.Persist.Sqlite          (createSqlitePoolFromInfo, mkS
 import           Eventful.Store.Sql               (defaultSqlEventStoreConfig)
 import qualified Ledger
 import           Plutus.SCB.Command               (installCommand)
-import           Plutus.SCB.Events                (ChainEvent, ContractInstanceId, ContractInstanceState)
-import qualified Plutus.SCB.Query                 as Query
-import           Plutus.SCB.Types                 (ContractExe, DbConfig (DbConfig), SCBError, Source (..),
-                                                   dbConfigFile, dbConfigPoolSize, toUUID)
-
-import           Cardano.Node.Follower            (NodeFollowerEffect)
 import           Plutus.SCB.Core.ContractInstance (activateContract, callContractEndpoint, processAllContractInboxes,
                                                    processAllContractOutboxes, processContractInbox)
 import           Plutus.SCB.Effects.Contract      (ContractCommand (..), ContractEffect, invokeContract)
-import           Plutus.SCB.Effects.EventLog      (Connection (..), EventLogEffect, addProcessBus, refreshProjection,
-                                                   runCommand, runGlobalQuery)
+import           Plutus.SCB.Effects.EventLog      (Connection (..), EventLogEffect, refreshProjection, runCommand,
+                                                   runGlobalQuery)
 import qualified Plutus.SCB.Effects.EventLog      as EventLog
 import           Plutus.SCB.Effects.UUID          (UUIDEffect)
-import           Wallet.API                       (WalletEffect)
-import           Wallet.Effects                   (ChainIndexEffect, NodeClientEffect, SigningProcessEffect)
+import           Plutus.SCB.Events                (ChainEvent, ContractInstanceId, ContractInstanceState)
+import qualified Plutus.SCB.Query                 as Query
+import           Plutus.SCB.Types                 (DbConfig (DbConfig), SCBError, Source (..), dbConfigFile,
+                                                   dbConfigPoolSize, toUUID)
 
 type ContractEffects t =
         '[ EventLogEffect (ChainEvent t)
@@ -149,16 +142,3 @@ dbConnect DbConfig {dbConfigFile, dbConfigPoolSize} = do
     MonadLogger.logDebugN "Connecting to DB"
     connectionPool <- createSqlitePoolFromInfo connectionInfo dbConfigPoolSize
     pure $ EventLog.Connection (defaultSqlEventStoreConfig, connectionPool)
-
-type SCBEffects =
-        '[ GenRandomTx
-        , NodeFollowerEffect
-        , WalletEffect
-        , UUIDEffect
-        , ContractEffect ContractExe
-        , ChainIndexEffect
-        , NodeClientEffect
-        , SigningProcessEffect
-        , EventLogEffect (ChainEvent ContractExe)
-        , LogMsg Text
-        ]
diff --git a/plutus-scb/src/Plutus/SCB/Effects/EventLog.hs b/plutus-scb/src/Plutus/SCB/Effects/EventLog.hs
index cc079e1e368..9f0d5347090 100644
--- a/plutus-scb/src/Plutus/SCB/Effects/EventLog.hs
+++ b/plutus-scb/src/Plutus/SCB/Effects/EventLog.hs
@@ -7,85 +7,100 @@
 
 module Plutus.SCB.Effects.EventLog where
 
-import           Control.Monad.Freer
+import           Control.Monad.Freer        (Eff, LastMember, Member, type (~>), interpret, sendM)
 import           Control.Monad.Freer.Extras (monadStateToState)
-import           Control.Monad.Freer.Reader
+import           Control.Monad.Freer.Reader (Reader, ask)
 import           Control.Monad.Freer.State  (State)
 import           Control.Monad.Freer.TH     (makeEffect)
 import qualified Control.Monad.IO.Unlift    as Unlift
 import qualified Control.Monad.Logger       as MonadLogger
 import           Data.Aeson                 (FromJSON, ToJSON)
-import           Database.Persist.Sqlite
-import           Eventful
+import           Database.Persist.Sqlite    (ConnectionPool, SqlPersistT, retryOnBusy, runSqlPool)
+import           Eventful                   (Aggregate, EventStoreWriter, GlobalStreamProjection, Projection,
+                                             VersionedEventStoreReader, VersionedStreamEvent, commandStoredAggregate,
+                                             getLatestStreamProjection, globalStreamProjection,
+                                             serializedEventStoreWriter, serializedGlobalEventStoreReader,
+                                             serializedVersionedEventStoreReader, streamProjectionState)
 import qualified Eventful.Store.Memory      as M
-import           Eventful.Store.Sql
+import           Eventful.Store.Sql         (JSONString, SqlEvent, SqlEventStoreConfig, jsonStringSerializer,
+                                             sqlEventStoreReader, sqlGlobalEventStoreReader)
 import           Eventful.Store.Sqlite      (sqliteEventStoreWriter)
-
-import           Plutus.SCB.Query           (nullProjection)
 import           Plutus.SCB.Types           (Source (..), toUUID)
 
 newtype Connection =
     Connection (SqlEventStoreConfig SqlEvent JSONString, ConnectionPool)
 
 data EventLogEffect event r where
-    RefreshProjection :: GlobalStreamProjection state event
-                     -> EventLogEffect event (GlobalStreamProjection state event)
-    RunCommand :: Aggregate state event command -> Source -> command -> EventLogEffect event [event]
+    RefreshProjection
+        :: GlobalStreamProjection state event
+        -> EventLogEffect event (GlobalStreamProjection state event)
+    RunCommand
+        :: Aggregate state event command
+        -> Source
+        -> command
+        -> EventLogEffect event [event]
+
 makeEffect ''EventLogEffect
 
 -- | A handler for 'EventLogEffect' that uses an 'M.EventMap'
 --   as the event store (in-memory)
 handleEventLogState ::
-    forall effs event.
-    ( Member (State (M.EventMap event)) effs)
+       forall effs event. (Member (State (M.EventMap event)) effs)
     => Eff (EventLogEffect event ': effs) ~> Eff effs
-handleEventLogState = interpret $ \case
-    RefreshProjection projection ->
-        monadStateToState $
-        getLatestStreamProjection M.stateGlobalEventStoreReader projection
-    RunCommand aggregate source command ->
-        monadStateToState $
-        commandStoredAggregate
-            M.stateEventStoreWriter
-            M.stateEventStoreReader
-            aggregate
-            (toUUID source)
-            command
+handleEventLogState =
+    interpret $ \case
+        RefreshProjection projection ->
+            monadStateToState $
+            getLatestStreamProjection M.stateGlobalEventStoreReader projection
+        RunCommand aggregate source command ->
+            monadStateToState $
+            commandStoredAggregate
+                M.stateEventStoreWriter
+                M.stateEventStoreReader
+                aggregate
+                (toUUID source)
+                command
 
 -- | A handler for 'EventLogEffect' that uses a SQL connection
 --   as the event store (remote)
 handleEventLogSql ::
-    forall effs event m.
-    ( Member (Reader Connection) effs
-    , LastMember m effs
-    , ToJSON event
-    , FromJSON event
-    , MonadLogger.MonadLogger m
-    , Unlift.MonadUnliftIO m
-    )
+       forall effs event m.
+       ( Member (Reader Connection) effs
+       , LastMember m effs
+       , ToJSON event
+       , FromJSON event
+       , MonadLogger.MonadLogger m
+       , Unlift.MonadUnliftIO m
+       )
     => Eff (EventLogEffect event ': effs) ~> Eff effs
-handleEventLogSql = interpret $ \case
-    RefreshProjection projection -> do
-        (Connection (sqlConfig, connectionPool)) <- ask
-        sendM $ do
-            let reader =
-                    serializedGlobalEventStoreReader jsonStringSerializer $
-                    sqlGlobalEventStoreReader sqlConfig
-            flip runSqlPool connectionPool $
-                getLatestStreamProjection reader projection
-    RunCommand aggregate source input -> do
-        (Connection (sqlConfig, connectionPool)) <- ask
-        sendM $ do
-            let reader =
-                    serializedVersionedEventStoreReader jsonStringSerializer $
-                    sqlEventStoreReader sqlConfig
-            let writer =
-                    addProcessBus
-                        (serializedEventStoreWriter jsonStringSerializer $
-                        sqliteEventStoreWriter sqlConfig)
+handleEventLogSql =
+    interpret $ \case
+        RefreshProjection projection -> do
+            (Connection (sqlConfig, connectionPool)) <- ask
+            sendM $ do
+                let reader =
+                        serializedGlobalEventStoreReader jsonStringSerializer $
+                        sqlGlobalEventStoreReader sqlConfig
+                flip runSqlPool connectionPool $
+                    getLatestStreamProjection reader projection
+        RunCommand aggregate source input -> do
+            Connection (sqlConfig, connectionPool) <- ask
+            sendM $ do
+                let reader :: VersionedEventStoreReader (SqlPersistT m) event
+                    reader =
+                        serializedVersionedEventStoreReader jsonStringSerializer $
+                        sqlEventStoreReader sqlConfig
+                let writer :: EventStoreWriter (SqlPersistT m) event
+                    writer =
+                        serializedEventStoreWriter jsonStringSerializer $
+                        sqliteEventStoreWriter sqlConfig
+                retryOnBusy . flip runSqlPool connectionPool $
+                    commandStoredAggregate
+                        writer
                         reader
-            retryOnBusy . flip runSqlPool connectionPool $
-                commandStoredAggregate writer reader aggregate (toUUID source) input
+                        aggregate
+                        (toUUID source)
+                        input
 
 runGlobalQuery ::
        Member (EventLogEffect event) effs
@@ -94,19 +109,3 @@ runGlobalQuery ::
 runGlobalQuery query =
     fmap streamProjectionState <$> refreshProjection $
     globalStreamProjection query
-
-addProcessBus ::
-       Monad m
-    => EventStoreWriter m event
-    -> VersionedEventStoreReader m event
-    -> EventStoreWriter m event
-addProcessBus writer reader =
-    synchronousEventBusWrapper
-        writer
-        [ \subwriter _ _ ->
-              applyProcessManagerCommandsAndEvents
-                  (ProcessManager nullProjection (const []) (const []))
-                  subwriter
-                  reader
-                  ()
-        ]
diff --git a/plutus-scb/src/Plutus/SCB/Webserver/API.hs b/plutus-scb/src/Plutus/SCB/Webserver/API.hs
index d9ea08d5956..0c1d083be1d 100644
--- a/plutus-scb/src/Plutus/SCB/Webserver/API.hs
+++ b/plutus-scb/src/Plutus/SCB/Webserver/API.hs
@@ -3,6 +3,7 @@
 
 module Plutus.SCB.Webserver.API
     ( API
+    , WSAPI
     ) where
 
 import qualified Data.Aeson                 as JSON
@@ -10,6 +11,7 @@ import           Data.Text                  (Text)
 import           Plutus.SCB.Events          (ContractInstanceState)
 import           Plutus.SCB.Webserver.Types (ContractSignatureResponse, FullReport)
 import           Servant.API                ((:<|>), (:>), Capture, Get, JSON, Post, ReqBody)
+import           Servant.API.WebSocket      (WebSocketPending)
 
 type API t
      = "api" :> ("healthcheck" :> Get '[ JSON] ()
@@ -17,3 +19,5 @@ type API t
                  :<|> "contract" :> ("activate" :> ReqBody '[ JSON] t :> Post '[ JSON] (ContractInstanceState t)
                                      :<|> Capture "contract-instance-id" Text :> ("schema" :> Get '[ JSON] (ContractSignatureResponse t)
                                                                                   :<|> "endpoint" :> Capture "endpoint-name" String :> ReqBody '[ JSON] JSON.Value :> Post '[ JSON] (ContractInstanceState t))))
+
+type WSAPI = "ws" :> WebSocketPending
diff --git a/plutus-scb/src/Plutus/SCB/Webserver/Handler.hs b/plutus-scb/src/Plutus/SCB/Webserver/Handler.hs
new file mode 100644
index 00000000000..491aa3870cb
--- /dev/null
+++ b/plutus-scb/src/Plutus/SCB/Webserver/Handler.hs
@@ -0,0 +1,206 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DerivingStrategies    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MonoLocalBinds        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeOperators         #-}
+
+module Plutus.SCB.Webserver.Handler
+    ( handler
+    , getFullReport
+    , getChainReport
+    , getContractReport
+    , contractSchema
+    ) where
+
+import           Control.Monad.Freer                             (Eff, Member)
+import           Control.Monad.Freer.Error                       (Error, throwError)
+import           Control.Monad.Freer.Extra.Log                   (LogMsg, logInfo)
+import           Control.Monad.Freer.Log                         (LogMessage, LogObserve)
+import qualified Data.Aeson                                      as JSON
+import           Data.Map                                        (Map)
+import qualified Data.Map                                        as Map
+import qualified Data.Set                                        as Set
+import           Data.Text                                       (Text)
+import           Data.Text.Prettyprint.Doc                       (Pretty, pretty)
+import qualified Data.UUID                                       as UUID
+import           Eventful                                        (streamEventEvent)
+import           Language.Plutus.Contract.Effects.ExposeEndpoint (EndpointDescription (EndpointDescription))
+import           Ledger                                          (PubKeyHash)
+import           Ledger.Blockchain                               (Blockchain)
+import           Plutus.SCB.App                                  (ContractExeLogMsg (..), UnStringifyJSONLog,
+                                                                  parseStringifiedJSON)
+import           Plutus.SCB.Arbitrary                            ()
+import           Plutus.SCB.Core                                 (runGlobalQuery)
+import qualified Plutus.SCB.Core                                 as Core
+import qualified Plutus.SCB.Core.ContractInstance                as Instance
+import           Plutus.SCB.Effects.Contract                     (ContractEffect, exportSchema)
+import           Plutus.SCB.Effects.EventLog                     (EventLogEffect)
+import           Plutus.SCB.Effects.UUID                         (UUIDEffect)
+import           Plutus.SCB.Events                               (ChainEvent, ContractInstanceId (ContractInstanceId),
+                                                                  ContractInstanceState (ContractInstanceState),
+                                                                  csContractDefinition)
+import qualified Plutus.SCB.Query                                as Query
+import           Plutus.SCB.Types
+import           Plutus.SCB.Webserver.Types
+import           Servant                                         ((:<|>) ((:<|>)))
+import           Wallet.Effects                                  (ChainIndexEffect, confirmedBlocks)
+import           Wallet.Emulator.Wallet                          (Wallet)
+import qualified Wallet.Rollup                                   as Rollup
+
+healthcheck :: Monad m => m ()
+healthcheck = pure ()
+
+getContractReport ::
+       forall t effs.
+       ( Member (EventLogEffect (ChainEvent t)) effs
+       , Member (ContractEffect t) effs
+       , Ord t
+       )
+    => Eff effs (ContractReport t)
+getContractReport = do
+    installedContracts <-
+        Set.toList <$> runGlobalQuery (Query.installedContractsProjection @t)
+    crAvailableContracts <-
+        traverse
+            (\t -> ContractSignatureResponse t <$> exportSchema t)
+            installedContracts
+    crActiveContractStates <-
+        Map.elems <$> runGlobalQuery (Query.contractState @t)
+    pure ContractReport {crAvailableContracts, crActiveContractStates}
+
+getChainReport ::
+       forall t effs. Member ChainIndexEffect effs
+    => Eff effs (ChainReport t)
+getChainReport = do
+    blocks :: Blockchain <- confirmedBlocks
+    let ChainOverview { chainOverviewBlockchain
+                      , chainOverviewUnspentTxsById
+                      , chainOverviewUtxoIndex
+                      } = mkChainOverview blocks
+    let walletMap :: Map PubKeyHash Wallet = Map.empty -- TODO Will the real walletMap please step forward?
+    annotatedBlockchain <- Rollup.doAnnotateBlockchain chainOverviewBlockchain
+    pure
+        ChainReport
+            { transactionMap = chainOverviewUnspentTxsById
+            , utxoIndex = chainOverviewUtxoIndex
+            , annotatedBlockchain
+            , walletMap
+            }
+
+getFullReport ::
+       forall t effs.
+       ( Member (EventLogEffect (ChainEvent t)) effs
+       , Member (ContractEffect t) effs
+       , Member ChainIndexEffect effs
+       , Ord t
+       )
+    => Eff effs (FullReport t)
+getFullReport = do
+    events <- fmap streamEventEvent <$> runGlobalQuery Query.pureProjection
+    contractReport <- getContractReport
+    chainReport <- getChainReport
+    pure FullReport {contractReport, chainReport, events}
+
+contractSchema ::
+       forall t effs.
+       ( Member (EventLogEffect (ChainEvent t)) effs
+       , Member (ContractEffect t) effs
+       , Member (Error SCBError) effs
+       )
+    => ContractInstanceId
+    -> Eff effs (ContractSignatureResponse t)
+contractSchema contractId = do
+    ContractInstanceState {csContractDefinition} <-
+        getContractInstanceState @t contractId
+    ContractSignatureResponse csContractDefinition <$>
+        exportSchema csContractDefinition
+
+activateContract ::
+       forall t effs.
+       ( Member (EventLogEffect (ChainEvent t)) effs
+       , Member (Error SCBError) effs
+       , Member (ContractEffect t) effs
+       , Member UUIDEffect effs
+       , Member (LogMsg (Instance.ContractInstanceMsg t)) effs
+       , Ord t
+       , Show t
+       )
+    => t
+    -> Eff effs (ContractInstanceState t)
+activateContract = Core.activateContract
+
+getContractInstanceState ::
+       forall t effs.
+       ( Member (EventLogEffect (ChainEvent t)) effs
+       , Member (Error SCBError) effs
+       )
+    => ContractInstanceId
+    -> Eff effs (ContractInstanceState t)
+getContractInstanceState contractId = do
+    contractStates <- runGlobalQuery (Query.contractState @t)
+    case Map.lookup contractId contractStates of
+        Nothing    -> throwError $ ContractInstanceNotFound contractId
+        Just value -> pure value
+
+invokeEndpoint ::
+       forall t effs.
+       ( Member (EventLogEffect (ChainEvent t)) effs
+       , Member (ContractEffect t) effs
+       , Member (LogMsg ContractExeLogMsg) effs
+       , Member (Error SCBError) effs
+       , Member (LogMsg (Instance.ContractInstanceMsg t)) effs
+       , Member (LogObserve (LogMessage Text)) effs
+       , Pretty t
+       )
+    => EndpointDescription
+    -> JSON.Value
+    -> ContractInstanceId
+    -> Eff effs (ContractInstanceState t)
+invokeEndpoint (EndpointDescription endpointDescription) payload contractId = do
+    logInfo $ InvokingEndpoint endpointDescription payload
+    newState :: [ChainEvent t] <-
+        Instance.callContractEndpoint @t contractId endpointDescription payload
+    logInfo $ EndpointInvocationResponse $ fmap pretty newState
+    getContractInstanceState contractId
+
+parseContractId ::
+       (Member (Error SCBError) effs) => Text -> Eff effs ContractInstanceId
+parseContractId t =
+    case UUID.fromText t of
+        Just uuid -> pure $ ContractInstanceId uuid
+        Nothing   -> throwError $ InvalidUUIDError t
+
+
+handler ::
+       forall effs.
+       ( Member (EventLogEffect (ChainEvent ContractExe)) effs
+       , Member (ContractEffect ContractExe) effs
+       , Member ChainIndexEffect effs
+       , Member UUIDEffect effs
+       , Member (LogMsg ContractExeLogMsg) effs
+       , Member (Error SCBError) effs
+       , Member (LogMsg UnStringifyJSONLog) effs
+       , Member (LogMsg (Instance.ContractInstanceMsg ContractExe)) effs
+       , Member (LogObserve (LogMessage Text)) effs
+       )
+    => Eff effs ()
+       :<|> (Eff effs (FullReport ContractExe)
+             :<|> ((ContractExe -> Eff effs (ContractInstanceState ContractExe))
+                   :<|> (Text -> Eff effs (ContractSignatureResponse ContractExe)
+                                 :<|> (String -> JSON.Value -> Eff effs (ContractInstanceState ContractExe)))))
+handler =
+    healthcheck :<|> getFullReport :<|>
+    (activateContract :<|>
+     (\rawInstanceId ->
+          (parseContractId rawInstanceId >>= contractSchema) :<|>
+          (\rawEndpointDescription payload ->
+               parseStringifiedJSON payload >>= \payload' ->
+                   parseContractId rawInstanceId >>=
+                   invokeEndpoint
+                       (EndpointDescription rawEndpointDescription)
+                       payload')))
diff --git a/plutus-scb/src/Plutus/SCB/Webserver/Server.hs b/plutus-scb/src/Plutus/SCB/Webserver/Server.hs
index cd2a4f45fad..c2f8f0bf21d 100644
--- a/plutus-scb/src/Plutus/SCB/Webserver/Server.hs
+++ b/plutus-scb/src/Plutus/SCB/Webserver/Server.hs
@@ -2,73 +2,38 @@
 {-# LANGUAGE DerivingStrategies    #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MonoLocalBinds        #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeOperators         #-}
 
 module Plutus.SCB.Webserver.Server
     ( main
-    , getFullReport
-    , contractSchema
     ) where
 
-import           Control.Concurrent.Availability                 (Availability, available)
-import           Control.Monad.Except                            (ExceptT (ExceptT))
-import           Control.Monad.Freer                             (Eff, Member)
-import           Control.Monad.Freer.Error                       (Error, throwError)
-import           Control.Monad.Freer.Extra.Log                   (LogMsg, logInfo)
-import           Control.Monad.Freer.Log                         (LogMessage, LogObserve)
-import           Control.Monad.IO.Class                          (liftIO)
-import           Control.Monad.Logger                            (LogLevel (LevelDebug))
-import qualified Data.Aeson                                      as JSON
-import           Data.Bifunctor                                  (first)
-import qualified Data.ByteString.Lazy.Char8                      as LBS
-import           Data.Function                                   ((&))
-import           Data.Map                                        (Map)
-import qualified Data.Map                                        as Map
-import           Data.Proxy                                      (Proxy (Proxy))
-import qualified Data.Set                                        as Set
-import           Data.Text                                       (Text)
-import qualified Data.Text.Encoding                              as Text
-import           Data.Text.Prettyprint.Doc                       (Pretty (..))
-import qualified Data.UUID                                       as UUID
-import           Eventful                                        (streamEventEvent)
-import           Language.Plutus.Contract.Effects.ExposeEndpoint (EndpointDescription (EndpointDescription))
-import           Ledger                                          (PubKeyHash)
-import           Ledger.Blockchain                               (Blockchain)
-import qualified Network.Wai.Handler.Warp                        as Warp
-import           Plutus.SCB.App                                  (App, ContractExeLogMsg (..), UnStringifyJSONLog,
-                                                                  parseStringifiedJSON, runApp)
-import           Plutus.SCB.Arbitrary                            ()
-import           Plutus.SCB.Core                                 (runGlobalQuery)
-import qualified Plutus.SCB.Core                                 as Core
-import qualified Plutus.SCB.Core.ContractInstance                as Instance
-import           Plutus.SCB.Effects.Contract                     (ContractEffect, exportSchema)
-import           Plutus.SCB.Effects.EventLog                     (EventLogEffect)
-import           Plutus.SCB.Effects.UUID                         (UUIDEffect)
-import           Plutus.SCB.Events                               (ChainEvent, ContractInstanceId (ContractInstanceId),
-                                                                  ContractInstanceState (ContractInstanceState),
-                                                                  csContractDefinition)
-import qualified Plutus.SCB.Query                                as Query
-import           Plutus.SCB.Types                                (ChainOverview (ChainOverview), Config, ContractExe,
-                                                                  SCBError (ContractInstanceNotFound, InvalidUUIDError),
-                                                                  baseUrl, chainOverviewBlockchain,
-                                                                  chainOverviewUnspentTxsById, chainOverviewUtxoIndex,
-                                                                  mkChainOverview, scbWebserverConfig, staticDir)
-import           Plutus.SCB.Utils                                (tshow)
-import           Plutus.SCB.Webserver.API                        (API)
-import           Plutus.SCB.Webserver.Types
-import           Servant                                         ((:<|>) ((:<|>)), Application, Handler (Handler), Raw,
-                                                                  err400, err500, errBody, hoistServer, serve,
-                                                                  serveDirectoryFileServer)
-import           Servant.Client                                  (BaseUrl (baseUrlPort))
-import           Wallet.Effects                                  (ChainIndexEffect, confirmedBlocks)
-import           Wallet.Emulator.Wallet                          (Wallet)
-import qualified Wallet.Rollup                                   as Rollup
+import           Control.Concurrent.Availability (Availability, available)
+import           Control.Monad.Except            (ExceptT (ExceptT))
+import           Control.Monad.Freer.Extra.Log   (logInfo)
+import           Control.Monad.IO.Class          (liftIO)
+import           Control.Monad.Logger            (LogLevel (LevelDebug))
+import           Data.Bifunctor                  (first)
+import qualified Data.ByteString.Lazy.Char8      as LBS
+import           Data.Function                   ((&))
+import           Data.Proxy                      (Proxy (Proxy))
+import qualified Data.Text.Encoding              as Text
+import qualified Network.Wai.Handler.Warp        as Warp
+import           Plutus.SCB.App                  (App, runApp)
+import           Plutus.SCB.Arbitrary            ()
+import           Plutus.SCB.Types                (Config, ContractExe, SCBError (InvalidUUIDError), baseUrl,
+                                                  scbWebserverConfig, staticDir)
+import           Plutus.SCB.Utils                (tshow)
+import           Plutus.SCB.Webserver.API        (API, WSAPI)
+import           Plutus.SCB.Webserver.Handler    (handler)
+import           Plutus.SCB.Webserver.WebSocket  (handleWS)
+import           Servant                         ((:<|>) ((:<|>)), Application, Handler (Handler), Raw, err400, err500,
+                                                  errBody, hoistServer, serve, serveDirectoryFileServer)
+import           Servant.Client                  (BaseUrl (baseUrlPort))
 
 asHandler :: Config -> App a -> Handler a
 asHandler config =
@@ -79,158 +44,15 @@ asHandler config =
             {errBody = "Invalid UUID: " <> LBS.fromStrict (Text.encodeUtf8 t)}
     decodeErr err = err500 {errBody = LBS.pack $ show err}
 
-healthcheck :: Monad m => m ()
-healthcheck = pure ()
-
-getContractReport ::
-       forall t effs.
-       ( Member (EventLogEffect (ChainEvent t)) effs
-       , Member (ContractEffect t) effs
-       , Ord t
-       )
-    => Eff effs (ContractReport t)
-getContractReport = do
-    installedContracts <- Set.toList <$> runGlobalQuery (Query.installedContractsProjection @t)
-    crAvailableContracts <- traverse (\t -> ContractSignatureResponse t <$> exportSchema t) installedContracts
-    crActiveContractStates <-
-        Map.elems <$> runGlobalQuery (Query.contractState @t)
-    pure ContractReport {crAvailableContracts, crActiveContractStates}
-
-getChainReport ::
-       forall t effs. Member ChainIndexEffect effs
-    => Eff effs (ChainReport t)
-getChainReport = do
-    blocks :: Blockchain <- confirmedBlocks
-    let ChainOverview { chainOverviewBlockchain
-                      , chainOverviewUnspentTxsById
-                      , chainOverviewUtxoIndex
-                      } = mkChainOverview blocks
-    let walletMap :: Map PubKeyHash Wallet = Map.empty -- TODO Will the real walletMap please step forward?
-    annotatedBlockchain <- Rollup.doAnnotateBlockchain chainOverviewBlockchain
-    pure
-        ChainReport
-            { transactionMap = chainOverviewUnspentTxsById
-            , utxoIndex = chainOverviewUtxoIndex
-            , annotatedBlockchain
-            , walletMap
-            }
-
-getFullReport ::
-       forall t effs.
-       ( Member (EventLogEffect (ChainEvent t)) effs
-       , Member (ContractEffect t) effs
-       , Member ChainIndexEffect effs
-       , Ord t
-       )
-    => Eff effs (FullReport t)
-getFullReport = do
-    events <- fmap streamEventEvent <$> runGlobalQuery Query.pureProjection
-    contractReport <- getContractReport
-    chainReport <- getChainReport
-    pure FullReport {contractReport, chainReport, events}
-
-contractSchema ::
-       forall t effs.
-       ( Member (EventLogEffect (ChainEvent t)) effs
-       , Member (ContractEffect t) effs
-       , Member (Error SCBError) effs
-       )
-    => ContractInstanceId
-    -> Eff effs (ContractSignatureResponse t)
-contractSchema contractId = do
-    ContractInstanceState {csContractDefinition} <- getContractInstanceState @t contractId
-    ContractSignatureResponse csContractDefinition <$> exportSchema csContractDefinition
-
-activateContract ::
-       forall t effs.
-       ( Member (EventLogEffect (ChainEvent t)) effs
-       , Member (Error SCBError) effs
-       , Member (ContractEffect t) effs
-       , Member UUIDEffect effs
-       , Member (LogMsg (Instance.ContractInstanceMsg t)) effs
-       , Ord t
-       , Show t
-       )
-    => t
-    -> Eff effs (ContractInstanceState t)
-activateContract = Core.activateContract
-
-getContractInstanceState ::
-       forall t effs.
-       ( Member (EventLogEffect (ChainEvent t)) effs
-       , Member (Error SCBError) effs
-       )
-    => ContractInstanceId
-    -> Eff effs (ContractInstanceState t)
-getContractInstanceState contractId = do
-    contractStates <- runGlobalQuery (Query.contractState @t)
-    case Map.lookup contractId contractStates of
-        Nothing    -> throwError $ ContractInstanceNotFound contractId
-        Just value -> pure value
-
-invokeEndpoint ::
-       forall t effs.
-       ( Member (EventLogEffect (ChainEvent t)) effs
-       , Member (ContractEffect t) effs
-       , Member (LogMsg ContractExeLogMsg) effs
-       , Member (Error SCBError) effs
-       , Member (LogMsg (Instance.ContractInstanceMsg t)) effs
-       , Member (LogObserve (LogMessage Text)) effs
-       , Pretty t
-       )
-    => EndpointDescription
-    -> JSON.Value
-    -> ContractInstanceId
-    -> Eff effs (ContractInstanceState t)
-invokeEndpoint (EndpointDescription endpointDescription) payload contractId = do
-    logInfo $ InvokingEndpoint endpointDescription payload
-    newState :: [ChainEvent t] <-
-        Instance.callContractEndpoint @t contractId endpointDescription payload
-    logInfo $ EndpointInvocationResponse $ fmap pretty newState
-    getContractInstanceState contractId
-
-parseContractId ::
-       (Member (Error SCBError) effs) => Text -> Eff effs ContractInstanceId
-parseContractId t =
-    case UUID.fromText t of
-        Just uuid -> pure $ ContractInstanceId uuid
-        Nothing   -> throwError $ InvalidUUIDError t
-
-handler ::
-       forall effs.
-       ( Member (EventLogEffect (ChainEvent ContractExe)) effs
-       , Member (ContractEffect ContractExe) effs
-       , Member ChainIndexEffect effs
-       , Member UUIDEffect effs
-       , Member (LogMsg ContractExeLogMsg) effs
-       , Member (Error SCBError) effs
-       , Member (LogMsg UnStringifyJSONLog) effs
-       , Member (LogMsg (Instance.ContractInstanceMsg ContractExe)) effs
-       , Member (LogObserve (LogMessage Text)) effs
-       )
-    => Eff effs ()
-       :<|> (Eff effs (FullReport ContractExe)
-             :<|> ((ContractExe -> Eff effs (ContractInstanceState ContractExe))
-                   :<|> (Text -> Eff effs (ContractSignatureResponse ContractExe)
-                                 :<|> (String -> JSON.Value -> Eff effs (ContractInstanceState ContractExe)))))
-handler =
-    healthcheck :<|> getFullReport :<|>
-    (activateContract :<|>
-     (\rawInstanceId ->
-          (parseContractId rawInstanceId >>= contractSchema) :<|>
-          (\rawEndpointDescription payload ->
-               parseStringifiedJSON payload >>= \payload' ->
-               parseContractId rawInstanceId >>=
-               invokeEndpoint
-                   (EndpointDescription rawEndpointDescription)
-                   payload')))
-
 app :: Config -> Application
 app config = serve rest (apiServer :<|> fileServer)
   where
-    rest = Proxy @(API ContractExe :<|> Raw)
-    api = Proxy @(API ContractExe)
-    apiServer = hoistServer api (asHandler config) handler
+    rest = Proxy @((API ContractExe :<|> WSAPI) :<|> Raw)
+    apiServer =
+      hoistServer
+        (Proxy @(API ContractExe :<|> WSAPI))
+        (asHandler config)
+        (handler :<|> handleWS)
     fileServer = serveDirectoryFileServer (staticDir . scbWebserverConfig $ config)
 
 main :: Config -> Availability -> App ()
diff --git a/plutus-scb/src/Plutus/SCB/Webserver/Types.hs b/plutus-scb/src/Plutus/SCB/Webserver/Types.hs
index 08e2a4e4e07..7b2bfbd7c85 100644
--- a/plutus-scb/src/Plutus/SCB/Webserver/Types.hs
+++ b/plutus-scb/src/Plutus/SCB/Webserver/Types.hs
@@ -1,20 +1,24 @@
 {-# LANGUAGE DeriveAnyClass     #-}
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE StrictData         #-}
 
 module Plutus.SCB.Webserver.Types where
 
-import           Data.Aeson             (FromJSON, ToJSON)
-import           Data.Map               (Map)
-import           GHC.Generics           (Generic)
-import           Ledger                 (PubKeyHash, Tx, TxId)
-import           Ledger.Index           (UtxoIndex)
-import           Playground.Types       (FunctionSchema)
-import           Plutus.SCB.Events      (ChainEvent, ContractInstanceState)
-import           Schema                 (FormSchema)
-import           Wallet.Emulator.Wallet (Wallet)
-import           Wallet.Rollup.Types    (AnnotatedTx)
+import           Data.Aeson                (FromJSON, ToJSON)
+import           Data.Map                  (Map)
+import           Data.Text                 (Text)
+import           Data.Text.Prettyprint.Doc (Pretty, pretty, viaShow, (<+>))
+import           Data.UUID                 (UUID)
+import           GHC.Generics              (Generic)
+import           Ledger                    (PubKeyHash, Tx, TxId)
+import           Ledger.Index              (UtxoIndex)
+import           Playground.Types          (FunctionSchema)
+import           Plutus.SCB.Events         (ChainEvent, ContractInstanceState)
+import           Schema                    (FormSchema)
+import           Wallet.Emulator.Wallet    (Wallet)
+import           Wallet.Rollup.Types       (AnnotatedTx)
 
 data ContractReport t =
     ContractReport
@@ -50,3 +54,27 @@ data ContractSignatureResponse t =
         }
     deriving (Show, Eq, Generic)
     deriving anyclass (FromJSON, ToJSON)
+
+newtype StreamToServer t =
+    Ping Text
+    deriving (Show, Eq, Generic)
+    deriving newtype (FromJSON, ToJSON)
+
+data StreamToClient t
+    = NewChainReport (ChainReport t)
+    | NewContractReport (ContractReport t)
+    | NewChainEvents [ChainEvent t]
+    | Echo Text
+    | ErrorResponse Text
+    deriving (Show, Eq, Generic)
+    deriving anyclass (FromJSON, ToJSON)
+
+data WebSocketLogMsg
+    = CreatedConnection UUID
+    | ClosedConnection UUID
+
+instance Pretty WebSocketLogMsg where
+    pretty (CreatedConnection uuid) =
+        "Created WebSocket conection:" <+> viaShow uuid
+    pretty (ClosedConnection uuid) =
+        "Closed WebSocket conection:" <+> viaShow uuid
diff --git a/plutus-scb/src/Plutus/SCB/Webserver/WebSocket.hs b/plutus-scb/src/Plutus/SCB/Webserver/WebSocket.hs
new file mode 100644
index 00000000000..5a9ab07fd45
--- /dev/null
+++ b/plutus-scb/src/Plutus/SCB/Webserver/WebSocket.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeOperators       #-}
+
+module Plutus.SCB.Webserver.WebSocket
+    ( handleWS
+    ) where
+
+import           Control.Concurrent.Async      (Async, async, waitAnyCancel)
+import           Control.Exception             (SomeException, handle)
+import           Control.Monad                 (forever, void, when)
+import           Control.Monad.Freer           (Eff, LastMember, Member)
+import           Control.Monad.Freer.Delay     (DelayEffect, delayThread, handleDelayEffect)
+import           Control.Monad.Freer.Extra.Log (LogMsg, logInfo)
+import           Control.Monad.Freer.Reader    (Reader, ask)
+import           Control.Monad.Freer.WebSocket (WebSocketEffect, acceptConnection, receiveJSON, sendJSON)
+import           Control.Monad.IO.Class        (MonadIO, liftIO)
+import           Control.Monad.Logger          (LogLevel (LevelDebug))
+import qualified Data.Text                     as Text
+import           Data.Time.Units               (Second, TimeUnit)
+import           Network.WebSockets.Connection (Connection, PendingConnection, withPingThread)
+import           Plutus.SCB.App                (runApp)
+import           Plutus.SCB.Effects.Contract   (ContractEffect)
+import           Plutus.SCB.Effects.EventLog   (EventLogEffect)
+import           Plutus.SCB.Events             (ChainEvent)
+import           Plutus.SCB.Types              (Config, ContractExe, SCBError)
+import           Plutus.SCB.Webserver.Handler  (getChainReport, getContractReport)
+import           Plutus.SCB.Webserver.Types    (StreamToClient (Echo, ErrorResponse, NewChainReport, NewContractReport),
+                                                StreamToServer (Ping),
+                                                WebSocketLogMsg (ClosedConnection, CreatedConnection))
+import           Wallet.Effects                (ChainIndexEffect)
+
+timeBetweenChainReports :: Second
+timeBetweenChainReports = 10
+
+timeBetweenEvents :: Second
+timeBetweenEvents = 3
+
+------------------------------------------------------------
+-- Message processors.
+------------------------------------------------------------
+chainReportThread ::
+       ( Member ChainIndexEffect effs
+       , Member DelayEffect effs
+       , Member WebSocketEffect effs
+       )
+    => Connection
+    -> Eff effs ()
+chainReportThread connection =
+    pollAndNotifyOnChange timeBetweenChainReports getChainReport notify
+  where
+    notify newReport =
+        sendJSON connection $ NewChainReport @ContractExe newReport
+
+contractStateThread ::
+       ( Member WebSocketEffect effs
+       , Member (EventLogEffect (ChainEvent ContractExe)) effs
+       , Member (ContractEffect ContractExe) effs
+       , Member DelayEffect effs
+       )
+    => Connection
+    -> Eff effs ()
+contractStateThread connection =
+    pollAndNotifyOnChange timeBetweenEvents getContractReport notify
+  where
+    notify newReport =
+        sendJSON connection $ NewContractReport @ContractExe newReport
+
+chatThread :: Member WebSocketEffect effs => Connection -> Eff effs ()
+chatThread connection =
+    forever $ do
+        payload :: Either String (StreamToServer ContractExe) <-
+            receiveJSON connection
+        sendJSON connection $ handleStreamingMessage payload
+
+-- TODO Polling is icky. But we can't use Eventful's hook system
+-- because that relies all events coming in from the same thread. We
+-- can't guarantee that. (eg. We could be running on the server, but
+-- the update came via the CLI.)
+--
+-- Can we use the DB commit hook instead?
+-- https://www.sqlite.org/c3ref/commit_hook.html
+pollAndNotifyOnChange ::
+       (TimeUnit t, Eq a, Member DelayEffect effs)
+    => t
+    -> Eff effs a
+    -> (a -> Eff effs ())
+    -> Eff effs ()
+pollAndNotifyOnChange time query notify = go Nothing
+  where
+    go oldValue = do
+        newValue <- query
+        when (oldValue /= Just newValue) (notify newValue)
+        delayThread time
+        go $ Just newValue
+
+handleStreamingMessage :: Either String (StreamToServer t) -> StreamToClient t
+handleStreamingMessage (Left err)         = ErrorResponse $ Text.pack err
+handleStreamingMessage (Right (Ping msg)) = Echo msg
+
+------------------------------------------------------------
+-- Plumbing
+------------------------------------------------------------
+threadApp :: Config -> Connection -> IO ()
+threadApp config connection = do
+    tasks :: [Async (Either SCBError ())] <-
+        traverse
+            asyncApp
+            [ chainReportThread connection
+            , contractStateThread connection
+            , chatThread connection
+            ]
+    void $ waitAnyCancel tasks
+  where
+    asyncApp = async . runApp LevelDebug config . handleDelayEffect
+
+handleClient :: Config -> Connection -> IO ()
+handleClient config connection =
+    handle disconnect . withPingThread connection 30 (pure ()) $
+    threadApp config connection
+  where
+    disconnect :: SomeException -> IO ()
+    disconnect _ = pure ()
+
+handleWS ::
+       ( LastMember m effs
+       , MonadIO m
+       , Member (LogMsg WebSocketLogMsg) effs
+       , Member (Reader Config) effs
+       , Member WebSocketEffect effs
+       )
+    => PendingConnection
+    -> Eff effs ()
+handleWS pending = do
+    (uuid, connection) <- acceptConnection pending
+    config <- ask
+    logInfo $ CreatedConnection uuid
+    liftIO $ handleClient config connection
+    logInfo $ ClosedConnection uuid
diff --git a/web-common/src/Control/Coroutine/Extra.purs b/web-common/src/Control/Coroutine/Extra.purs
new file mode 100644
index 00000000000..505e2adf54c
--- /dev/null
+++ b/web-common/src/Control/Coroutine/Extra.purs
@@ -0,0 +1,10 @@
+module Control.Coroutine.Extra where
+
+import Control.Coroutine (Consumer)
+import Control.Monad.Free.Trans (interpret)
+import Data.Function ((<<<))
+import Data.Functor (class Functor)
+import Data.Profunctor (lcmap)
+
+mapConsumer :: forall f a b r. Functor f => (a -> b) -> Consumer b f r -> Consumer a f r
+mapConsumer = interpret <<< lcmap
diff --git a/web-common/src/WebSocket/Support.purs b/web-common/src/WebSocket/Support.purs
new file mode 100644
index 00000000000..952e5df727a
--- /dev/null
+++ b/web-common/src/WebSocket/Support.purs
@@ -0,0 +1,103 @@
+module WebSocket.Support where
+
+import Prelude
+import Control.Coroutine (Producer, Consumer)
+import Control.Coroutine as CR
+import Control.Coroutine.Aff (emit, produce)
+import Control.Monad.Except (runExcept)
+import Data.Either (Either)
+import Data.Foldable (for_)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class (class MonadEffect, liftEffect)
+import Foreign (MultipleErrors, F)
+import Foreign.Class (class Decode, class Encode, decode)
+import Foreign.Generic (decodeJSON, encodeJSON)
+import Web.Event.EventTarget (addEventListener, eventListener)
+import Web.HTML as W
+import Web.HTML.Location as WL
+import Web.HTML.Window as WW
+import Web.Socket.Event.EventTypes (onMessage)
+import Web.Socket.Event.MessageEvent as MessageEvent
+import Web.Socket.ReadyState as WSRS
+import Web.Socket.WebSocket (WebSocket)
+import Web.Socket.WebSocket as WS
+
+data Output a
+  = ReceiveMessage (Either MultipleErrors a)
+  | WebSocketClosed
+
+derive instance genericOutput :: Generic (Output a) _
+
+instance showOutput :: Show a => Show (Output a) where
+  show = genericShow
+
+data Input a
+  = SendMessage a
+
+derive instance genericInput :: Generic (Input a) _
+
+instance showInput :: Show a => Show (Input a) where
+  show = genericShow
+
+------------------------------------------------------------
+mkSocket :: String -> Effect WebSocket
+mkSocket uri = do
+  window <- W.window
+  location <- WW.location window
+  protocol <- WL.protocol location
+  hostname <- WL.hostname location
+  port <- WL.port location
+  let
+    wsProtocol = case protocol of
+      "https:" -> "wss"
+      _ -> "ws"
+
+    wsPath = wsProtocol <> "://" <> hostname <> ":" <> port <> uri
+  WS.create wsPath []
+
+------------------------------------------------------------
+wsProducer ::
+  forall a.
+  Decode a =>
+  WebSocket -> Producer (Output a) Aff Unit
+wsProducer socket =
+  produce \emitter -> do
+    listener <-
+      eventListener \ev -> do
+        for_ (MessageEvent.fromEvent ev) \msgEvent ->
+          let
+            decoder :: F a
+            decoder = do
+              str <- decode $ MessageEvent.data_ msgEvent
+              decodeJSON str
+          in
+            emit emitter $ ReceiveMessage $ runExcept decoder
+    addEventListener onMessage listener false (WS.toEventTarget socket)
+
+wsConsumer :: forall m a. Monad m => (a -> m Unit) -> Consumer a m Unit
+wsConsumer query =
+  CR.consumer \msg -> do
+    query msg
+    pure Nothing
+
+wsSender ::
+  forall m a b c r.
+  Encode c =>
+  MonadEffect m =>
+  (Output b -> m a) ->
+  WebSocket -> Consumer (Input c) m r
+wsSender query socket =
+  CR.consumer
+    $ \msg -> do
+        case msg of
+          SendMessage contents -> do
+            state <- liftEffect $ WS.readyState socket
+            if state == WSRS.Open then
+              void $ liftEffect $ WS.sendString socket $ encodeJSON contents
+            else
+              void $ query $ WebSocketClosed
+        pure Nothing