More correct handling of user preferences

RaftFable/public/index.html

@@ -33,7 +33,7 @@
         <button class="heartbeat-button" type="button">Heartbeat server</button>
     </form>
     <h3>Clients</h3>
-    <div class="clients"></div>
+    <table class="clients"></table>
     <form>
         <label for="client-server-selection">Server to send to</label>
         <input type="number" id="client-server-selection" class="client-server-selection" />

RaftFable/src/App.fs

@@ -1,5 +1,7 @@
 namespace RaftFable
 
+open System.Collections.Generic
+open System.Security.Cryptography
 open Fable.Core.JS
 open Raft
 open Browser.Dom
@@ -8,69 +10,8 @@ open Fable.Core
 module App =
 
     let clusterSize = 5
-
     let ui = Ui.initialise document
 
-    let handleRegisterClientResponse (response : RegisterClientResponse) : unit = printfn "%O" response
-
-    let handleClientResponse (response : ClientResponse) : unit = printfn "%O" response
-
-    let rec fullyRerender<'a>
-        (parse : string -> Result<'a, string>)
-        (userPrefs : UserPreferences<'a> ref)
-        (cluster : Cluster<'a>)
-        (network : Network<'a>)
-        : Promise<unit>
-        =
-        userPrefs.Value <-
-            Ui.getUserPrefs<'a> parse handleRegisterClientResponse handleClientResponse cluster.ClusterSize ui
-
-        Ui.freezeState cluster network
-        |> Async.StartAsPromise
-        |> fun p ->
-            p.``then`` (fun clusterState ->
-                Ui.render<'a>
-                    (perform<'a> parse userPrefs cluster network)
-                    document
-                    ui
-                    {
-                        UserPreferences = userPrefs.Value
-                        ClusterState = clusterState
-                    }
-            )
-
-    and perform<'a>
-        (parse : string -> Result<'a, string>)
-        (userPrefs : UserPreferences<'a> ref)
-        (cluster : Cluster<'a>)
-        (network : Network<'a>)
-        (action : NetworkAction<'a>)
-        : Promise<unit>
-        =
-        NetworkAction.perform cluster network action
-
-        userPrefs.Value <-
-            { userPrefs.Value with
-                ActionHistory = action :: userPrefs.Value.ActionHistory
-            }
-
-        fullyRerender parse userPrefs cluster network
-
-    let parseByte (s : string) =
-        match System.Byte.TryParse s with
-        | false, _ -> Error (sprintf "Expected byte, got '%s'" s)
-        | true, v -> Ok v
-
-    let userPrefs : UserPreferences<byte> ref =
-        ref (Ui.getUserPrefs parseByte handleRegisterClientResponse handleClientResponse clusterSize ui)
-
-    let mutable cluster, network = InMemoryCluster.make<byte> clusterSize
-
-    let leaderStateButton =
-        document.querySelector ".leader-select-button" :?> Browser.Types.HTMLButtonElement
-
-    leaderStateButton.onclick <- fun _ -> fullyRerender parseByte userPrefs cluster network
-
     let startupActions : NetworkAction<byte> list =
         [
             NetworkAction.InactivityTimeout 0<ServerId>
@@ -103,7 +44,97 @@ module App =
             NetworkAction.NetworkMessage (1<ServerId>, 6)
         ]
 
-    ui.ActionHistory.textContent <- startupActions |> Seq.map NetworkAction.toString |> String.concat "\n"
+    let userPrefs =
+        ref
+            {
+                ActionHistory = startupActions
+                ShowConsumedMessages = false
+                LeaderUnderConsideration = 0<ServerId>
+            }
+
+    Ui.renderPrefs userPrefs.Value ui
+
+    let clients = Dictionary<int<ClientId>, int<ClientSequence> HashSet> ()
+
+    let handleRegisterClientResponse (response : RegisterClientResponse) : unit =
+        lock
+            clients
+            (fun () ->
+                match response with
+                | RegisterClientResponse.Success client ->
+                    if clients.TryAdd (client, HashSet ()) then
+                        ()
+                    else
+                        failwith "got a response a second time - need to handle this in the UI"
+                | RegisterClientResponse.NotLeader hint -> failwith "asked a non-leader, have to handle it"
+            )
+
+    let handleClientResponse (response : ClientResponse) : unit =
+        lock
+            clients
+            (fun () ->
+                match response with
+                | ClientResponse.SessionExpired -> failwith "session expired, have to handle it"
+                | ClientResponse.NotLeader hint -> failwith "asked a non-leader, have to handle it"
+                | ClientResponse.Success (client, sequence) ->
+                    match clients.TryGetValue client with
+                    | false, _ ->
+                        failwithf "Logic error: committed a client request for a non-existent client %i" client
+                    | true, v -> v.Add sequence |> ignore
+            )
+
+    let rec fullyRerender<'a>
+        (parse : string -> Result<'a, string>)
+        (userPrefs : UserPreferences<'a> ref)
+        (cluster : Cluster<'a>)
+        (network : Network<'a>)
+        : Promise<unit>
+        =
+        Ui.freezeState cluster network
+        |> Async.StartAsPromise
+        |> fun p ->
+            p.``then`` (fun clusterState ->
+                Ui.render<'a>
+                    (perform<'a> parse userPrefs cluster network)
+                    document
+                    ui
+                    {
+                        UserPreferences = userPrefs.Value
+                        ClusterState = clusterState
+                        Clients = clients :> IReadOnlyDictionary<_, _>
+                    }
+
+                Ui.renderPrefs userPrefs.Value ui
+            )
+
+    and perform<'a>
+        (parse : string -> Result<'a, string>)
+        (userPrefs : UserPreferences<'a> ref)
+        (cluster : Cluster<'a>)
+        (network : Network<'a>)
+        (action : NetworkAction<'a>)
+        : Promise<unit>
+        =
+        NetworkAction.perform cluster network action
+
+        userPrefs.Value <-
+            { userPrefs.Value with
+                ActionHistory = userPrefs.Value.ActionHistory @ [ action ]
+            }
+
+        fullyRerender parse userPrefs cluster network
+
+    let parseByte (s : string) =
+        match System.Byte.TryParse s with
+        | false, _ -> Error (sprintf "Expected byte, got '%s'" s)
+        | true, v -> Ok v
+
+    let mutable cluster, network = InMemoryCluster.make<byte> clusterSize
+
+    let leaderStateButton =
+        document.querySelector ".leader-select-button" :?> Browser.Types.HTMLButtonElement
+
+    leaderStateButton.onclick <- fun _ -> fullyRerender parseByte userPrefs cluster network
 
     let reloadActions () =
         let newCluster, newNetwork = InMemoryCluster.make<byte> clusterSize
@@ -183,4 +214,7 @@ module App =
             NetworkAction.ClientRequest (server, ClientRequest.RegisterClient handleRegisterClientResponse)
             |> perform parseByte userPrefs cluster network
 
-    ui.ShowConsumedMessages.onchange <- fun _event -> fullyRerender parseByte userPrefs cluster network
+    ui.ShowConsumedMessages.onchange <-
+        fun _event ->
+            printfn "rerendering"
+            fullyRerender parseByte userPrefs cluster network

RaftFable/src/Ui.fs

@@ -1,5 +1,6 @@
 namespace RaftFable
 
+open System.Collections.Generic
 open Raft
 
 type ClusterState<'a> =
@@ -22,6 +23,8 @@ type UiBackingState<'a> =
     {
         ClusterState : ClusterState<'a>
         UserPreferences : UserPreferences<'a>
+        /// TODO - make this be IReadOnlySet, not HashSet
+        Clients : IReadOnlyDictionary<int<ClientId>, int<ClientSequence> HashSet>
     }
 
 type ClientDataSection =
@@ -43,8 +46,8 @@ type UiElements =
         HeartbeatField : Browser.Types.HTMLInputElement
         SelectedLeaderId : Browser.Types.HTMLInputElement
         ShowConsumedMessages : Browser.Types.HTMLInputElement
-        ActionHistory : Browser.Types.HTMLTextAreaElement
+        ActionHistoryList : Browser.Types.HTMLTextAreaElement
-        ClientsList : Browser.Types.HTMLDivElement
+        ClientsList : Browser.Types.HTMLTableElement
         ClientData : ClientDataSection
         ClientCreateServer : Browser.Types.HTMLInputElement
     }
@@ -57,7 +60,7 @@ type RequiresPopulation =
 [<RequireQualifiedAccess>]
 module Ui =
 
-    let initialise (document : Browser.Types.Document) : UiElements =
+    let initialise<'a> (document : Browser.Types.Document) : UiElements =
         let serverStatuses =
             document.querySelector ".server-statuses" :?> Browser.Types.HTMLTableElement
 
@@ -96,7 +99,8 @@ module Ui =
         let actionHistory =
             document.querySelector ".action-history" :?> Browser.Types.HTMLTextAreaElement
 
-        let clientsList = document.querySelector ".clients" :?> Browser.Types.HTMLDivElement
+        let clientsList =
+            document.querySelector ".clients" :?> Browser.Types.HTMLTableElement
 
         let clientCreateServer =
             document.querySelector ".create-client-server" :?> Browser.Types.HTMLInputElement
@@ -119,7 +123,7 @@ module Ui =
             HeartbeatField = heartbeatField
             SelectedLeaderId = selectedLeaderId
             ShowConsumedMessages = showConsumed
-            ActionHistory = actionHistory
+            ActionHistoryList = actionHistory
             ClientsList = clientsList
             ClientData = clientInfo
             ClientCreateServer = clientCreateServer
@@ -184,12 +188,21 @@ module Ui =
 
         ui.ShowConsumedMessages.defaultChecked <- false
 
+        ui.ClientsList.border <- "1px"
         ui.ClientsList.innerText <- ""
 
         {
             ServerStatusNodes = serverStatusNodes
         }
 
+    let renderPrefs<'a> (prefs : UserPreferences<'a>) (ui : UiElements) : unit =
+
+        // Action list
+        let actionList =
+            prefs.ActionHistory |> Seq.map NetworkAction.toString |> String.concat "\n"
+
+        ui.ActionHistoryList.textContent <- actionList
+
     let render<'a>
         (perform : NetworkAction<'a> -> Fable.Core.JS.Promise<unit>)
         (document : Browser.Types.Document)
@@ -198,13 +211,11 @@ module Ui =
         : unit
         =
         let userPrefs = state.UserPreferences
-        let state = state.ClusterState
+        let requiresPopulation = reset state.ClusterState.ClusterSize ui
-
-        let requiresPopulation = reset state.ClusterSize ui
 
         let rows =
             List.init
-                state.ClusterSize
+                state.ClusterState.ClusterSize
                 (fun i ->
                     let cell = document.createElement "th" :?> Browser.Types.HTMLTableCellElement
                     cell.textContent <- sprintf "Server %i" i
@@ -213,7 +224,7 @@ module Ui =
 
         rows
         |> List.iteri (fun i row ->
-            let state = state.InternalState.[i]
+            let state = state.ClusterState.InternalState.[i]
 
             for logEntry in state.Log do
                 let cell = document.createElement "td" :?> Browser.Types.HTMLTableCellElement
@@ -225,18 +236,18 @@ module Ui =
                 row.appendChild cell |> ignore
         )
 
-        for i in 0 .. state.ClusterSize - 1 do
+        for i in 0 .. state.ClusterState.ClusterSize - 1 do
-            let status = state.Statuses.[i]
+            let status = state.ClusterState.Statuses.[i]
             requiresPopulation.ServerStatusNodes.[i].textContent <- status |> string<ServerStatus>
 
         // Network status
         let allButtons =
-            [ 0 .. state.ClusterSize - 1 ]
+            [ 0 .. state.ClusterState.ClusterSize - 1 ]
             |> List.map (fun i ->
                 if userPrefs.ShowConsumedMessages then
-                    state.AllMessages.[i] |> List.indexed
+                    state.ClusterState.AllMessages.[i] |> List.indexed
                 else
-                    state.UndeliveredMessages.[i]
+                    state.ClusterState.UndeliveredMessages.[i]
                 |> List.map (fun (messageId, message) ->
                     Button.create
                         document
@@ -267,7 +278,7 @@ module Ui =
         leaderIdBox.innerText <- sprintf "%i" userPrefs.LeaderUnderConsideration
 
         let leaderState =
-            state.InternalState.[userPrefs.LeaderUnderConsideration / 1<ServerId>]
+            state.ClusterState.InternalState.[userPrefs.LeaderUnderConsideration / 1<ServerId>]
 
         match leaderState.LeaderState with
         | None -> leaderIdBox.innerText <- sprintf "%i: not a leader" userPrefs.LeaderUnderConsideration
@@ -313,6 +324,26 @@ module Ui =
 
         Table.createRow document nextToSend ui.LeaderStateTable |> ignore
 
+        Table.createHeaderRow document [ "Client ID" ; "Successful requests" ] ui.ClientsList
+        // Clients
+        for KeyValue (clientId, committed) in state.Clients do
+            let clientNode =
+                let node = document.createElement "div"
+                node.innerText <- sprintf "%i" clientId
+                node
+
+            let messagesNode =
+                let node = document.createElement "div"
+                let text = committed |> Seq.map (sprintf "%i") |> String.concat ","
+
+                node.innerText <- text
+                node
+
+            printfn "hi!"
+
+            Table.createRow document [ Some clientNode ; Some messagesNode ] ui.ClientsList
+            |> ignore
+
     let freezeState<'a> (cluster : Cluster<'a>) (network : Network<'a>) : ClusterState<'a> Async =
         let internalState =
             let states = Array.zeroCreate<ServerInternalState<'a>> cluster.ClusterSize
@@ -376,7 +407,7 @@ module Ui =
             ShowConsumedMessages = ui.ShowConsumedMessages.``checked``
             ActionHistory =
                 // TODO write these back out again, and give a button to Load
-                ui.ActionHistory.textContent.Split "\n"
+                ui.ActionHistoryList.textContent.Split "\n"
                 |> Seq.filter (not << System.String.IsNullOrEmpty)
                 |> Seq.map (
                     NetworkAction.tryParse<'a>