Fix tui recovery (#2201)

<!-- Describe your change here -->

Follow-up on #2159

Fixes #2156

#### Motivation

To fix WS clients trying to recover their state when reconnecting to a
rotated node

#### 🔄 Changes

- Added head state to rotated log event

- Added network info type + projection from network state changed events

- Extended greetings message with network info

#### ⚠️ Unresolved

- To recover pending Increments

> note FIXME! comments

---

<!-- Consider each and tick it off one way or the other -->
* [x] CHANGELOG updated or not needed
* [x] Documentation updated or not needed
* [x] Haddocks updated or not needed
* [x] No new TODOs introduced or explained herafter

Author: ffakenz

CHANGELOG.md

@@ -10,8 +10,8 @@ changes.
 
 ## [0.23.0] - UNRELEASED
 
-- Fix bug where TUI would have out-of-date head status information in the
-  presence of event rotation.
+- Fix bug where TUI would have out-of-date head status information
+  after restarting on a rotated node (due to event rotation).
 
 - Accept additional field `tokens` when depositing to specify different (non-ADA) assets that should be depositted to a Head returning any leftover to the user.
 

hydra-node/golden/Greetings/Greetings.json

@@ -2,24 +2,42 @@
     "samples": [
         {
             "env": {
-                "configuredPeers": "",
+                "configuredPeers": "s",
                 "contestationPeriod": 43200,
-                "depositPeriod": 61129,
+                "depositPeriod": 60080,
                 "otherParties": [],
-                "participants": [
-                    "01000000000001000101000101010101000101000001000000010100"
-                ],
+                "participants": [],
                 "party": {
-                    "vkey": "35719d612496ce0f320cd39e4693a2997194cec954ec602064f67a5c81150136"
+                    "vkey": "348cdf360a866dedf92cb18cfb736c2da212ea44d2f1270fe60dad88801be97c"
                 },
-                "signingKey": "c659b97ce8782bc64476a5e82a14cbd38d0413cb15b18fa87d281b44272fa476"
+                "signingKey": "23db2c1b05cc1c905486253e1a39b0df087217f33180f7d5cf4aa1ec8c0b6634"
             },
             "headStatus": "Closed",
             "hydraHeadId": "01000001000001000000000001000101",
-            "hydraNodeVersion": "",
+            "hydraNodeVersion": "G",
             "me": {
                 "vkey": "3d8fb298d77d2fda814e9530b5539758751d27ad1c234080e04ec2e15dea1490"
             },
+            "networkInfo": {
+                "networkConnected": true,
+                "peersInfo": {
+                    "127.0.0.1:5000": true,
+                    "peer.local:5001": false
+                }
+            },
+            "snapshotUtxo": {
+                "0101010101010001010001010001010101010001010000000100010101010100#30": {
+                    "address": "addr_test1xqqxwuptvt44m42v49ux7l37cy6zg9ylxpr0ltmsnaedfx9frwx7crjjl27pwadu3a4vere9d2cmrm8x2xey5rmzw73sfcqwk4",
+                    "datum": null,
+                    "datumhash": "da0beccb4644ffb9db547cb2c058ee0b27abe96774d43dd85884483b5452b696",
+                    "inlineDatum": null,
+                    "inlineDatumRaw": null,
+                    "referenceScript": null,
+                    "value": {
+                        "lovelace": 45000000000000000
+                    }
+                }
+            },
             "tag": "Greetings"
         }
     ],

hydra-node/golden/ServerOutput/EventLogRotated.json

@@ -872,6 +872,7 @@ components:
         - headStatus
         - hydraNodeVersion
         - env
+        - networkInfo
       properties:
         tag:
           type: string
@@ -1773,13 +1774,16 @@ components:
       required:
         - tag
         - seq
+        - checkpoint
         - timestamp
       properties:
         tag:
           type: string
           enum: ["EventLogRotated"]
         seq:
           $ref: "api.yaml#/components/schemas/SequenceNumber"
+        checkpoint:
+          $ref: "api.yaml#/components/schemas/HeadState"
         timestamp:
           $ref: "api.yaml#/components/schemas/UTCTime"
 
@@ -2985,6 +2989,26 @@ components:
         configuredPeers:
           type: string
 
+    NetworkInfo:
+      type: object
+      description: |
+        L2 Hydra network status information.
+      required:
+      - networkConnected
+      - peersInfo
+      additionalProperties: false
+      properties:
+        networkConnected:
+          type: boolean
+        peersInfo:
+          type: object
+          description: Mapping from peer Host to connection status.
+          additionalProperties:
+            type: boolean
+          example:
+            "127.0.0.1:5000": true
+            "peer.local:5001": false
+
     SequenceNumber:
       type: integer
       minimum: 0

hydra-node/json-schemas/api.yaml

@@ -20,6 +20,7 @@ import Hydra.API.Projection (Projection (..), mkProjection)
 import Hydra.API.ServerOutput (
   ClientMessage,
   CommitInfo (..),
+  NetworkInfo (..),
   ServerOutput (..),
   TimedServerOutput (..),
  )
@@ -105,6 +106,7 @@ withAPIServer config env party eventSource tracer chain pparams serverOutputFilt
     -- CommitInfo etc. would suffice and are less fragile
     commitInfoP <- mkProjection "commitInfoP" CannotCommit projectCommitInfo
     pendingDepositsP <- mkProjection "pendingDepositsP" [] projectPendingDeposits
+    networkInfoP <- mkProjection "networkInfoP" (NetworkInfo False mempty) projectNetworkInfo
     let historyTimedOutputs = sourceEvents .| map mkTimedServerOutputFromStateEvent .| catMaybes
     _ <-
       runConduitRes $
@@ -133,7 +135,7 @@ withAPIServer config env party eventSource tracer chain pparams serverOutputFilt
             . simpleCors
             $ websocketsOr
               defaultConnectionOptions
-              (wsApp env party tracer historyTimedOutputs callback headStateP responseChannel serverOutputFilter)
+              (wsApp env party tracer historyTimedOutputs callback headStateP networkInfoP responseChannel serverOutputFilter)
               ( httpApp
                   tracer
                   chain
@@ -158,6 +160,7 @@ withAPIServer config env party eventSource tracer chain pparams serverOutputFilt
                       update headStateP stateChanged
                       update commitInfoP stateChanged
                       update pendingDepositsP stateChanged
+                      update networkInfoP stateChanged
                     -- Send to the client if it maps to a server output
                     case mkTimedServerOutputFromStateEvent event of
                       Nothing -> pure ()
@@ -216,7 +219,7 @@ setupServerNotification = do
   pure (putMVar mv (), takeMVar mv)
 
 -- | Defines the subset of 'StateEvent' that should be sent as 'TimedServerOutput' to clients.
-mkTimedServerOutputFromStateEvent :: IsTx tx => StateEvent tx -> Maybe (TimedServerOutput tx)
+mkTimedServerOutputFromStateEvent :: IsChainState tx => StateEvent tx -> Maybe (TimedServerOutput tx)
 mkTimedServerOutputFromStateEvent event =
   case mapStateChangedToServerOutput stateChanged of
     Nothing -> Nothing
@@ -261,7 +264,7 @@ mkTimedServerOutputFromStateEvent event =
     StateChanged.ChainRolledBack{} -> Nothing
     StateChanged.TickObserved{} -> Nothing
     StateChanged.LocalStateCleared{..} -> Just SnapshotSideLoaded{..}
-    StateChanged.Checkpoint{} -> Just EventLogRotated
+    StateChanged.Checkpoint{state} -> Just $ EventLogRotated state
 
 -- | Projection to obtain the list of pending deposits.
 projectPendingDeposits :: IsTx tx => [TxIdType tx] -> StateChanged.StateChanged tx -> [TxIdType tx]
@@ -288,3 +291,15 @@ projectCommitInfo commitInfo = \case
   StateChanged.HeadAborted{} -> CannotCommit
   StateChanged.HeadClosed{} -> CannotCommit
   _other -> commitInfo
+
+projectNetworkInfo :: NetworkInfo -> StateChanged.StateChanged tx -> NetworkInfo
+projectNetworkInfo networkInfo = \case
+  StateChanged.NetworkConnected ->
+    networkInfo{networkConnected = True}
+  StateChanged.NetworkDisconnected ->
+    networkInfo{networkConnected = False, peersInfo = mempty}
+  StateChanged.PeerConnected{peer} ->
+    networkInfo{peersInfo = Map.insert peer True (peersInfo networkInfo)}
+  StateChanged.PeerDisconnected{peer} ->
+    networkInfo{peersInfo = Map.insert peer False (peersInfo networkInfo)}
+  _other -> networkInfo

hydra-node/src/Hydra/API/Server.hs

@@ -11,7 +11,7 @@ import Data.Aeson.Lens (atKey, key)
 import Data.ByteString.Lazy qualified as LBS
 import Hydra.API.ClientInput (ClientInput)
 import Hydra.Chain (PostChainTx, PostTxError)
-import Hydra.Chain.ChainState (IsChainState)
+import Hydra.Chain.ChainState (ChainStateType, IsChainState)
 import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), InitialState (..), OpenState (..), SeenSnapshot (..))
 import Hydra.HeadLogic.State qualified as HeadState
 import Hydra.Ledger (ValidationError)
@@ -103,6 +103,7 @@ data Greetings tx = Greetings
   , snapshotUtxo :: Maybe (UTxOType tx)
   , hydraNodeVersion :: String
   , env :: Environment
+  , networkInfo :: NetworkInfo
   }
   deriving (Generic)
 
@@ -212,15 +213,15 @@ data ServerOutput tx
     -- The local state has been reset, meaning pending transactions were pruned.
     -- Any signing round has been discarded, and the snapshot leader has changed accordingly.
     SnapshotSideLoaded {headId :: HeadId, snapshotNumber :: SnapshotNumber}
-  | EventLogRotated
+  | EventLogRotated {checkpoint :: HeadState tx}
   deriving stock (Generic)
 
 deriving stock instance IsChainState tx => Eq (ServerOutput tx)
 deriving stock instance IsChainState tx => Show (ServerOutput tx)
 deriving anyclass instance IsChainState tx => FromJSON (ServerOutput tx)
 deriving anyclass instance IsChainState tx => ToJSON (ServerOutput tx)
 
-instance ArbitraryIsTx tx => Arbitrary (ServerOutput tx) where
+instance (ArbitraryIsTx tx, Arbitrary (ChainStateType tx)) => Arbitrary (ServerOutput tx) where
   arbitrary = genericArbitrary
   shrink = recursivelyShrink
 
@@ -317,6 +318,17 @@ data CommitInfo
   | NormalCommit HeadId
   | IncrementalCommit HeadId
 
+-- | L2 Hydra network status information.
+data NetworkInfo = NetworkInfo
+  { networkConnected :: Bool
+  , peersInfo :: Map Host Bool
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+instance Arbitrary NetworkInfo where
+  arbitrary = genericArbitrary
+
 -- | Get latest confirmed snapshot UTxO from 'HeadState'.
 getSnapshotUtxo :: Monoid (UTxOType tx) => HeadState tx -> Maybe (UTxOType tx)
 getSnapshotUtxo = \case

hydra-node/src/Hydra/API/ServerOutput.hs

@@ -21,6 +21,7 @@ import Hydra.API.ServerOutput (
   Greetings (..),
   HeadStatus (..),
   InvalidInput (..),
+  NetworkInfo,
   ServerOutputConfig (..),
   TimedServerOutput (..),
   WithAddressedTx (..),
@@ -67,11 +68,13 @@ wsApp ::
   (ClientInput tx -> IO ()) ->
   -- | Read model to enhance 'Greetings' messages with 'HeadStatus'.
   Projection STM.STM (StateChanged tx) (HeadState tx) ->
+  -- | Read model to enhance 'Greetings' messages with 'NetworkInfo'.
+  Projection STM.STM (StateChanged tx) NetworkInfo ->
   TChan (Either (TimedServerOutput tx) (ClientMessage tx)) ->
   ServerOutputFilter tx ->
   PendingConnection ->
   IO ()
-wsApp env party tracer history callback headStateP responseChannel ServerOutputFilter{txContainsAddr} pending = do
+wsApp env party tracer history callback headStateP networkInfoP responseChannel ServerOutputFilter{txContainsAddr} pending = do
   traceWith tracer NewAPIConnection
   let path = requestPath $ pendingRequest pending
   queryParams <- uriQuery <$> mkURIBs path
@@ -95,7 +98,8 @@ wsApp env party tracer history callback headStateP responseChannel ServerOutputF
   -- important to make sure the latest configured 'party' is reaching the
   -- client.
   forwardGreetingOnly config con = do
-    headState <- atomically getLatest
+    headState <- atomically getLatestHeadState
+    networkInfo <- atomically getLatestNetworkInfo
     sendTextData con $
       handleUtxoInclusion config (atKey "snapshotUtxo" .~ Nothing) $
         Aeson.encode
@@ -106,9 +110,11 @@ wsApp env party tracer history callback headStateP responseChannel ServerOutputF
             , snapshotUtxo = getSnapshotUtxo headState
             , hydraNodeVersion = showVersion NetworkVersions.hydraNodeVersion
             , env
+            , networkInfo
             }
 
-  Projection{getLatest} = headStateP
+  Projection{getLatest = getLatestHeadState} = headStateP
+  Projection{getLatest = getLatestNetworkInfo} = networkInfoP
 
   mkServerOutputConfig :: [QueryParam] -> ServerOutputConfig
   mkServerOutputConfig qp =

hydra-node/src/Hydra/API/WSServer.hs

@@ -17,8 +17,11 @@ module Hydra.Network (
 import Hydra.Prelude hiding (show)
 
 import Cardano.Ledger.Orphans ()
+import Data.Aeson (FromJSONKeyFunction (FromJSONKeyTextParser), ToJSONKey (..))
+import Data.Aeson.Types (FromJSONKey (..), toJSONKeyText)
 import Data.IP (IP, toIPv4w)
 import Data.Text (pack, unpack)
+import Data.Text qualified as T
 import Hydra.Cardano.Api (Key (SigningKey))
 import Hydra.Tx (Party)
 import Hydra.Tx.Crypto (HydraKey)
@@ -160,6 +163,12 @@ instance Arbitrary Host where
     ip <- toIPv4w <$> arbitrary
     Host (toText $ show ip) <$> arbitrary
 
+instance ToJSONKey Host where
+  toJSONKey = toJSONKeyText (T.pack . show)
+
+instance FromJSONKey Host where
+  fromJSONKey = FromJSONKeyTextParser (readHost . T.unpack)
+
 showHost :: Host -> String
 showHost Host{hostname, port} =
   unpack hostname <> ":" <> show port

hydra-node/src/Hydra/Network.hs

@@ -1299,7 +1299,7 @@ createTestHydraClient outputs messages outputHistory HydraNode{inputQueue, nodeS
     }
 
 createHydraNode ::
-  (IsTx tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m, MonadThrow m) =>
+  (IsChainState tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m, MonadThrow m) =>
   Tracer m (HydraNodeLog tx) ->
   Ledger tx ->
   ChainStateType tx ->