patrick/raft-fable
1
0
Fork 0
Code Issues Pull Requests Packages Releases Activity

Implement committal

Browse Source
This commit is contained in:
Smaug123
2022-10-27 21:31:48 +01:00
parent 15a035ec8e
commit 3c40471d7e
11 changed files with 544 additions and 338 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
RaftExplorer/Program.fs
View File

@@ -57,12 +57,28 @@ module Program =
printf "Unrecognised input. "
None
let rec getHeartbeater (clusterSize : int) (serverId : string) =
// TODO: restrict this to the leaders only
match Int32.TryParse serverId with
| true, serverId ->
if serverId >= clusterSize || serverId < 0 then
printf "Server ID must be between 0 and %i inclusive. " (clusterSize - 1)
None
else
Some (serverId * 1<ServerId>)
| false, _ ->
printf "Unrecognised input. "
None
type UserAction =
| Timeout of int<ServerId>
| InactivityTimeout of int<ServerId>
| NetworkMessage of int<ServerId> * int
| DropMessage of int<ServerId> * int
| Heartbeat of int<ServerId>
let rec getAction (clusterSize : int) =
printf "Enter action. Trigger [t]imeout <server id>, or allow [m]essage <server id, message id>: "
printf
"Enter action. Trigger [t]imeout <server id>, [h]eartbeat a leader <server id>, [d]rop message <server id, message id>, or allow [m]essage <server id, message id>: "
let s =
let rec go () =
@@ -74,31 +90,62 @@ module Program =
match s.[0] with
| 'T' ->
match getTimeout clusterSize s.[1..] with
| Some t -> t |> Timeout
| Some t -> t |> InactivityTimeout
| None -> getAction clusterSize
| 'D' ->
match getMessage clusterSize s.[1..] with
| Some m -> m |> DropMessage
| None -> getAction clusterSize
| 'M' ->
match getMessage clusterSize s.[1..] with
| Some m -> m |> NetworkMessage
| None -> getAction clusterSize
| 'H' ->
match getHeartbeater clusterSize s.[1..] with
| Some h -> Heartbeat h
| None -> getAction clusterSize
| _ ->
printf "Unrecognised input. "
getAction clusterSize
let processAction (cluster : Cluster<'a>) (network : Network<'a>) (action : UserAction) : unit =
match action with
| InactivityTimeout serverId -> cluster.InactivityTimeout serverId
| Heartbeat serverId -> cluster.HeartbeatTimeout serverId
| DropMessage (serverId, messageId) -> network.DropMessage serverId messageId
| NetworkMessage (serverId, messageId) ->
network.InboundMessage serverId messageId |> cluster.SendMessage serverId
network.DropMessage serverId messageId
[<EntryPoint>]
let main _argv =
let clusterSize = 5
let cluster, network = InMemoryCluster.make<int> clusterSize
let startupSequence =
[
UserAction.InactivityTimeout 0<ServerId>
UserAction.NetworkMessage (1<ServerId>, 0)
UserAction.NetworkMessage (2<ServerId>, 0)
UserAction.DropMessage (3<ServerId>, 0)
UserAction.DropMessage (4<ServerId>, 0)
UserAction.NetworkMessage (0<ServerId>, 0)
UserAction.NetworkMessage (0<ServerId>, 1)
]
for action in startupSequence do
processAction cluster network action
while true do
printNetworkState network
printClusterState cluster
let action = getAction clusterSize
processAction cluster network action
match action with
| Timeout serverId -> cluster.Timeout serverId
| NetworkMessage (serverId, messageId) ->
network.InboundMessage serverId messageId |> cluster.SendMessage serverId
network.DropMessage serverId messageId
// TODO: log out the committed state so that we can see whether the leader is correctly
// processing heartbeat responses
// TODO: allow client queries!
0