Add a basic interactive client

Raft.Test/TestServer.fs

@@ -4,6 +4,7 @@ open System.Threading
 open Raft
 open NUnit.Framework
 open FsUnitTyped
+open FsCheck
 
 [<TestFixture>]
 module TestServer =
@@ -60,7 +61,7 @@ module TestServer =
         calls.Value |> shouldEqual 0
 
     [<Test>]
-    let ``Startup sequence in prod`` () =
+    let ``Startup sequence in prod, only one timeout takes place`` () =
         let cluster, network = InMemoryCluster.make<int> 5
 
         cluster.Servers.[0].TriggerTimeout ()
@@ -85,3 +86,152 @@ module TestServer =
 
         for i in 1..4 do
             cluster.Servers.[i].State |> shouldEqual ServerStatus.Follower
+
+    let popOne (queues : 'a list list) : ((int * 'a) * 'a list list) list =
+        queues
+        |> List.indexed
+        |> List.filter (fun (index, l) -> not (List.isEmpty l))
+        |> List.collect (fun (firstPlaceWithInstruction, entries) ->
+            entries
+            |> List.indexed
+            |> List.map (fun (i, entry) -> (firstPlaceWithInstruction, entry), List.removeAt i entries)
+            |> List.map (fun (removed, rest) ->
+                let afterPop =
+                    queues
+                    |> List.removeAt firstPlaceWithInstruction
+                    |> List.insertAt firstPlaceWithInstruction rest
+
+                removed, afterPop
+            )
+        )
+
+    let rec allOrderings (queues : 'a list list) : (int * 'a) list list =
+        let output = popOne queues
+
+        match output with
+        | [] -> [ [] ]
+        | output ->
+
+        output
+        |> List.collect (fun (extracted, remaining) ->
+            let sub = allOrderings remaining
+            sub |> List.map (fun s -> extracted :: s)
+        )
+
+    let factorial i =
+        let rec go acc i =
+            if i <= 0 then acc else go (acc * i) (i - 1)
+
+        go 1 i
+
+    [<TestCase(0, 1)>]
+    [<TestCase(1, 1)>]
+    [<TestCase(2, 2)>]
+    [<TestCase(3, 6)>]
+    [<TestCase(4, 24)>]
+    let ``Test factorial`` (n : int, result : int) = factorial n |> shouldEqual result
+
+    [<Test>]
+    let ``Test allOrderings`` () =
+        let case = [ [ "a" ; "b" ] ; [ "c" ; "d" ; "e" ] ]
+        let output = case |> allOrderings
+        output |> shouldEqual (List.distinct output)
+
+        output
+        |> List.length
+        |> shouldEqual (factorial (List.concat case |> List.length))
+
+        let allElements = Set.ofList (List.concat case)
+
+        for output in output do
+            output |> List.map snd |> Set.ofList |> shouldEqual allElements
+
+    let randomChoice<'a> (r : System.Random) (arr : 'a list) : 'a = arr.[r.Next (0, arr.Length)]
+
+    [<Test>]
+    let ``Startup sequence in prod, two timeouts at once, random`` () =
+        let rand = System.Random ()
+        let cluster, network = InMemoryCluster.make<int> 5
+
+        cluster.Servers.[0].TriggerTimeout ()
+        cluster.Servers.[0].Sync ()
+        cluster.Servers.[1].TriggerTimeout ()
+        cluster.Servers.[1].Sync ()
+
+        // Those two each sent a message to every other server.
+        network.InboundMessages.[0].Count |> shouldEqual 1
+        network.InboundMessages.[1].Count |> shouldEqual 1
+
+        for i in 2..4 do
+            network.InboundMessages.[i].Count |> shouldEqual 2
+
+        while network.InboundMessages |> Seq.concat |> Seq.isEmpty |> not do
+            let allOrderings' =
+                network.InboundMessages |> List.ofArray |> List.map List.ofSeq |> allOrderings
+
+            network.InboundMessages |> Array.iter (fun arr -> arr.Clear ())
+            // Process the messages!
+            let ordering = randomChoice rand allOrderings'
+
+            for serverConsuming, message in ordering do
+                cluster.SendMessageDirectly (serverConsuming * 1<ServerId>) message
+
+        (cluster.Servers.[0].State = Leader && cluster.Servers.[1].State = Leader)
+        |> shouldEqual false
+
+        (cluster.Servers.[0].State = Candidate && cluster.Servers.[1].State = Candidate)
+        |> shouldEqual false
+
+        ((cluster.Servers.[0].State = Leader && cluster.Servers.[1].State = Candidate)
+         || (cluster.Servers.[1].State = Leader && cluster.Servers.[0].State = Candidate))
+        |> shouldEqual true
+
+        for i in 2..4 do
+            cluster.Servers.[i].State |> shouldEqual ServerStatus.Follower
+
+    type History = History of (int<ServerId> * int) list
+
+    let historyGen (clusterSize : int) =
+        gen {
+            let! pile = Gen.choose (0, clusterSize - 1)
+            let! entry = Arb.generate<int>
+            return (pile * 1<ServerId>, abs entry)
+        }
+        |> Gen.listOf
+        |> Gen.map History
+
+    let apply (History history) (cluster : Cluster<'a>) (network : Network<'a>) : unit =
+        for pile, entry in history do
+            let messages = network.InboundMessages.[pile / 1<ServerId>]
+
+            if entry < messages.Count then
+                cluster.SendMessageDirectly pile messages.[entry]
+
+    [<Test>]
+    let ``Startup sequence in prod, two timeouts at once, property-based: at most one leader is elected`` () =
+        let cluster, network = InMemoryCluster.make<int> 5
+
+        cluster.Servers.[0].TriggerTimeout ()
+        cluster.Servers.[0].Sync ()
+        cluster.Servers.[1].TriggerTimeout ()
+        cluster.Servers.[1].Sync ()
+
+        // Those two each sent a message to every other server.
+        network.InboundMessages.[0].Count |> shouldEqual 1
+        network.InboundMessages.[1].Count |> shouldEqual 1
+
+        for i in 2..4 do
+            network.InboundMessages.[i].Count |> shouldEqual 2
+
+        let property (history : History) =
+            apply history cluster network
+
+            (cluster.Servers.[0].State = Leader && cluster.Servers.[1].State = Leader)
+            |> shouldEqual false
+
+            for i in 2..4 do
+                cluster.Servers.[i].State |> shouldEqual ServerStatus.Follower
+
+        property
+        |> Prop.forAll (Arb.fromGen (historyGen 5))
+        |> Check.QuickThrowOnFailure