diff --git a/frontend/src/Riptide/App.purs b/frontend/src/Riptide/App.purs index da7dc85..6307ff6 100644 --- a/frontend/src/Riptide/App.purs +++ b/frontend/src/Riptide/App.purs @@ -1,5 +1,7 @@ module Riptide.App - ( component + ( commandsForSocketOpen + , component + , sessionFromApp ) where import Prelude @@ -13,7 +15,7 @@ import Effect.Aff.Class (class MonadAff) import Halogen as H import Riptide.Action (ControlKey) import Riptide.ImportExport as ImportExport -import Riptide.Model (App, Block, BlockId, CellId, ConnectionState(..), DropTarget, Page(..), Song, SongId, Toolbox, ToolboxId, Track, TrackId, canUseBackend) +import Riptide.Model (App, Block, BlockId, Cell, CellId, ConnectionState(..), DropTarget, Page(..), Song, SongId, Toolbox, ToolboxId, Track, TrackId, canUseBackend, totalBars) import Riptide.Protocol.Client as Protocol import Riptide.Reducer as Reducer import Riptide.Validation (authoritativeValidation) @@ -576,8 +578,10 @@ handleSocketEvent :: forall output m. MonadAff m => H.SubscriptionId -> WebSocke handleSocketEvent subscriptionId = case _ of WebSocket.WebSocketReady socket -> H.modify_ (Reducer.setWebSocket (Just socket)) - WebSocket.WebSocketOpened -> + WebSocket.WebSocketOpened -> do H.modify_ (Reducer.setConnection Connected) + app <- H.get + traverse_ sendWhenConnected (commandsForSocketOpen app) WebSocket.WebSocketClosed -> do H.unsubscribe subscriptionId H.modify_ (Reducer.setWebSocket Nothing <<< Reducer.setConnection Disconnected) @@ -612,6 +616,42 @@ sendWhenConnected command = do _ -> pure unit +commandsForSocketOpen :: App -> Array Protocol.ClientCommand +commandsForSocketOpen app = + [ Protocol.SetSession (sessionFromApp app) ] + +sessionFromApp :: App -> Protocol.Session +sessionFromApp app = + { sessionSlotCapacity: totalBars + , sessionTracks: + Array.mapWithIndex trackFromApp (currentTracks app) + , sessionDefinitions: blockFromApp <$> currentBlocks app + } + +trackFromApp :: Int -> Track -> Protocol.Track +trackFromApp index track = + { trackId: track.id + , trackName: track.name + , trackSlot: index + 1 + , trackTexts: textFromApp <$> track.cells + , trackActiveText: track.active + , trackSelectedText: track.selected + } + +textFromApp :: Cell -> Protocol.TrackText +textFromApp cell = + { trackTextId: cell.id + , trackTextSource: cell.code + } + +blockFromApp :: Block -> Protocol.Block +blockFromApp block = + { blockId: block.id + , blockName: block.name + , blockCode: block.code + , blockApplied: block.applied + } + sendPlaybackTransitions :: forall output m. MonadAff m => App -> App -> H.HalogenM App Action () output m Unit sendPlaybackTransitions before after = traverse_ sendWhenConnected diff --git a/frontend/src/Riptide/Protocol/Client.purs b/frontend/src/Riptide/Protocol/Client.purs index bc90a62..2871ca2 100644 --- a/frontend/src/Riptide/Protocol/Client.purs +++ b/frontend/src/Riptide/Protocol/Client.purs @@ -20,7 +20,8 @@ import Data.Argonaut.Core (Json, fromString, stringify) import Data.Argonaut.Decode (class DecodeJson, JsonDecodeError(..), decodeJson, fromJsonString, printJsonDecodeError, (.:)) import Data.Argonaut.Encode (class EncodeJson, encodeJson) import Data.Either (Either(..)) -import Data.Maybe (Maybe) +import Data.Maybe (Maybe(..)) +import Data.String.Common as String import Foreign.Object (Object) type TrackId = String @@ -56,6 +57,7 @@ type Session = data ClientCommand = ValidateText String + | SetSession Session | ActivateTrackText TrackId CellId | SilenceTrack TrackId | SaveTrackText TrackId CellId String @@ -67,6 +69,7 @@ derive instance eqClientCommand :: Eq ClientCommand instance showClientCommand :: Show ClientCommand where show = case _ of ValidateText text -> "(ValidateText " <> show text <> ")" + SetSession session -> "(SetSession " <> show session <> ")" ActivateTrackText trackId cellId -> "(ActivateTrackText " <> show trackId <> " " <> show cellId <> ")" SilenceTrack trackId -> "(SilenceTrack " <> show trackId <> ")" SaveTrackText trackId cellId text -> "(SaveTrackText " <> show trackId <> " " <> show cellId <> " " <> show text <> ")" @@ -80,6 +83,11 @@ encodeClientCommand = case _ of [ field "type" "validateText" , field "text" text ] + SetSession session -> + object + [ field "type" "setSession" + , fieldJson "session" (sessionJson session) + ] ActivateTrackText trackId cellId -> object [ field "type" "activateTrackText" @@ -124,6 +132,8 @@ instance decodeJsonClientCommand :: DecodeJson ClientCommand where case commandType of "validateText" -> ValidateText <$> value .: "text" + "setSession" -> + SetSession <$> value .: "session" "activateTrackText" -> ActivateTrackText <$> value .: "trackId" <*> value .: "textId" "silenceTrack" -> @@ -202,18 +212,63 @@ field :: String -> String -> String field key value = quote key <> ":" <> quote value +fieldJson :: String -> String -> String +fieldJson key value = + quote key <> ":" <> value + object :: Array String -> String object fields = "{" <> joinWithComma fields <> "}" +sessionJson :: Session -> String +sessionJson session = + object + [ fieldJson "sessionSlotCapacity" (show session.sessionSlotCapacity) + , fieldJson "sessionTracks" (arrayJson trackJson session.sessionTracks) + , fieldJson "sessionDefinitions" (arrayJson blockJson session.sessionDefinitions) + ] + +trackJson :: Track -> String +trackJson track = + object + [ field "trackId" track.trackId + , field "trackName" track.trackName + , fieldJson "trackSlot" (show track.trackSlot) + , fieldJson "trackTexts" (arrayJson trackTextJson track.trackTexts) + , fieldJson "trackActiveText" (maybeStringJson track.trackActiveText) + , fieldJson "trackSelectedText" (maybeStringJson track.trackSelectedText) + ] + +trackTextJson :: TrackText -> String +trackTextJson text = + object + [ field "trackTextId" text.trackTextId + , field "trackTextSource" text.trackTextSource + ] + +blockJson :: Block -> String +blockJson block = + object + [ field "blockId" block.blockId + , field "blockName" block.blockName + , field "blockCode" block.blockCode + , field "blockApplied" block.blockApplied + ] + +arrayJson :: forall a. (a -> String) -> Array a -> String +arrayJson encode = + case _ of + [] -> "[]" + values -> "[" <> joinWithComma (map encode values) <> "]" + +maybeStringJson :: Maybe String -> String +maybeStringJson = case _ of + Just value -> quote value + Nothing -> "null" + joinWithComma :: Array String -> String -joinWithComma = case _ of - [] -> "" - [ one ] -> one - [ one, two ] -> one <> "," <> two - [ one, two, three ] -> one <> "," <> two <> "," <> three - [ one, two, three, four ] -> one <> "," <> two <> "," <> three <> "," <> four - fields -> stringify (encodeJson fields) +joinWithComma = + String.joinWith "," quote :: String -> String quote = diff --git a/frontend/test/Main.purs b/frontend/test/Main.purs index 33df004..0a34d7f 100644 --- a/frontend/test/Main.purs +++ b/frontend/test/Main.purs @@ -11,6 +11,7 @@ import Data.Number as Number import Effect (Effect) import Effect.Aff (launchAff_) import Riptide.Action (ControlKey(..)) +import Riptide.App as App import Riptide.Helpers (cascade, collectIds, definedNames, duplicateIds, effectiveSelected, normalizeScore) import Riptide.Model (Cell, Song, Track, totalBars) import Riptide.Model as Model @@ -75,6 +76,8 @@ main = it "encodes client commands with backend tags and field names" do Protocol.encodeClientCommand (Protocol.ValidateText "d1 $ sound \"bd\"") `shouldEqual` "{\"type\":\"validateText\",\"text\":\"d1 $ sound \\\"bd\\\"\"}" + Protocol.encodeClientCommand (Protocol.SetSession sampleProtocolSession) `shouldEqual` + "{\"type\":\"setSession\",\"session\":{\"sessionSlotCapacity\":16,\"sessionTracks\":[{\"trackId\":\"t1\",\"trackName\":\"drums\",\"trackSlot\":1,\"trackTexts\":[{\"trackTextId\":\"c1\",\"trackTextSource\":\"d1 $ sound \\\"bd\\\"\"},{\"trackTextId\":\"c2\",\"trackTextSource\":\"d1 $ sound \\\"cp\\\"\"}],\"trackActiveText\":\"c1\",\"trackSelectedText\":\"c2\"}],\"sessionDefinitions\":[{\"blockId\":\"b1\",\"blockName\":\"feel\",\"blockCode\":\"feel = (# room 0.4)\",\"blockApplied\":\"feel = (# room 0.35)\"}]}}" Protocol.encodeClientCommand (Protocol.ActivateTrackText "track-a" "cell-1") `shouldEqual` "{\"type\":\"activateTrackText\",\"trackId\":\"track-a\",\"textId\":\"cell-1\"}" Protocol.encodeClientCommand (Protocol.SilenceTrack "track-a") `shouldEqual` @@ -121,6 +124,10 @@ main = Protocol.decodeServerEvent "{\"type\":\"commandFailed\",\"failure\":{\"command\":{\"type\":\"silenceTrack\",\"trackId\":\"track-a\"},\"message\":\"track not found\"}}" `shouldEqual` Right (Protocol.CommandFailed { command: Protocol.SilenceTrack "track-a", message: "track not found" }) + it "prepares the full current editor state as the first open command" do + App.commandsForSocketOpen appWithSongAndToolbox `shouldEqual` + [ Protocol.SetSession sampleProtocolSession ] + describe "definition names" do it "parses optional let bindings only at line starts" do definedNames "feel = (# room 0.4)\n let swing_2 = nudge 0.01\nx feel = ignored\n_kit = sound \"bd\"" `shouldEqual` @@ -553,6 +560,64 @@ appWithToolbox = , currentToolboxId = Just "tbx1" } +appWithSongAndToolbox :: Model.App +appWithSongAndToolbox = + Model.defaultApp + { songs = + [ { id: "s-open" + , name: "open song" + , tracks: + [ ( track "t1" "drums" + [ cell "c1" "d1 $ sound \"bd\"" + , cell "c2" "d1 $ sound \"cp\"" + ] + ) + { active = Just "c1" + , selected = Just "c2" + } + ] + } + ] + , currentSongId = Just "s-open" + , toolboxes = + [ { id: "tb-open" + , name: "open defs" + , blocks: + [ { id: "b1" + , name: "feel" + , code: "feel = (# room 0.4)" + , applied: "feel = (# room 0.35)" + } + ] + } + ] + , currentToolboxId = Just "tb-open" + } + +sampleProtocolSession :: Protocol.Session +sampleProtocolSession = + { sessionSlotCapacity: Model.totalBars + , sessionTracks: + [ { trackId: "t1" + , trackName: "drums" + , trackSlot: 1 + , trackTexts: + [ { trackTextId: "c1", trackTextSource: "d1 $ sound \"bd\"" } + , { trackTextId: "c2", trackTextSource: "d1 $ sound \"cp\"" } + ] + , trackActiveText: Just "c1" + , trackSelectedText: Just "c2" + } + ] + , sessionDefinitions: + [ { blockId: "b1" + , blockName: "feel" + , blockCode: "feel = (# room 0.4)" + , blockApplied: "feel = (# room 0.35)" + } + ] + } + sampleSong :: Song sampleSong = { id: "s1" diff --git a/specs/031-state-reconcile/plan.md b/specs/031-state-reconcile/plan.md new file mode 100644 index 0000000..059d910 --- /dev/null +++ b/specs/031-state-reconcile/plan.md @@ -0,0 +1,67 @@ +# Plan: Client State Reconcile On Connect + +## Context + +The backend websocket sends a server snapshot immediately after accept, then +processes commands. The frontend ignores that snapshot and continues from +`seedApp`. On a fresh server store, playback transitions can reference client +track ids such as `t2` before the server has any corresponding tracks. + +The chosen direction is client-as-editor/source-of-truth. The client pushes its +current editable state to the server on websocket open. + +## Wire Shape + +Add a `ClientCommand` constructor: + +```text +SetSession Session +``` + +JSON: + +```json +{ + "type": "setSession", + "session": { + "sessionSlotCapacity": 16, + "sessionTracks": [], + "sessionDefinitions": [] + } +} +``` + +Server handling preserves its configured `sessionSlotCapacity` and replaces only +`sessionTracks` and `sessionDefinitions` from the payload before calling +`saveSession`. + +## Slice 1: Backend Protocol And Handler + +Owned files: + +- `src/Riptide/Protocol.hs` +- `src/Riptide/Server.hs` +- `test/Riptide/ProtocolSpec.hs` +- `test/Riptide/ServerSpec.hs` + +Add the command, JSON round-trip coverage, and server persistence test. Do not +edit `Session.hs`, `Store.hs`, `Eval.hs`, or `Playback.hs`. + +## Slice 2: Frontend Command And Connect Handshake + +Owned files: + +- `frontend/src/Riptide/Protocol/Client.purs` +- `frontend/src/Riptide/App.purs` +- `frontend/test/Main.purs` + +Add the PureScript command, encoder/decoder support, app-to-session mapping, +and send it on `WebSocketOpened` before any connected playback command path can +run. Tests should assert the encoded JSON shape and that connect-open commands +start with `SetSession`. + +## Verification + +Run `./gate.sh` at the end of each slice. After the final slice, also run a +fresh `riptide serve` smoke when practical and confirm no `CommandFailed` text +appears in the served UI. diff --git a/specs/031-state-reconcile/spec.md b/specs/031-state-reconcile/spec.md new file mode 100644 index 0000000..0c89626 --- /dev/null +++ b/specs/031-state-reconcile/spec.md @@ -0,0 +1,34 @@ +# Specification: Client State Reconcile On Connect + +## User Story + +When a performer opens the served riptide UI, the server session must mirror the +editor state that the client boots with before any playback command is sent. +Fresh page load must not surface `PlaybackTrackMissing` for tracks that exist in +the UI seed but not yet in the server store. + +## Functional Requirements + +- Add a client-to-server command that carries the client's current tracks and + definitions as one state payload. +- On receipt, the server replaces its session tracks and definitions with the + payload, preserves the server-configured slot capacity, persists both stores, + and broadcasts a state snapshot. +- On every websocket connect or reconnect, the frontend sends the state command + before any activate or silence command can be emitted from the connected + session. +- The command JSON shape is stable across Haskell and PureScript encoders and + decoders. +- Existing validation, save, apply, activate, and silence behavior remains + unchanged. + +## Success Criteria + +- Backend protocol round-trip tests cover the new command. +- Backend server tests prove the command replaces tracks and definitions and + writes both stores. +- Frontend tests cover the new command encoding and the connect-handshake command + order. +- `./gate.sh` passes, including frontend render smoke. +- Opening a served UI against an empty state directory does not show a + `Command failed: PlaybackTrackMissing ...` toast/banner on fresh connect. diff --git a/specs/031-state-reconcile/tasks.md b/specs/031-state-reconcile/tasks.md new file mode 100644 index 0000000..235a00d --- /dev/null +++ b/specs/031-state-reconcile/tasks.md @@ -0,0 +1,27 @@ +# Tasks: Client State Reconcile On Connect + +## Slice 1 - Backend Protocol And Handler + +- [X] T031-S1 Add `SetSession` command JSON support in `src/Riptide/Protocol.hs`. +- [X] T031-S1 Handle the command in `src/Riptide/Server.hs` by replacing tracks + and definitions, preserving slot capacity, persisting via `saveSession`, and + broadcasting a snapshot. +- [X] T031-S1 Add backend tests for protocol round-trip and server persistence. +- [X] T031-S1 Run focused backend tests and `./gate.sh`. +- [X] T031-S1 Commit as `fix(backend): reconcile client session state`. + +## Slice 2 - Frontend Handshake + +- [X] T031-S2 Add PureScript protocol support for the state command and exact + JSON encoding. +- [X] T031-S2 Send the current app tracks and definitions on websocket open + before connected playback transitions. +- [X] T031-S2 Add frontend tests for command encoding and connect-handshake + ordering. +- [X] T031-S2 Run focused frontend tests and `./gate.sh`. +- [X] T031-S2 Commit as `fix(frontend): push state on websocket connect`. + +## Finalization + +- [X] T031-F1 Verify the full gate at HEAD. +- [ ] T031-F1 Open a draft PR against `main` and confirm PR CI reports 4/4 green. diff --git a/src/Riptide/Protocol.hs b/src/Riptide/Protocol.hs index bdf9e31..09370f2 100644 --- a/src/Riptide/Protocol.hs +++ b/src/Riptide/Protocol.hs @@ -33,6 +33,7 @@ import Riptide.Session data ClientCommand = ValidateText Text + | SetSession Session | ActivateTrackText TrackId TextId | SilenceTrack TrackId | SaveTrackText TrackId TextId Text @@ -46,6 +47,10 @@ instance ToJSON ClientCommand where tagged "validateText" ["text" .= source] + SetSession session -> + tagged + "setSession" + ["session" .= session] ActivateTrackText track text -> tagged "activateTrackText" @@ -82,6 +87,9 @@ instance FromJSON ClientCommand where "validateText" -> ValidateText <$> value .: "text" + "setSession" -> + SetSession + <$> value .: "session" "activateTrackText" -> ActivateTrackText <$> value .: "trackId" diff --git a/src/Riptide/Server.hs b/src/Riptide/Server.hs index 911d6e1..f486056 100644 --- a/src/Riptide/Server.hs +++ b/src/Riptide/Server.hs @@ -81,6 +81,7 @@ import Riptide.Session import Riptide.Store ( loadSession , saveDefinitions + , saveSession , saveTracks ) import System.Environment (lookupEnv) @@ -182,6 +183,16 @@ handleClientCommand server command = case command of ValidateText source -> validateText server source + SetSession clientSession -> + stateCommand server command $ \session -> do + let updated = + session + { sessionTracks = sessionTracks clientSession + , sessionDefinitions = + sessionDefinitions clientSession + } + saveSession (serverStateDir server) updated + pure $ commandSucceeded updated ActivateTrackText trackIdent textIdent -> stateCommand server command $ \session -> do let candidate = activateTrackText trackIdent textIdent session diff --git a/test/Riptide/ProtocolSpec.hs b/test/Riptide/ProtocolSpec.hs index 82d7f26..82971f6 100644 --- a/test/Riptide/ProtocolSpec.hs +++ b/test/Riptide/ProtocolSpec.hs @@ -47,10 +47,12 @@ genClientCommand = do track <- genTrackId text <- genTextId definition <- genDefinitionId + session <- genSession source <- genSourceText name <- genNameText elements [ ValidateText source + , SetSession session , ActivateTrackText track text , SilenceTrack track , SaveTrackText track text source diff --git a/test/Riptide/ServerSpec.hs b/test/Riptide/ServerSpec.hs index fe9505c..5608e8b 100644 --- a/test/Riptide/ServerSpec.hs +++ b/test/Riptide/ServerSpec.hs @@ -166,6 +166,21 @@ spec = do sourceFor trackA textA session{sessionTracks = loaded} `shouldBe` Just "sound \"sn\"" + it "replaces session tracks and definitions from the client" $ + withServer sessionWithCapacity $ \server _ stateDir -> do + events <- handleClientCommand server $ SetSession clientSession + + session <- currentSession server + sessionSlotCapacity session `shouldBe` 8 + sessionTracks session `shouldBe` sessionTracks clientSession + sessionDefinitions session `shouldBe` sessionDefinitions clientSession + events `shouldBe` [StateSnapshot session] + + loadedTracks <- loadTracks stateDir + loadedDefinitions <- loadDefinitions stateDir + loadedTracks `shouldBe` sessionTracks clientSession + loadedDefinitions `shouldBe` sessionDefinitions clientSession + it "saves and applies definitions and persists definitions" $ withServer trackSession $ \server _ stateDir -> do saveEvents <- @@ -261,6 +276,39 @@ sessionWithAppliedDefinition = & addDefinitionBlock defsA "shared" "let kick = sound \"bd\"" & applyDefinitionBlock defsA +sessionWithCapacity :: Session +sessionWithCapacity = + emptySession 8 + +clientSession :: Session +clientSession = + Session + { sessionSlotCapacity = 2 + , sessionTracks = + [ Track + { trackId = trackA + , trackName = "client track" + , trackSlot = Slot 3 + , trackTexts = + [ TrackText + { trackTextId = textA + , trackTextSource = "sound \"bd\"" + } + ] + , trackActiveText = Just textA + , trackSelectedText = Just textA + } + ] + , sessionDefinitions = + [ DefinitionBlock + { blockId = defsA + , blockName = "client defs" + , blockCode = "let kick = sound \"bd\"" + , blockApplied = "let kick = sound \"bd\"" + } + ] + } + findTrack :: TrackId -> Session -> Maybe Track findTrack ident session = find ((== ident) . trackId) (sessionTracks session)