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

Lift the declarative history definition to the library

Browse Source
This commit is contained in:
Smaug123
2022-10-27 21:53:01 +01:00
parent 3c40471d7e
commit cce92eb9fd
4 changed files with 100 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
Raft/InMemory.fs
View File

@@ -84,3 +84,21 @@ module InMemoryCluster =
}
cluster, network
type NetworkAction =
| InactivityTimeout of int<ServerId>
| NetworkMessage of int<ServerId> * int
| DropMessage of int<ServerId> * int
| Heartbeat of int<ServerId>
[<RequireQualifiedAccess>]
module NetworkAction =
let perform<'a> (cluster : Cluster<'a>) (network : Network<'a>) (action : NetworkAction) : 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

42
Raft/Server.fs
View File

@@ -430,6 +430,26 @@ type Server<'a>
let divideByTwoRoundingUp (n : int) =
if n % 2 = 0 then n / 2 else (n / 2) + 1
let emitHeartbeat () =
match currentType with
| ServerSpecialisation.Candidate _
| ServerSpecialisation.Follower -> ()
| ServerSpecialisation.Leader _ ->
for i in 0 .. clusterSize - 1 do
if i * 1<ServerId> <> me then
{
LeaderTerm = persistentState.CurrentTerm
LeaderId = me
PrevLogEntry = persistentState.GetLastLogEntry () |> Option.map snd
NewEntry = None
LeaderCommitIndex = volatileState.CommitIndex
ReplyChannel =
fun reply -> messageChannel me (reply |> Reply.AppendEntriesReply |> Message.Reply)
}
|> Instruction.AppendEntries
|> Message.Instruction
|> messageChannel (i * 1<ServerId>)
let processReply (r : Reply) : unit =
match r with
| AppendEntriesReply appendEntriesReply ->
@@ -492,6 +512,7 @@ type Server<'a>
LeaderState.New clusterSize persistentState.CurrentLogIndex
|> ServerSpecialisation.Leader
emitHeartbeat ()
let mailbox =
let rec loop (mailbox : MailboxProcessor<_>) =
@@ -501,26 +522,7 @@ type Server<'a>
//System.Console.WriteLine toPrint
match m with
| ServerAction.EmitHeartbeat ->
match currentType with
| ServerSpecialisation.Candidate _
| ServerSpecialisation.Follower -> ()
| ServerSpecialisation.Leader _ ->
for i in 0 .. clusterSize - 1 do
if i * 1<ServerId> <> me then
{
LeaderTerm = persistentState.CurrentTerm
LeaderId = me
PrevLogEntry = persistentState.GetLastLogEntry () |> Option.map snd
NewEntry = None
LeaderCommitIndex = volatileState.CommitIndex
ReplyChannel =
fun reply ->
messageChannel me (reply |> Reply.AppendEntriesReply |> Message.Reply)
}
|> Instruction.AppendEntries
|> Message.Instruction
|> messageChannel (i * 1<ServerId>)
| ServerAction.EmitHeartbeat -> emitHeartbeat ()
| ServerAction.BeginElection ->
match currentType with
| ServerSpecialisation.Leader _ -> ()