Skip to content

Commit a2eb2ba

Browse files
noonioch1bojmaganffakenz
authored
Update TUI state based on greetings message (#2159)
Fixes #2156 We backported #2087 to update the `Greetings` message to include the hydra environment, which provides the information needed to update the head state when we see it in the websocket from a rotated node. ### Todo - [x] Changelog - [x] Test that after rotate it can see initialising - [x] Re-rewrite `newActiveLink` to not always set into initialising; get the actual head state from somewhere (so it works in opening too) --------- Co-authored-by: Sebastian Nagel <[email protected]> Co-authored-by: Juan Salvador Magán Valero <[email protected]> Co-authored-by: Franco Testagrossa <[email protected]>
1 parent d80e5a5 commit a2eb2ba

File tree

6 files changed

+240
-35
lines changed

6 files changed

+240
-35
lines changed

‎CHANGELOG.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
88
As a minor extension, we also keep a semantic version for the `UNRELEASED`
99
changes.
1010

11+
## [0.23.0] - UNRELEASED
12+
13+
- Fix bug where TUI would have out-of-date head status information in the
14+
presence of event rotation.
15+
1116
## [0.22.4] - 2025-08-05
1217

1318
- Accept additional field `amount` when depositing to specify the amount of Lovelace that should be depositted to a Head returning any leftover to the user.

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -182,6 +182,7 @@ wsApp env party tracer history callback headStateP responseChannel ServerOutputF
182182
WithAddressedTx addr -> txContainsAddr tx addr
183183
WithoutAddressedTx -> True
184184

185+
-- \| Get the content of 'headStatus' field in 'Greetings' message from the full 'HeadState'.
185186
getHeadStatus :: HeadState tx -> HeadStatus
186187
getHeadStatus = \case
187188
HeadState.Idle{} -> Idle

‎hydra-tui/hydra-tui.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,7 @@ test-suite tests
110110
, hydra-tx
111111
, io-classes
112112
, optparse-applicative
113+
, QuickCheck
113114
, regex-tdfa
114115
, unix
115116
, vty

‎hydra-tui/src/Hydra/TUI/Handlers.hs‎

Lines changed: 55 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ import Hydra.TUI.Logging.Types (LogMessage, LogState, LogVerbosity (..), Severit
3737
import Hydra.TUI.Model
3838
import Hydra.TUI.Style (own)
3939
import Hydra.Tx (IsTx (..), Party, Snapshot (..), balance)
40+
import Hydra.Tx.ContestationPeriod qualified as CP
4041
import Lens.Micro.Mtl (use, (%=), (.=))
4142

4243
handleEvent ::
@@ -47,9 +48,10 @@ handleEvent ::
4748
handleEvent cardanoClient client = \case
4849
AppEvent e -> do
4950
handleTick e
51+
now <- use nowL
5052
zoom connectedStateL $ do
5153
handleHydraEventsConnectedState e
52-
zoom connectionL $ handleHydraEventsConnection e
54+
zoom connectionL $ handleHydraEventsConnection now e
5355
zoom (logStateL . logMessagesL) $
5456
handleHydraEventsInfo e
5557
MouseDown{} -> pure ()
@@ -83,25 +85,30 @@ handleHydraEventsConnectedState = \case
8385
ClientDisconnected -> put Disconnected
8486
_ -> pure ()
8587

86-
handleHydraEventsConnection :: HydraEvent Tx -> EventM Name Connection ()
87-
handleHydraEventsConnection = \case
88-
Update (ApiGreetings API.Greetings{me, env = Environment{configuredPeers}}) -> do
88+
handleHydraEventsConnection :: UTCTime -> HydraEvent Tx -> EventM Name Connection ()
89+
handleHydraEventsConnection now = \case
90+
e@(Update (ApiGreetings API.Greetings{me, env = Environment{configuredPeers}})) -> do
8991
meL .= Identified me
90-
let peerStrs = map T.unpack (T.splitOn "," configuredPeers)
91-
let peerAddrs = map (takeWhile (/= '=')) peerStrs
92-
case traverse readHost peerAddrs of
93-
Left err -> do
94-
liftIO $ putStrLn $ "Failed to parse configured peers: " <> err
92+
if T.null configuredPeers
93+
then
9594
peersL .= mempty
96-
Right parsedPeers -> do
97-
existing <- use peersL
98-
let existingMap = Map.fromList existing
99-
updatedMap =
100-
Map.fromList $
101-
[ (p, Map.findWithDefault PeerIsUnknown p existingMap)
102-
| p <- parsedPeers
103-
]
104-
peersL .= Map.toList updatedMap
95+
else do
96+
let peerStrs = map T.unpack (T.splitOn "," configuredPeers)
97+
let peerAddrs = map (takeWhile (/= '=')) peerStrs
98+
case traverse readHost peerAddrs of
99+
Left err -> do
100+
liftIO $ putStrLn $ "Failed to parse configured peers: " <> err
101+
peersL .= mempty
102+
Right parsedPeers -> do
103+
existing <- use peersL
104+
let existingMap = Map.fromList existing
105+
updatedMap =
106+
Map.fromList $
107+
[ (p, Map.findWithDefault PeerIsUnknown p existingMap)
108+
| p <- parsedPeers
109+
]
110+
peersL .= Map.toList updatedMap
111+
zoom headStateL $ handleHydraEventsHeadState now e
105112
Update (ApiTimedServerOutput TimedServerOutput{output = API.PeerConnected p}) ->
106113
peersL %= updatePeerStatus p PeerIsConnected
107114
Update (ApiTimedServerOutput TimedServerOutput{output = API.PeerDisconnected p}) ->
@@ -112,21 +119,47 @@ handleHydraEventsConnection = \case
112119
Update (ApiTimedServerOutput TimedServerOutput{output = API.NetworkDisconnected}) -> do
113120
networkStateL .= Just NetworkDisconnected
114121
peersL %= map (\(h, _) -> (h, PeerIsUnknown))
115-
e -> zoom headStateL $ handleHydraEventsHeadState e
122+
e -> zoom headStateL $ handleHydraEventsHeadState now e
116123
where
117124
updatePeerStatus :: Host -> PeerStatus -> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
118125
updatePeerStatus host status peers =
119126
(host, status) : filter ((/= host) . fst) peers
120127

121-
handleHydraEventsHeadState :: HydraEvent Tx -> EventM Name HeadState ()
122-
handleHydraEventsHeadState e = do
128+
handleHydraEventsHeadState :: UTCTime -> HydraEvent Tx -> EventM Name HeadState ()
129+
handleHydraEventsHeadState now e = do
123130
case e of
124131
Update (ApiTimedServerOutput TimedServerOutput{time, output = API.HeadIsInitializing{parties, headId}}) ->
125-
put $ Active (newActiveLink (toList parties) headId)
132+
put $ Active (newActiveLink (toList parties) headId (initState parties))
133+
-- Note: We only need to use the greetings when there is a headId present.
134+
Update (ApiGreetings API.Greetings{headStatus, hydraHeadId = Just headId, env = Environment{party, otherParties, contestationPeriod}}) -> do
135+
let parties = party : otherParties
136+
case headStatus of
137+
API.Initializing{} ->
138+
put $ Active (newActiveLink (toList parties) headId (initState parties))
139+
API.Open{} ->
140+
put $ Active (newActiveLink (toList parties) headId (Open OpenHome))
141+
API.Closed{} ->
142+
put $ Active (newActiveLink (toList parties) headId (closedState contestationPeriod))
143+
API.FanoutPossible{} ->
144+
put $ Active (newActiveLink (toList parties) headId FanoutPossible)
145+
_ -> put Idle
126146
Update (ApiTimedServerOutput TimedServerOutput{time, output = API.HeadIsAborted{}}) ->
127147
put Idle
128148
_ -> pure ()
129149
zoom activeLinkL $ handleHydraEventsActiveLink e
150+
where
151+
initState parties =
152+
Initializing
153+
{ initializingState =
154+
InitializingState
155+
{ remainingParties = parties
156+
, initializingScreen = InitializingHome
157+
}
158+
}
159+
closedState contestationPeriod =
160+
Closed
161+
{ closedState = ClosedState{contestationDeadline = addUTCTime (CP.toNominalDiffTime contestationPeriod) now}
162+
}
130163

131164
handleHydraEventsActiveLink :: HydraEvent Tx -> EventM Name ActiveLink ()
132165
handleHydraEventsActiveLink e = do

‎hydra-tui/src/Hydra/TUI/Model.hs‎

Lines changed: 3 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -211,18 +211,11 @@ emptyConnection =
211211
, headState = Idle
212212
}
213213

214-
newActiveLink :: [Party] -> HeadId -> ActiveLink
215-
newActiveLink parties headId =
214+
newActiveLink :: [Party] -> HeadId -> ActiveHeadState -> ActiveLink
215+
newActiveLink parties headId headState =
216216
ActiveLink
217217
{ parties
218-
, activeHeadState =
219-
Initializing
220-
{ initializingState =
221-
InitializingState
222-
{ remainingParties = parties
223-
, initializingScreen = InitializingHome
224-
}
225-
}
218+
, activeHeadState = headState
226219
, utxo = mempty
227220
, pendingUTxOToDecommit = mempty
228221
, pendingIncrements = mempty

‎hydra-tui/test/Hydra/TUISpec.hs‎

Lines changed: 175 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,9 @@ import Test.Hydra.Prelude
88

99
import Blaze.ByteString.Builder.Char8 (writeChar)
1010
import CardanoNode (NodeLog, withCardanoNodeDevnet)
11+
import Control.Concurrent.Class.MonadMVar (MonadMVar (..))
1112
import Control.Concurrent.Class.MonadSTM (readTQueue, tryReadTQueue, writeTQueue)
13+
import Control.Monad.Class.MonadAsync (cancel, waitCatch)
1214
import Data.ByteString qualified as BS
1315
import Graphics.Vty (
1416
DisplayContext (..),
@@ -39,16 +41,23 @@ import Hydra.Cluster.Fixture (
3941
aliceSk,
4042
)
4143
import Hydra.Cluster.Util (chainConfigFor, createAndSaveSigningKey, keysFor)
42-
import Hydra.Logging (showLogsOnFailure)
44+
import Hydra.Logging (Tracer, showLogsOnFailure)
4345
import Hydra.Network (Host (..))
44-
import Hydra.Options (DirectOptions (..))
46+
import Hydra.Options (DirectOptions (..), RunOptions, persistenceRotateAfter)
4547
import Hydra.TUI (runWithVty)
4648
import Hydra.TUI.Drawing (renderTime)
4749
import Hydra.TUI.Options (Options (..))
4850
import Hydra.Tx.ContestationPeriod (ContestationPeriod, toNominalDiffTime)
49-
import HydraNode (HydraClient (HydraClient, hydraNodeId), HydraNodeLog, withHydraNode)
51+
import HydraNode (
52+
HydraClient (HydraClient, hydraNodeId),
53+
HydraNodeLog,
54+
prepareHydraNode,
55+
withHydraNode,
56+
withPreparedHydraNode,
57+
)
5058
import System.FilePath ((</>))
5159
import System.Posix (OpenMode (WriteOnly), closeFd, defaultFileFlags, openFd)
60+
import Test.QuickCheck (Positive (..))
5261

5362
tuiContestationPeriod :: ContestationPeriod
5463
tuiContestationPeriod = 10
@@ -63,6 +72,60 @@ spec = do
6372
sendInputEvent $ EvKey (KChar 'q') []
6473
threadDelay 1
6574
shouldNotRender "Connecting"
75+
76+
around setupRotatedStateTUI $ do
77+
fit "tui-rotated starts" $ do
78+
\TUIRotatedTest
79+
{ tuiTest = TUITest{sendInputEvent, shouldRender, shouldNotRender}
80+
, nodeHandle = HydraNodeHandle{restartNode}
81+
} -> do
82+
threadDelay 1
83+
shouldRender "Connected"
84+
shouldRender "Idle"
85+
sendInputEvent $ EvKey (KChar 'i') []
86+
threadDelay 1
87+
shouldRender "Initializing"
88+
restartNode
89+
sendInputEvent $ EvKey (KChar 'h') []
90+
threadDelay 1
91+
shouldNotRender "HeadIsInitializing"
92+
shouldRender "Checkpoint triggered"
93+
sendInputEvent $ EvKey (KChar 's') []
94+
threadDelay 1
95+
shouldRender "Initializing"
96+
shouldRender "Head id"
97+
-- open the head
98+
sendInputEvent $ EvKey (KChar 'c') []
99+
threadDelay 1
100+
shouldRender "42000000 lovelace"
101+
sendInputEvent $ EvKey (KChar '>') []
102+
sendInputEvent $ EvKey (KChar ' ') []
103+
sendInputEvent $ EvKey KEnter []
104+
threadDelay 1
105+
shouldRender "Open"
106+
restartNode
107+
sendInputEvent $ EvKey (KChar 'h') []
108+
threadDelay 1
109+
shouldNotRender "HeadIsOpen"
110+
shouldRender "Checkpoint triggered"
111+
sendInputEvent $ EvKey (KChar 's') []
112+
threadDelay 1
113+
shouldRender "Open"
114+
-- close the head
115+
sendInputEvent $ EvKey (KChar 'c') []
116+
threadDelay 1
117+
sendInputEvent $ EvKey KEnter []
118+
threadDelay 1
119+
shouldRender "Closed"
120+
restartNode
121+
sendInputEvent $ EvKey (KChar 'h') []
122+
threadDelay 1
123+
shouldNotRender "HeadIsClosed"
124+
shouldRender "Checkpoint triggered"
125+
sendInputEvent $ EvKey (KChar 's') []
126+
threadDelay 1
127+
shouldRender "Closed"
128+
66129
around setupNodeAndTUI $ do
67130
it "starts & renders" $
68131
\TUITest{sendInputEvent, shouldRender} -> do
@@ -153,6 +216,115 @@ spec = do
153216
threadDelay 1
154217
shouldRender "Not enough Fuel. Please provide more to the internal wallet and try again."
155218

219+
setupRotatedStateTUI :: (TUIRotatedTest -> IO ()) -> IO ()
220+
setupRotatedStateTUI action = do
221+
showLogsOnFailure "TUISpec" $ \tracer ->
222+
withTempDir "tui-end-to-end" $ \tmpDir -> do
223+
withCardanoNodeDevnet (contramap FromCardano tracer) tmpDir $ \_ backend -> do
224+
hydraScriptsTxId <- publishHydraScriptsAs backend Faucet
225+
chainConfig <- chainConfigFor Alice tmpDir backend hydraScriptsTxId [] tuiContestationPeriod
226+
let nodeId = 1
227+
let externalKeyFilePath = tmpDir </> "external.sk"
228+
externalSKey <- createAndSaveSigningKey externalKeyFilePath
229+
let externalVKey = getVerificationKey externalSKey
230+
seedFromFaucet_ backend externalVKey 42_000_000 (contramap FromFaucet tracer)
231+
(aliceCardanoVk, _) <- keysFor Alice
232+
seedFromFaucet_ backend aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)
233+
options <- prepareHydraNode chainConfig tmpDir nodeId aliceSk [] [nodeId] id
234+
let options' = options{persistenceRotateAfter = Just (Positive 1)}
235+
withTUIRotatedTest (contramap FromHydra tracer) tmpDir nodeId backend externalKeyFilePath options' action
236+
237+
data TUIRotatedTest = TUIRotatedTest
238+
{ tuiTest :: TUITest
239+
, nodeHandle :: HydraNodeHandle
240+
}
241+
242+
data HydraNodeHandle = HydraNodeHandle
243+
{ startNode :: IO ()
244+
, stopNode :: IO ()
245+
, restartNode :: IO ()
246+
, getClient :: IO HydraClient
247+
}
248+
249+
withHydraNodeHandle ::
250+
Tracer IO HydraNodeLog ->
251+
FilePath ->
252+
Int ->
253+
RunOptions ->
254+
(HydraNodeHandle -> IO a) ->
255+
IO a
256+
withHydraNodeHandle tracer tmpDir nodeId options action = do
257+
clientVar <- newEmptyMVar
258+
runningAsyncVar <- newEmptyMVar
259+
let
260+
-- If startNode is called more than once without stopNode,
261+
-- putMVar clientVar will block because it’s already full.
262+
startNode = do
263+
a <- asyncLabelled "hydra-node" $
264+
withPreparedHydraNode tracer tmpDir nodeId options $ \client -> do
265+
putMVar clientVar client
266+
-- keep async alive as long as node is running
267+
forever (threadDelay 1_000_000)
268+
putMVar runningAsyncVar a
269+
270+
stopNode = do
271+
cancelRunningAsync
272+
void $ tryTakeMVar clientVar
273+
274+
cancelRunningAsync =
275+
tryTakeMVar runningAsyncVar >>= mapM_ (\a -> cancel a >> waitCatch a >> pure ())
276+
277+
restartNode = stopNode >> startNode
278+
279+
getClient = readMVar clientVar
280+
281+
bracket
282+
(pure HydraNodeHandle{startNode, stopNode, restartNode, getClient})
283+
(const stopNode)
284+
action
285+
286+
withTUIRotatedTest ::
287+
Tracer IO HydraNodeLog ->
288+
FilePath ->
289+
Int ->
290+
DirectBackend ->
291+
FilePath ->
292+
RunOptions ->
293+
(TUIRotatedTest -> Expectation) ->
294+
Expectation
295+
withTUIRotatedTest tracer tmpDir nodeId backend externalKeyFilePath options' action = do
296+
withHydraNodeHandle tracer tmpDir nodeId options' $ \nodeHandle -> do
297+
startNode nodeHandle
298+
HydraClient{hydraNodeId} <- getClient nodeHandle
299+
withTUITest (150, 10) $ \brickTest@TUITest{buildVty} -> do
300+
raceLabelled_
301+
( "run-vty"
302+
, do
303+
runWithVty
304+
buildVty
305+
Options
306+
{ hydraNodeHost =
307+
Host
308+
{ hostname = "127.0.0.1"
309+
, port = fromIntegral $ 4000 + hydraNodeId
310+
}
311+
, cardanoNodeSocket =
312+
nodeSocket
313+
, cardanoNetworkId =
314+
networkId
315+
, cardanoSigningKey = externalKeyFilePath
316+
}
317+
)
318+
( "action-brick-test"
319+
, action $
320+
TUIRotatedTest
321+
{ tuiTest = brickTest
322+
, nodeHandle
323+
}
324+
)
325+
where
326+
DirectBackend DirectOptions{nodeSocket, networkId} = backend
327+
156328
setupNodeAndTUI' :: Text -> Coin -> (TUITest -> IO ()) -> IO ()
157329
setupNodeAndTUI' hostname lovelace action =
158330
showLogsOnFailure "TUISpec" $ \tracer ->

0 commit comments

Comments
 (0)