Rerender on every tick
This commit is contained in:
Smaug123
@@ -6,7 +6,6 @@
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
</head>
|
||||
<body>
|
||||
<p class="startup-text">Starting up...</p>
|
||||
<h2>Status of each server</h2>
|
||||
<table class="server-statuses">
|
||||
</table>
|
||||
|
||||
@@ -9,191 +9,35 @@ module App =
|
||||
|
||||
let clusterSize = 5
|
||||
|
||||
let serverStatuses =
|
||||
document.querySelector ".server-statuses" :?> Browser.Types.HTMLTableElement
|
||||
let ui = Ui.initialise document clusterSize
|
||||
|
||||
serverStatuses.border <- "1px"
|
||||
Table.createHeaderRow document [ "Server" ; "Status" ] serverStatuses
|
||||
let rec fullyRerender<'a> (cluster : Cluster<'a>) (network : Network<'a>) : Promise<unit> =
|
||||
let prefs = Ui.getUserPrefs ui
|
||||
|
||||
let serverStatusNodes =
|
||||
fun i ->
|
||||
let node = document.createElement "tr" :?> Browser.Types.HTMLTableRowElement
|
||||
let child = document.createElement "td" :?> Browser.Types.HTMLTableCellElement
|
||||
let statusCell = document.createElement "td" :?> Browser.Types.HTMLTableCellElement
|
||||
child.textContent <- sprintf "%i" i
|
||||
node.appendChild child |> ignore
|
||||
node.appendChild statusCell |> ignore
|
||||
serverStatuses.appendChild node |> ignore
|
||||
statusCell
|
||||
|> List.init clusterSize
|
||||
Ui.freezeState cluster network
|
||||
|> Async.StartAsPromise
|
||||
|> fun p ->
|
||||
p.``then`` (fun clusterState ->
|
||||
Ui.render
|
||||
(perform cluster network)
|
||||
document
|
||||
ui
|
||||
{
|
||||
UserPreferences = prefs
|
||||
ClusterState = clusterState
|
||||
}
|
||||
)
|
||||
|
||||
let logArea = document.querySelector ".log-area" :?> Browser.Types.HTMLTableElement
|
||||
|
||||
logArea.border <- "1px"
|
||||
|
||||
let renderLogArea (cluster : Cluster<'a>) =
|
||||
logArea.innerText <- ""
|
||||
|
||||
let rows =
|
||||
List.init
|
||||
cluster.ClusterSize
|
||||
(fun i ->
|
||||
let cell = document.createElement "th" :?> Browser.Types.HTMLTableCellElement
|
||||
cell.textContent <- sprintf "Server %i" i
|
||||
Table.createRow document [ Some cell ] logArea
|
||||
)
|
||||
|
||||
rows
|
||||
|> List.iteri (fun i row ->
|
||||
let i = i * 1<ServerId>
|
||||
|
||||
cluster.GetCurrentInternalState i
|
||||
|> Async.StartAsPromise
|
||||
|> fun p ->
|
||||
p.``then`` (fun state ->
|
||||
for logEntry in state.Log do
|
||||
let cell = document.createElement "td" :?> Browser.Types.HTMLTableCellElement
|
||||
|
||||
match logEntry with
|
||||
| None -> cell.textContent <- "<none>"
|
||||
| Some (value, term) -> cell.textContent <- sprintf "%i: %O" term value
|
||||
|
||||
row.appendChild cell |> ignore
|
||||
)
|
||||
|> ignore
|
||||
)
|
||||
|
||||
let messageQueueArea =
|
||||
document.querySelector ".button-area" :?> Browser.Types.HTMLTableElement
|
||||
|
||||
messageQueueArea.border <- "1px"
|
||||
|
||||
let resetButtonArea () =
|
||||
messageQueueArea.innerText <- ""
|
||||
|
||||
messageQueueArea
|
||||
|> Table.createHeaderRow document (List.init clusterSize (sprintf "Server %i"))
|
||||
|
||||
resetButtonArea ()
|
||||
|
||||
let setLeaderState (cluster : Cluster<'a>) (id : int<ServerId>) =
|
||||
let leaderIdBox =
|
||||
document.querySelector ".leader-state" :?> Browser.Types.HTMLBlockElement
|
||||
|
||||
leaderIdBox.innerText <- sprintf "%i" id
|
||||
|
||||
let leaderIdTable =
|
||||
document.querySelector ".leader-state-table" :?> Browser.Types.HTMLTableElement
|
||||
|
||||
leaderIdTable.innerText <- ""
|
||||
|
||||
leaderIdTable
|
||||
|> Table.createHeaderRow document ("" :: List.init clusterSize (sprintf "Server %i"))
|
||||
|
||||
let leaderStatePromise = cluster.GetCurrentInternalState id |> Async.StartAsPromise
|
||||
|
||||
leaderStatePromise.``then`` (fun state ->
|
||||
match state.LeaderState with
|
||||
| None -> leaderIdBox.innerText <- sprintf "%i: not a leader" id
|
||||
| Some state ->
|
||||
|
||||
let knownStoredIndices =
|
||||
state.MatchIndex
|
||||
|> Seq.mapi (fun target index ->
|
||||
let target = target * 1<ServerId>
|
||||
if target = id then "(self)" else sprintf "%i" index
|
||||
)
|
||||
|> Seq.toList
|
||||
|> fun l -> "Log index known to be stored on each node" :: l
|
||||
|> List.map (fun text ->
|
||||
let node = document.createElement "div"
|
||||
node.innerText <- text
|
||||
Some node
|
||||
)
|
||||
|
||||
Table.createRow document knownStoredIndices leaderIdTable |> ignore
|
||||
|
||||
let nextToSend =
|
||||
state.ToSend
|
||||
|> Seq.mapi (fun target index ->
|
||||
let target = target * 1<ServerId>
|
||||
if target = id then "(self)" else sprintf "%i" index
|
||||
)
|
||||
|> Seq.toList
|
||||
|> fun l -> "Will try next to send this index" :: l
|
||||
|> List.map (fun text ->
|
||||
let node = document.createElement "div"
|
||||
node.innerText <- text
|
||||
Some node
|
||||
)
|
||||
|
||||
Table.createRow document nextToSend leaderIdTable |> ignore
|
||||
)
|
||||
|
||||
let printClusterState<'a> (cluster : Cluster<'a>) : unit =
|
||||
for i in 0 .. cluster.ClusterSize - 1 do
|
||||
let status = cluster.Status (i * 1<ServerId>)
|
||||
serverStatusNodes.[i].textContent <- status |> string<ServerStatus>
|
||||
and perform (cluster : Cluster<'a>) (network : Network<'a>) (action : NetworkAction<'a>) : Promise<unit> =
|
||||
NetworkAction.perform cluster network action
|
||||
fullyRerender cluster network
|
||||
|
||||
let cluster, network = InMemoryCluster.make<byte> clusterSize
|
||||
|
||||
let leaderStateButton =
|
||||
document.querySelector ".leader-select-button" :?> Browser.Types.HTMLButtonElement
|
||||
|
||||
let selectedLeaderId =
|
||||
document.querySelector ".leader-select" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
selectedLeaderId.min <- "0"
|
||||
selectedLeaderId.max <- sprintf "%i" (clusterSize - 1)
|
||||
selectedLeaderId.defaultValue <- "0"
|
||||
|
||||
leaderStateButton.onclick <-
|
||||
fun _ ->
|
||||
let id = selectedLeaderId.valueAsNumber |> int |> (fun i -> i * 1<ServerId>)
|
||||
setLeaderState cluster id
|
||||
|
||||
let performWithoutPrintingNetworkState action =
|
||||
NetworkAction.perform cluster network action
|
||||
printClusterState cluster
|
||||
renderLogArea cluster
|
||||
|
||||
let rec printNetworkState<'a> (network : Network<'a>) : unit =
|
||||
resetButtonArea ()
|
||||
|
||||
let allButtons =
|
||||
[ 0 .. network.ClusterSize - 1 ]
|
||||
|> List.map (fun i ->
|
||||
let i = i * 1<ServerId>
|
||||
|
||||
network.UndeliveredMessages i
|
||||
|> List.map (fun (messageId, message) ->
|
||||
Button.create
|
||||
document
|
||||
(sprintf "Server %i, message %i: %O" i messageId message)
|
||||
(fun button ->
|
||||
button.remove ()
|
||||
NetworkMessage (i, messageId) |> performWithoutPrintingNetworkState
|
||||
printNetworkState network
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
let maxQueueLength = allButtons |> Seq.map List.length |> Seq.max
|
||||
|
||||
let allButtons' =
|
||||
allButtons
|
||||
|> List.map (fun l -> List.append (List.map Some l) (List.replicate (maxQueueLength - List.length l) None))
|
||||
|> List.transpose
|
||||
|
||||
for row in allButtons' do
|
||||
Table.createRow document row messageQueueArea |> ignore
|
||||
|
||||
let perform (action : NetworkAction<_>) : unit =
|
||||
performWithoutPrintingNetworkState action
|
||||
printNetworkState network
|
||||
|
||||
let startupText =
|
||||
document.querySelector ".startup-text" :?> Browser.Types.HTMLParagraphElement
|
||||
leaderStateButton.onclick <- fun _ -> fullyRerender cluster network
|
||||
|
||||
let startupSequence =
|
||||
[
|
||||
@@ -226,72 +70,40 @@ module App =
|
||||
NetworkAction.NetworkMessage (0<ServerId>, 2)
|
||||
NetworkAction.NetworkMessage (1<ServerId>, 6)
|
||||
]
|
||||
|> fun s -> (Constructors.Promise.resolve (printClusterState cluster), s)
|
||||
||> List.fold (fun (inPromise : Promise<unit>) action -> inPromise.``then`` (fun () -> perform action))
|
||||
|> fun p -> p.``then`` (fun () -> startupText.textContent <- "")
|
||||
|> fun s -> (fullyRerender cluster network, s)
|
||||
||> List.fold (fun (inPromise : Promise<unit>) action ->
|
||||
promise {
|
||||
let! _ = inPromise
|
||||
return! perform cluster network action
|
||||
}
|
||||
)
|
||||
|
||||
let timeoutButton =
|
||||
document.querySelector ".timeout-button" :?> Browser.Types.HTMLButtonElement
|
||||
|
||||
let timeoutField =
|
||||
document.querySelector ".timeout-text" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
timeoutField.max <- string<int> (clusterSize - 1)
|
||||
timeoutField.min <- "0"
|
||||
timeoutField.defaultValue <- "0"
|
||||
|
||||
timeoutButton.onclick <-
|
||||
fun _event ->
|
||||
startupSequence.``then`` (fun () ->
|
||||
timeoutField.valueAsNumber
|
||||
ui.TimeoutField.valueAsNumber
|
||||
|> int
|
||||
|> fun i -> i * 1<ServerId>
|
||||
|> InactivityTimeout
|
||||
|> perform
|
||||
|
||||
printClusterState cluster
|
||||
renderLogArea cluster
|
||||
printNetworkState network
|
||||
|> perform cluster network
|
||||
)
|
||||
|
||||
let heartbeatButton =
|
||||
document.querySelector ".heartbeat-button" :?> Browser.Types.HTMLButtonElement
|
||||
|
||||
let heartbeatField =
|
||||
document.querySelector ".heartbeat-text" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
heartbeatField.max <- string<int> (clusterSize - 1)
|
||||
heartbeatField.min <- "0"
|
||||
heartbeatField.defaultValue <- "0"
|
||||
|
||||
heartbeatButton.onclick <-
|
||||
fun _event ->
|
||||
startupSequence.``then`` (fun () ->
|
||||
heartbeatField.valueAsNumber
|
||||
ui.HeartbeatField.valueAsNumber
|
||||
|> int
|
||||
|> fun i -> i * 1<ServerId>
|
||||
|> Heartbeat
|
||||
|> perform
|
||||
|
||||
printClusterState cluster
|
||||
renderLogArea cluster
|
||||
printNetworkState network
|
||||
|> perform cluster network
|
||||
)
|
||||
|
||||
let clientDataField =
|
||||
document.querySelector ".client-data" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
clientDataField.max <- "255"
|
||||
clientDataField.min <- "0"
|
||||
clientDataField.defaultValue <- "0"
|
||||
|
||||
let clientDataServerField =
|
||||
document.querySelector ".client-server-selection" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
clientDataServerField.max <- string<int> (clusterSize - 1)
|
||||
clientDataServerField.min <- "0"
|
||||
clientDataServerField.defaultValue <- "0"
|
||||
|
||||
let clientDataSubmitButton =
|
||||
document.querySelector ".client-data-submit" :?> Browser.Types.HTMLButtonElement
|
||||
|
||||
@@ -299,12 +111,10 @@ module App =
|
||||
fun _event ->
|
||||
startupSequence.``then`` (fun () ->
|
||||
let server =
|
||||
clientDataServerField.valueAsNumber |> int |> (fun i -> i * 1<ServerId>)
|
||||
ui.ClientDataServerField.valueAsNumber |> int |> (fun i -> i * 1<ServerId>)
|
||||
|
||||
let data = clientDataField.valueAsNumber |> byte
|
||||
NetworkAction.ClientRequest (server, data, printfn "%O") |> perform
|
||||
let data = ui.ClientDataField.valueAsNumber |> byte
|
||||
|
||||
printClusterState cluster
|
||||
renderLogArea cluster
|
||||
printNetworkState network
|
||||
NetworkAction.ClientRequest (server, data, printfn "%O")
|
||||
|> perform cluster network
|
||||
)
|
||||
|
||||
@@ -3,7 +3,7 @@ namespace RaftFable
|
||||
[<RequireQualifiedAccess>]
|
||||
module Button =
|
||||
|
||||
let create (document : Browser.Types.Document) (text : string) (onClick : Browser.Types.HTMLButtonElement -> unit) =
|
||||
let create (document : Browser.Types.Document) (text : string) (onClick : Browser.Types.HTMLButtonElement -> 'a) =
|
||||
let node = document.createElement "button" :?> Browser.Types.HTMLButtonElement
|
||||
node.textContent <- text
|
||||
node.onclick <- fun _ -> onClick node
|
||||
|
||||
@@ -5,6 +5,7 @@
|
||||
<ItemGroup>
|
||||
<Compile Include="Table.fs" />
|
||||
<Compile Include="Button.fs" />
|
||||
<Compile Include="Ui.fs" />
|
||||
<Compile Include="App.fs" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
|
||||
307
RaftFable/src/Ui.fs
Normal file
307
RaftFable/src/Ui.fs
Normal file
@@ -0,0 +1,307 @@
|
||||
namespace RaftFable
|
||||
|
||||
open Raft
|
||||
|
||||
type ClusterState<'a> =
|
||||
{
|
||||
ClusterSize : int
|
||||
InternalState : ServerInternalState<'a> array
|
||||
Statuses : ServerStatus array
|
||||
UndeliveredMessages : (int * Message<'a>) list array
|
||||
}
|
||||
|
||||
type UserPreferences =
|
||||
{
|
||||
LeaderUnderConsideration : int<ServerId>
|
||||
}
|
||||
|
||||
type UiBackingState<'a> =
|
||||
{
|
||||
ClusterState : ClusterState<'a>
|
||||
UserPreferences : UserPreferences
|
||||
}
|
||||
|
||||
type UiElements =
|
||||
{
|
||||
Document : Browser.Types.Document
|
||||
ServerStatusTable : Browser.Types.HTMLTableElement
|
||||
LogArea : Browser.Types.HTMLTableElement
|
||||
MessageQueueArea : Browser.Types.HTMLTableElement
|
||||
LeaderStateTable : Browser.Types.HTMLTableElement
|
||||
TimeoutField : Browser.Types.HTMLInputElement
|
||||
ClientDataField : Browser.Types.HTMLInputElement
|
||||
ClientDataServerField : Browser.Types.HTMLInputElement
|
||||
HeartbeatField : Browser.Types.HTMLInputElement
|
||||
SelectedLeaderId : Browser.Types.HTMLInputElement
|
||||
}
|
||||
|
||||
type RequiresPopulation =
|
||||
{
|
||||
ServerStatusNodes : Browser.Types.HTMLTableCellElement array
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Ui =
|
||||
|
||||
let initialise (document : Browser.Types.Document) (clusterSize : int) : UiElements =
|
||||
let serverStatuses =
|
||||
document.querySelector ".server-statuses" :?> Browser.Types.HTMLTableElement
|
||||
|
||||
let logArea = document.querySelector ".log-area" :?> Browser.Types.HTMLTableElement
|
||||
|
||||
let messageQueueArea =
|
||||
document.querySelector ".button-area" :?> Browser.Types.HTMLTableElement
|
||||
|
||||
let leaderStateTable =
|
||||
document.querySelector ".leader-state-table" :?> Browser.Types.HTMLTableElement
|
||||
|
||||
let timeoutButton =
|
||||
document.querySelector ".timeout-button" :?> Browser.Types.HTMLButtonElement
|
||||
|
||||
let timeoutField =
|
||||
document.querySelector ".timeout-text" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
let clientDataServerField =
|
||||
document.querySelector ".client-server-selection" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
let heartbeatField =
|
||||
document.querySelector ".heartbeat-text" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
let clientDataField =
|
||||
document.querySelector ".client-data" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
let selectedLeaderId =
|
||||
document.querySelector ".leader-select" :?> Browser.Types.HTMLInputElement
|
||||
|
||||
{
|
||||
Document = document
|
||||
ServerStatusTable = serverStatuses
|
||||
LogArea = logArea
|
||||
MessageQueueArea = messageQueueArea
|
||||
LeaderStateTable = leaderStateTable
|
||||
TimeoutField = timeoutField
|
||||
ClientDataField = clientDataField
|
||||
ClientDataServerField = clientDataServerField
|
||||
HeartbeatField = heartbeatField
|
||||
SelectedLeaderId = selectedLeaderId
|
||||
}
|
||||
|
||||
let reset (clusterSize : int) (ui : UiElements) : RequiresPopulation =
|
||||
let document = ui.Document
|
||||
|
||||
ui.ServerStatusTable.innerText <- ""
|
||||
ui.ServerStatusTable.border <- "1px"
|
||||
Table.createHeaderRow ui.Document [ "Server" ; "Status" ] ui.ServerStatusTable
|
||||
|
||||
let serverStatusNodes =
|
||||
[|
|
||||
for i in 0 .. clusterSize - 1 do
|
||||
let node = document.createElement "tr" :?> Browser.Types.HTMLTableRowElement
|
||||
let child = document.createElement "td" :?> Browser.Types.HTMLTableCellElement
|
||||
let statusCell = document.createElement "td" :?> Browser.Types.HTMLTableCellElement
|
||||
child.textContent <- sprintf "%i" i
|
||||
node.appendChild child |> ignore
|
||||
node.appendChild statusCell |> ignore
|
||||
ui.ServerStatusTable.appendChild node |> ignore
|
||||
yield statusCell
|
||||
|]
|
||||
|
||||
ui.SelectedLeaderId.min <- "0"
|
||||
ui.SelectedLeaderId.max <- sprintf "%i" (clusterSize - 1)
|
||||
ui.SelectedLeaderId.defaultValue <- "0"
|
||||
ui.ClientDataField.max <- "255"
|
||||
ui.ClientDataField.min <- "0"
|
||||
ui.ClientDataField.defaultValue <- "0"
|
||||
ui.HeartbeatField.max <- string<int> (clusterSize - 1)
|
||||
ui.HeartbeatField.min <- "0"
|
||||
ui.HeartbeatField.defaultValue <- "0"
|
||||
ui.ClientDataServerField.max <- string<int> (clusterSize - 1)
|
||||
ui.ClientDataServerField.min <- "0"
|
||||
ui.ClientDataServerField.defaultValue <- "0"
|
||||
ui.TimeoutField.max <- string<int> (clusterSize - 1)
|
||||
ui.TimeoutField.min <- "0"
|
||||
ui.TimeoutField.defaultValue <- "0"
|
||||
|
||||
ui.LeaderStateTable.innerText <- ""
|
||||
|
||||
ui.LeaderStateTable
|
||||
|> Table.createHeaderRow document ("" :: List.init clusterSize (sprintf "Server %i"))
|
||||
|
||||
ui.MessageQueueArea.border <- "1px"
|
||||
ui.MessageQueueArea.innerText <- ""
|
||||
|
||||
ui.MessageQueueArea
|
||||
|> Table.createHeaderRow document (List.init clusterSize (sprintf "Server %i"))
|
||||
|
||||
ui.LogArea.border <- "1px"
|
||||
ui.LogArea.innerText <- ""
|
||||
|
||||
{
|
||||
ServerStatusNodes = serverStatusNodes
|
||||
}
|
||||
|
||||
let render<'a>
|
||||
(perform : NetworkAction<'a> -> Fable.Core.JS.Promise<unit>)
|
||||
(document : Browser.Types.Document)
|
||||
(ui : UiElements)
|
||||
(state : UiBackingState<'a>)
|
||||
: unit =
|
||||
let userPrefs = state.UserPreferences
|
||||
let state = state.ClusterState
|
||||
|
||||
let requiresPopulation = reset state.ClusterSize ui
|
||||
|
||||
let rows =
|
||||
List.init
|
||||
state.ClusterSize
|
||||
(fun i ->
|
||||
let cell = document.createElement "th" :?> Browser.Types.HTMLTableCellElement
|
||||
cell.textContent <- sprintf "Server %i" i
|
||||
Table.createRow document [ Some cell ] ui.LogArea
|
||||
)
|
||||
|
||||
rows
|
||||
|> List.iteri (fun i row ->
|
||||
let state = state.InternalState.[i]
|
||||
|
||||
for logEntry in state.Log do
|
||||
let cell = document.createElement "td" :?> Browser.Types.HTMLTableCellElement
|
||||
|
||||
match logEntry with
|
||||
| None -> cell.textContent <- "<none>"
|
||||
| Some (value, term) -> cell.textContent <- sprintf "%i: %O" term value
|
||||
|
||||
row.appendChild cell |> ignore
|
||||
)
|
||||
|
||||
for i in 0 .. state.ClusterSize - 1 do
|
||||
let status = state.Statuses.[i]
|
||||
requiresPopulation.ServerStatusNodes.[i].textContent <- status |> string<ServerStatus>
|
||||
|
||||
// Network status
|
||||
let allButtons =
|
||||
[ 0 .. state.ClusterSize - 1 ]
|
||||
|> List.map (fun i ->
|
||||
state.UndeliveredMessages.[i]
|
||||
|> List.map (fun (messageId, message) ->
|
||||
Button.create
|
||||
document
|
||||
(sprintf "Server %i, message %i: %O" i messageId message)
|
||||
(fun button ->
|
||||
button.remove ()
|
||||
|
||||
NetworkMessage (i * 1<ServerId>, messageId) |> perform
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
let maxQueueLength = allButtons |> Seq.map List.length |> Seq.max
|
||||
|
||||
let allButtons' =
|
||||
allButtons
|
||||
|> List.map (fun l -> List.append (List.map Some l) (List.replicate (maxQueueLength - List.length l) None))
|
||||
|> List.transpose
|
||||
|
||||
for row in allButtons' do
|
||||
Table.createRow document row ui.MessageQueueArea |> ignore
|
||||
|
||||
// Leader status
|
||||
let leaderIdBox =
|
||||
document.querySelector ".leader-state" :?> Browser.Types.HTMLBlockElement
|
||||
|
||||
leaderIdBox.innerText <- sprintf "%i" userPrefs.LeaderUnderConsideration
|
||||
|
||||
let leaderState =
|
||||
state.InternalState.[userPrefs.LeaderUnderConsideration / 1<ServerId>]
|
||||
|
||||
match leaderState.LeaderState with
|
||||
| None -> leaderIdBox.innerText <- sprintf "%i: not a leader" userPrefs.LeaderUnderConsideration
|
||||
| Some leaderState ->
|
||||
|
||||
let knownStoredIndices =
|
||||
leaderState.MatchIndex
|
||||
|> Seq.mapi (fun target index ->
|
||||
let target = target * 1<ServerId>
|
||||
|
||||
if target = userPrefs.LeaderUnderConsideration then
|
||||
"(self)"
|
||||
else
|
||||
sprintf "%i" index
|
||||
)
|
||||
|> Seq.toList
|
||||
|> fun l -> "Log index known to be stored on each node" :: l
|
||||
|> List.map (fun text ->
|
||||
let node = document.createElement "div"
|
||||
node.innerText <- text
|
||||
Some node
|
||||
)
|
||||
|
||||
Table.createRow document knownStoredIndices ui.LeaderStateTable |> ignore
|
||||
|
||||
let nextToSend =
|
||||
leaderState.ToSend
|
||||
|> Seq.mapi (fun target index ->
|
||||
let target = target * 1<ServerId>
|
||||
|
||||
if target = userPrefs.LeaderUnderConsideration then
|
||||
"(self)"
|
||||
else
|
||||
sprintf "%i" index
|
||||
)
|
||||
|> Seq.toList
|
||||
|> fun l -> "Will try next to send this index" :: l
|
||||
|> List.map (fun text ->
|
||||
let node = document.createElement "div"
|
||||
node.innerText <- text
|
||||
Some node
|
||||
)
|
||||
|
||||
Table.createRow document nextToSend ui.LeaderStateTable |> ignore
|
||||
|
||||
let freezeState<'a> (cluster : Cluster<'a>) (network : Network<'a>) : ClusterState<'a> Async =
|
||||
let internalState =
|
||||
let states = Array.zeroCreate<ServerInternalState<'a>> cluster.ClusterSize
|
||||
|
||||
[ 0 .. cluster.ClusterSize - 1 ]
|
||||
|> List.map (fun i -> cluster.GetCurrentInternalState (i * 1<ServerId>))
|
||||
|> List.fold
|
||||
(fun (i, acc) state ->
|
||||
(i + 1),
|
||||
async {
|
||||
let! acc = acc
|
||||
let! state = state
|
||||
states.[i] <- state
|
||||
return states
|
||||
}
|
||||
)
|
||||
(0, async.Return states)
|
||||
|> snd
|
||||
|
||||
let statuses =
|
||||
[|
|
||||
for i in 0 .. cluster.ClusterSize - 1 do
|
||||
yield cluster.Status (i * 1<ServerId>)
|
||||
|]
|
||||
|
||||
let undeliveredMessages =
|
||||
[|
|
||||
for i in 0 .. cluster.ClusterSize - 1 do
|
||||
yield network.UndeliveredMessages (i * 1<ServerId>)
|
||||
|]
|
||||
|
||||
async {
|
||||
let! internalState = internalState
|
||||
|
||||
return
|
||||
{
|
||||
ClusterSize = cluster.ClusterSize
|
||||
InternalState = internalState
|
||||
Statuses = statuses
|
||||
UndeliveredMessages = undeliveredMessages
|
||||
}
|
||||
}
|
||||
|
||||
let getUserPrefs (ui : UiElements) : UserPreferences =
|
||||
{
|
||||
LeaderUnderConsideration = ui.SelectedLeaderId.valueAsNumber |> int |> (fun i -> i * 1<ServerId>)
|
||||
}
|
||||
Reference in New Issue
Block a user