From fa9cd83dd26ca02d302754d89acff151de5c8aae Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Tue, 9 Jan 2018 13:41:51 +0100 Subject: [PATCH 01/27] adding separate ClusterMember type for project file --- src/Disco/Disco/Core/Project.fs | 352 ++++++++++++++++-- src/Disco/Disco/Core/StateMachine.fs | 12 +- src/Disco/Disco/Core/Uri.fs | 4 +- src/Disco/Disco/Net/PubSub.fs | 9 +- src/Disco/Disco/Service/ApiServer.fs | 4 +- src/Disco/Disco/Service/CommandActions.fs | 10 +- src/Disco/Disco/Service/DiscoService.fs | 10 +- src/Disco/Disco/Service/GitServer.fs | 2 +- src/Disco/Disco/Service/Persistence.fs | 11 +- src/Disco/Disco/Service/WebSocket.fs | 2 +- src/Disco/Disco/Tests/Core/ApiTests.fs | 10 +- src/Disco/Disco/Tests/Core/Disco/Common.fs | 5 +- src/Disco/Disco/Tests/Core/Generators.fs | 37 +- src/Disco/Disco/Tests/Core/GitTests.fs | 13 +- src/Disco/Disco/Tests/Core/NetTests.fs | 2 +- src/Disco/Disco/Tests/Core/ProjectTests.fs | 6 +- .../Disco/Tests/Core/RaftIntegrationTests.fs | 19 +- .../Disco/Tests/Core/SerializationTests.fs | 53 --- src/Disco/Schema/Core.fbs | 17 +- src/Disco/Serialization.csproj | 123 ++++++ .../src/Core.Frontend/FlatBufferTypes.fs | 43 ++- .../src/Frontend/Elmish/AssetBrowserView.fs | 6 +- .../src/Frontend/Elmish/ClusterView.fs | 6 +- src/Frontend/src/Frontend/Elmish/Helpers.fs | 2 +- .../Elmish/Inspectors/MemberInspector.fs | 2 +- src/Frontend/src/Frontend/MockData.fs | 2 +- 26 files changed, 613 insertions(+), 149 deletions(-) diff --git a/src/Disco/Disco/Core/Project.fs b/src/Disco/Disco/Core/Project.fs index a12b8d59..a72563df 100644 --- a/src/Disco/Disco/Core/Project.fs +++ b/src/Disco/Disco/Core/Project.fs @@ -565,6 +565,244 @@ module HostGroup = let setName = Optic.set HostGroup.Name_ let setMembers = Optic.set HostGroup.Members_ +// * ClusterMember + +type ClusterMember = + { Id: MemberId + HostName: Name + IpAddress: IpAddress + MulticastAddress: IpAddress + MulticastPort: Port + HttpPort: Port + RaftPort: Port + WsPort: Port + GitPort: Port + ApiPort: Port + State: MemberState + Status: MemberStatus } + + // ** optics + + static member Id_ = + (fun (mem:ClusterMember) -> mem.Id), + (fun id (mem:ClusterMember) -> { mem with Id = id }) + + static member HostName_ = + (fun (mem:ClusterMember) -> mem.HostName), + (fun hostName (mem:ClusterMember) -> { mem with HostName = hostName }) + + static member IpAddress_ = + (fun (mem:ClusterMember) -> mem.IpAddress), + (fun ipAddress (mem:ClusterMember) -> { mem with IpAddress = ipAddress }) + + static member MulticastAddress_ = + (fun (mem:ClusterMember) -> mem.MulticastAddress), + (fun multicastAddress (mem:ClusterMember) -> { mem with MulticastAddress = multicastAddress }) + + static member MulticastPort_ = + (fun (mem:ClusterMember) -> mem.MulticastPort), + (fun multicastPort (mem:ClusterMember) -> { mem with MulticastPort = multicastPort }) + + static member RaftPort_ = + (fun (mem:ClusterMember) -> mem.RaftPort), + (fun raftPort (mem:ClusterMember) -> { mem with RaftPort = raftPort }) + + static member HttpPort_ = + (fun (mem:ClusterMember) -> mem.HttpPort), + (fun httpPort (mem:ClusterMember) -> { mem with HttpPort = httpPort }) + + static member WsPort_ = + (fun (mem:ClusterMember) -> mem.WsPort), + (fun wsPort (mem:ClusterMember) -> { mem with WsPort = wsPort }) + + static member GitPort_ = + (fun (mem:ClusterMember) -> mem.GitPort), + (fun gitPort (mem:ClusterMember) -> { mem with GitPort = gitPort }) + + static member ApiPort_ = + (fun (mem:ClusterMember) -> mem.ApiPort), + (fun apiPort (mem:ClusterMember) -> { mem with ApiPort = apiPort }) + + static member State_ = + (fun (mem:ClusterMember) -> mem.State), + (fun state (mem:ClusterMember) -> { mem with State = state }) + + static member Status_ = + (fun (mem:ClusterMember) -> mem.Status), + (fun status (mem:ClusterMember) -> { mem with Status = status }) + + // ** ToYaml + + #if !FABLE_COMPILER && !DISCO_NODES + + #endif + + // ** ToOffset + + member mem.ToOffset (builder: FlatBufferBuilder) = + let id = ClusterMemberFB.CreateIdVector(builder,mem.Id.ToByteArray()) + let ip = string mem.IpAddress |> builder.CreateString + let mcastip = string mem.MulticastAddress |> builder.CreateString + + let hostname = + let unwrapped = unwrap mem.HostName + if isNull unwrapped then + None + else + unwrapped |> builder.CreateString |> Some + + let state = mem.State.ToOffset(builder) + let status = mem.Status.ToOffset() + + ClusterMemberFB.StartClusterMemberFB(builder) + ClusterMemberFB.AddId(builder, id) + + match hostname with + | Some hostname -> ClusterMemberFB.AddHostName(builder, hostname) + | None -> () + + ClusterMemberFB.AddMulticastAddress(builder, mcastip) + ClusterMemberFB.AddMulticastPort(builder, unwrap mem.MulticastPort) + ClusterMemberFB.AddIpAddress(builder, ip) + ClusterMemberFB.AddRaftPort(builder, unwrap mem.RaftPort) + ClusterMemberFB.AddHttpPort(builder, unwrap mem.HttpPort) + ClusterMemberFB.AddWsPort(builder, unwrap mem.WsPort) + ClusterMemberFB.AddGitPort(builder, unwrap mem.GitPort) + ClusterMemberFB.AddApiPort(builder, unwrap mem.ApiPort) + ClusterMemberFB.AddState(builder, state) + ClusterMemberFB.AddStatus(builder, status) + ClusterMemberFB.EndClusterMemberFB(builder) + + // ** FromFB + + static member FromFB (fb: ClusterMemberFB) : Either = + either { + let! id = Id.decodeId fb + let! state = MemberState.FromFB fb.State + let! status = MemberStatus.FromFB fb.Status + let! ip = IpAddress.TryParse fb.IpAddress + let! mcastip = IpAddress.TryParse fb.MulticastAddress + return { + Id = id + State = state + Status = status + HostName = name fb.HostName + IpAddress = ip + MulticastAddress = mcastip + MulticastPort = port fb.MulticastPort + HttpPort = port fb.HttpPort + RaftPort = port fb.RaftPort + WsPort = port fb.WsPort + GitPort = port fb.GitPort + ApiPort = port fb.ApiPort + } + } + + // ** ToBytes + + member self.ToBytes () = Binary.buildBuffer self + + // ** FromBytes + + static member FromBytes (bytes: byte[]) = + Binary.createBuffer bytes + |> ClusterMemberFB.GetRootAsClusterMemberFB + |> ClusterMember.FromFB + + +// * ClusterMember module + +module ClusterMember = + + open Aether + + // ** getters + + let id = Optic.get ClusterMember.Id_ + let hostName = Optic.get ClusterMember.HostName_ + let ipAddress = Optic.get ClusterMember.IpAddress_ + let multicastAddress = Optic.get ClusterMember.MulticastAddress_ + let multicastPort = Optic.get ClusterMember.MulticastPort_ + let raftPort = Optic.get ClusterMember.RaftPort_ + let httpPort = Optic.get ClusterMember.HttpPort_ + let wsPort = Optic.get ClusterMember.WsPort_ + let gitPort = Optic.get ClusterMember.GitPort_ + let apiPort = Optic.get ClusterMember.ApiPort_ + let status = Optic.get ClusterMember.Status_ + let state = Optic.get ClusterMember.State_ + + // ** setters + + let setId = Optic.set ClusterMember.Id_ + let setHostName = Optic.set ClusterMember.HostName_ + let setIpAddress = Optic.set ClusterMember.IpAddress_ + let setMulticastAddress = Optic.set ClusterMember.MulticastAddress_ + let setMulticastPort = Optic.set ClusterMember.MulticastPort_ + let setClusterPort = Optic.set ClusterMember.RaftPort_ + let setHttpPort = Optic.set ClusterMember.HttpPort_ + let setWsPort = Optic.set ClusterMember.WsPort_ + let setGitPort = Optic.set ClusterMember.GitPort_ + let setApiPort = Optic.set ClusterMember.ApiPort_ + let setStatus = Optic.set ClusterMember.Status_ + let setState = Optic.set ClusterMember.State_ + + // ** create + + let create id = + #if FABLE_COMPILER + let hostname = Fable.Import.Browser.window.location.host + #else + let hostname = Network.getHostName () + #endif + { Id = id + HostName = name hostname + IpAddress = IPv4Address "127.0.0.1" + MulticastAddress = IpAddress.Parse Constants.DEFAULT_MCAST_ADDRESS + MulticastPort = Measure.port Constants.DEFAULT_MCAST_PORT + HttpPort = Measure.port Constants.DEFAULT_HTTP_PORT + RaftPort = Measure.port Constants.DEFAULT_RAFT_PORT + WsPort = Measure.port Constants.DEFAULT_WEB_SOCKET_PORT + GitPort = Measure.port Constants.DEFAULT_GIT_PORT + ApiPort = Measure.port Constants.DEFAULT_API_PORT + Status = Running + State = Follower } + + // ** toRaftMember + + let toRaftMember (mem:ClusterMember) = + { Id = mem.Id + HostName = mem.HostName + IpAddress = mem.IpAddress + MulticastAddress = mem.MulticastAddress + MulticastPort = mem.MulticastPort + HttpPort = mem.HttpPort + RaftPort = mem.RaftPort + WsPort = mem.WsPort + GitPort = mem.GitPort + ApiPort = mem.ApiPort + Status = mem.Status + State = mem.State + Voting = true + VotedForMe = false + NextIndex = index 1 + MatchIndex = index 0 } + + // ** ofRaftMember + + let ofRaftMember (mem:RaftMember) = + { Id = mem.Id + HostName = mem.HostName + IpAddress = mem.IpAddress + MulticastAddress = mem.MulticastAddress + MulticastPort = mem.MulticastPort + HttpPort = mem.HttpPort + RaftPort = mem.RaftPort + WsPort = mem.WsPort + GitPort = mem.GitPort + ApiPort = mem.ApiPort + Status = mem.Status + State = mem.State } + // * ClusterConfig // ____ _ _ @@ -576,7 +814,7 @@ module HostGroup = type ClusterConfig = { Id: ClusterId Name: Name - Members: Map + Members: Map Groups: HostGroup array } // ** optics @@ -647,21 +885,21 @@ type ClusterConfig = fb.MembersLength |> Array.zeroCreate Array.fold - (fun (m: Either>) _ -> + (fun (m: Either>) _ -> either { let! (idx,members) = m let! mem = #if FABLE_COMPILER fb.Members(idx) - |> RaftMember.FromFB + |> ClusterMember.FromFB #else let memish = fb.Members(idx) if memish.HasValue then let value = memish.Value - RaftMember.FromFB value + ClusterMember.FromFB value else - "Could not parse empty RaftMemberFB" + "Could not parse empty ClusterMemberFB" |> Error.asParseError "Cluster.FromFB" |> Either.fail #endif @@ -1035,12 +1273,28 @@ module ProjectYaml = [] val mutable Name: string [] val mutable Members: string array + // ** ClusterMemberYaml + + type ClusterMemberYaml() = + [] val mutable Id: string + [] val mutable HostName: string + [] val mutable IpAddress: string + [] val mutable MulticastAddress: string + [] val mutable MulticastPort: uint16 + [] val mutable HttpPort: uint16 + [] val mutable RaftPort: uint16 + [] val mutable WsPort: uint16 + [] val mutable GitPort: uint16 + [] val mutable ApiPort: uint16 + [] val mutable State: string + [] val mutable Status: string + // ** SiteYaml type SiteYaml () = [] val mutable Id: string [] val mutable Name: string - [] val mutable Members: RaftMemberYaml array + [] val mutable Members: ClusterMemberYaml array [] val mutable Groups: GroupYaml array // ** DiscoProjectYaml @@ -1254,11 +1508,7 @@ module ProjectYaml = // ** saveTiming - /// ### Transfer the TimingConfig options to the passed configuration file - /// - /// - /// - /// # Returns: ConfigFile + /// Transfer the TimingConfig options to the passed configuration file let internal saveTiming (file: DiscoProjectYaml, config: DiscoConfig) = let timing = TimingYaml() timing.Framebase <- int (config.Timing.Framebase) @@ -1269,14 +1519,55 @@ module ProjectYaml = servers.Add(string srv) timing.Servers <- servers.ToArray() - timing.TCPPort <- int (config.Timing.TCPPort) timing.UDPPort <- int (config.Timing.UDPPort) file.Timing <- timing - (file, config) + // ** parseMember + + let internal parseMember (yaml:ClusterMemberYaml) = + either { + let! id = DiscoId.TryParse yaml.Id + let! ip = IpAddress.TryParse yaml.IpAddress + let! mcastip = IpAddress.TryParse yaml.MulticastAddress + let! state = MemberState.TryParse yaml.State + let! status = MemberStatus.TryParse yaml.Status + return { + Id = id + HostName = name yaml.HostName + MulticastAddress = mcastip + MulticastPort = port yaml.MulticastPort + IpAddress = ip + HttpPort = port yaml.HttpPort + RaftPort = port yaml.RaftPort + WsPort = port yaml.WsPort + GitPort = port yaml.GitPort + ApiPort = port yaml.ApiPort + State = state + Status = status + } + } + // ** saveMember + + let internal saveMember (mem:ClusterMember) = + let yaml = ClusterMemberYaml() + yaml.Id <- string mem.Id + yaml.HostName <- unwrap mem.HostName + yaml.IpAddress <- string mem.IpAddress + yaml.MulticastAddress <- string mem.MulticastAddress + yaml.MulticastPort <- unwrap mem.MulticastPort + yaml.HttpPort <- unwrap mem.HttpPort + yaml.RaftPort <- unwrap mem.RaftPort + yaml.WsPort <- unwrap mem.WsPort + yaml.GitPort <- unwrap mem.GitPort + yaml.ApiPort <- unwrap mem.ApiPort + yaml.State <- string mem.State + yaml.Status <- string mem.Status + yaml + + // ** parseMembers /// ## Parse a collectio of Member definitions @@ -1287,13 +1578,13 @@ module ProjectYaml = /// - mems: MemberYaml collection /// /// Returns: Either - let internal parseMembers mems : Either> = + let internal parseMembers mems : Either> = either { let! (_,mems) = Seq.fold - (fun (m: Either>) mem -> either { + (fun (m: Either>) mem -> either { let! (idx, mems) = m - let! mem = RaftMember.FromYaml mem + let! mem = parseMember mem return (idx + 1, Map.add mem.Id mem mems) }) (Right(0, Map.empty)) @@ -1338,6 +1629,7 @@ module ProjectYaml = // ** parseCluster + /// ### Parse the Cluster configuration section /// /// Parse the cluster configuration section of a given configuration file into a `Cluster` value. @@ -1404,7 +1696,7 @@ module ProjectYaml = cfg.Name <- unwrap cluster.Name for KeyValue(_,mem) in cluster.Members do - let mem = mem.ToYaml() + let mem = saveMember mem members.Add(mem) for group in cluster.Groups do @@ -1634,7 +1926,7 @@ module Config = // ** getMembers - let getMembers (config: DiscoConfig) : Either> = + let getMembers (config: DiscoConfig) : Either> = match config.ActiveSite with | Some active -> match Array.tryFind (fun (clst: ClusterConfig) -> clst.Id = active) config.Sites with @@ -1674,7 +1966,7 @@ module Config = // ** setMembers - let setMembers (mems: Map) (config: DiscoConfig) = + let setMembers (mems: Map) (config: DiscoConfig) = match config.ActiveSite with | Some active -> match Array.tryFind (fun (clst: ClusterConfig) -> clst.Id = active) config.Sites with @@ -1692,7 +1984,7 @@ module Config = // ** validateSettings /// Cross-check the settins in a given cluster member definition with this machines settings - let validateSettings (mem: RaftMember) (machine:DiscoMachine): Either = + let validateSettings (mem: ClusterMember) (machine:DiscoMachine): Either = let errorMsg tag a b = sprintf "Member %s: %O is different from Machine %s: %O\n" tag a tag b let errors = [ @@ -1765,7 +2057,7 @@ module Config = // ** addMember - let addMember (mem: RaftMember) (config: DiscoConfig) = + let addMember (mem: ClusterMember) (config: DiscoConfig) = match config.ActiveSite with | Some active -> match Array.tryFind (fun clst -> ClusterConfig.id clst = active) config.Sites with @@ -2173,11 +2465,9 @@ module Project = /// /// Computes the path to the passed projects' git repository from its `Path` field and checks /// whether it exists. If so, construct a git Repository object and return that. - /// - /// # Returns: Repository option + let repository (project: DiscoProject) = - project.Path - |> Git.Repo.repository + Git.Repo.repository project.Path #endif @@ -2186,7 +2476,7 @@ module Project = let localRemote (project: DiscoProject) = project.Config |> Config.getActiveMember - |> Option.map (Uri.gitUri project.Name) + |> Option.map (fun mem -> Uri.gitUri project.Name mem.IpAddress mem.GitPort) // ** currentBranch @@ -2512,14 +2802,14 @@ module Project = // ** addMember - let addMember (mem: RaftMember) (project: DiscoProject) : DiscoProject = + let addMember (mem: ClusterMember) (project: DiscoProject) : DiscoProject = project.Config |> Config.addMember mem |> flip updateConfig project // ** updateMember - let updateMember (mem: RaftMember) (project: DiscoProject) : DiscoProject = + let updateMember (mem: ClusterMember) (project: DiscoProject) : DiscoProject = addMember mem project // ** removeMember @@ -2541,9 +2831,9 @@ module Project = // ** addMembers - let addMembers (mems: RaftMember list) (project: DiscoProject) : DiscoProject = + let addMembers (mems: ClusterMember list) (project: DiscoProject) : DiscoProject = List.fold - (fun config (mem: RaftMember) -> + (fun config (mem: ClusterMember) -> Config.addMember mem config) project.Config mems @@ -2581,7 +2871,7 @@ module Project = (fun kontinue id peer -> either { do! kontinue if id <> mem.Id then - let url = Uri.gitUri project.Name peer + let url = Uri.gitUri project.Name peer.IpAddress peer.GitPort let name = string peer.Id do! Git.Config.addRemote repo name url |> Either.iterError (string >> Logger.err (tag "updateRemotes")) diff --git a/src/Disco/Disco/Core/StateMachine.fs b/src/Disco/Disco/Core/StateMachine.fs index 5f50980e..6490ad43 100644 --- a/src/Disco/Disco/Core/StateMachine.fs +++ b/src/Disco/Disco/Core/StateMachine.fs @@ -1107,17 +1107,19 @@ module State = // ** addMember let addMember (mem: RaftMember) (state: State) = - { state with Project = Project.addMember mem state.Project } + let mem = ClusterMember.ofRaftMember mem + in { state with Project = Project.addMember mem state.Project } // ** updateMember let updateMember (mem: RaftMember) (state: State) = - { state with Project = Project.updateMember mem state.Project } + let mem = ClusterMember.ofRaftMember mem + in { state with Project = Project.updateMember mem state.Project } // ** removeMember - let removeMember (mem: RaftMember) (state: State) = - { state with Project = Project.removeMember mem.Id state.Project } + let removeMember (mem: MemberId) (state: State) = + { state with Project = Project.removeMember mem state.Project } // ____ _ _ _ // / ___| (_) ___ _ __ | |_ @@ -1246,7 +1248,7 @@ module State = | AddMember mem -> addMember mem state | UpdateMember mem -> updateMember mem state - | RemoveMember mem -> removeMember mem state + | RemoveMember mem -> removeMember mem.Id state | AddClient client -> addClient client state | UpdateClient client -> updateClient client state diff --git a/src/Disco/Disco/Core/Uri.fs b/src/Disco/Disco/Core/Uri.fs index bc23335d..9c550932 100644 --- a/src/Disco/Disco/Core/Uri.fs +++ b/src/Disco/Disco/Core/Uri.fs @@ -84,7 +84,7 @@ module Uri = /// /// Returns: string - let gitUri (name: Name) (mem: RaftMember) = + let gitUri (name: Name) ip port = let path = #if FABLE_COMPILER name @@ -95,4 +95,4 @@ module Uri = |> unwrap |> System.Web.HttpUtility.UrlEncode #endif - toUri HTTP None (Some path) (string mem.IpAddress) (mem.GitPort |> Some) + toUri HTTP None (Some path) (string ip) (Some port) diff --git a/src/Disco/Disco/Net/PubSub.fs b/src/Disco/Disco/Net/PubSub.fs index b1b875d1..ad188eff 100644 --- a/src/Disco/Disco/Net/PubSub.fs +++ b/src/Disco/Disco/Net/PubSub.fs @@ -110,19 +110,19 @@ module rec PubSub = let externalAddress = mem - |> Member.ipAddress + |> ClusterMember.ipAddress |> string |> IPAddress.Parse let remoteAddress = mem - |> Member.multicastAddress + |> ClusterMember.multicastAddress |> string |> IPAddress.Parse let remotePort = mem - |> Member.multicastPort + |> ClusterMember.multicastPort |> int let remoteEp = IPEndPoint(remoteAddress, remotePort) @@ -131,8 +131,7 @@ module rec PubSub = let state = { new IState with member state.Id - with get () = Member.id mem - + with get () = ClusterMember.id mem member state.LocalEndPoint with get () = localEp diff --git a/src/Disco/Disco/Service/ApiServer.fs b/src/Disco/Disco/Service/ApiServer.fs index 1c026cd7..81885e25 100644 --- a/src/Disco/Disco/Service/ApiServer.fs +++ b/src/Disco/Disco/Service/ApiServer.fs @@ -480,7 +480,7 @@ module ApiServer = // ** start - let private start (mem: RaftMember) + let private start (mem: ClusterMember) (store: IAgentStore) (agent: ApiAgent) = either { @@ -521,7 +521,7 @@ module ApiServer = // ** create - let create (mem: RaftMember) callbacks = + let create (mem: ClusterMember) callbacks = either { let cts = new CancellationTokenSource() let store = AgentStore.create () diff --git a/src/Disco/Disco/Service/CommandActions.fs b/src/Disco/Disco/Service/CommandActions.fs index 681c76f1..75fdcfb9 100644 --- a/src/Disco/Disco/Service/CommandActions.fs +++ b/src/Disco/Disco/Service/CommandActions.fs @@ -90,10 +90,10 @@ let listProjects (cfg: DiscoMachine): Either = /// Create a new DiscoProject data structure with given parameters. let buildProject (machine: DiscoMachine) - (name: string) - (path: FilePath) - (raftDir: FilePath) - (mem: RaftMember) = + (name: string) + (path: FilePath) + (raftDir: FilePath) + (mem: ClusterMember) = either { let! project = Project.create (Project.ofFilePath path) name machine @@ -141,7 +141,7 @@ let createProject (machine: DiscoMachine) (opts: CreateProjectOptions) = either do! mkDir raftDir let mem = - { Member.create(machine.MachineId) with + { ClusterMember.create(machine.MachineId) with IpAddress = IpAddress.Parse opts.ipAddr GitPort = port opts.gitPort WsPort = port opts.wsPort diff --git a/src/Disco/Disco/Service/DiscoService.fs b/src/Disco/Disco/Service/DiscoService.fs index aaf6d2da..e69bd306 100644 --- a/src/Disco/Disco/Service/DiscoService.fs +++ b/src/Disco/Disco/Service/DiscoService.fs @@ -62,7 +62,7 @@ module DiscoService = [] type private DiscoState = - { Member: RaftMember + { Member: ClusterMember Machine: DiscoMachine Status: ServiceStatus Store: Store @@ -635,9 +635,9 @@ module DiscoService = let snapshot = DataSnapshot state.Store.State let members = match Config.getActiveSite state.Store.State.Project.Config with - | Some site -> site.Members |> Map.toArray |> Array.map snd + | Some site -> site.Members |> Map.toArray |> Array.map (snd >> ClusterMember.toRaftMember) | _ -> [| |] - (id,yml.Index ,yml.Term ,yml.LastIndex ,yml.LastTerm ,members , snapshot) + (id,yml.Index,yml.Term,yml.LastIndex,yml.LastTerm,members,snapshot) |> Snapshot |> Some with exn -> @@ -711,8 +711,8 @@ module DiscoService = if Map.containsKey machineId site.Members then site else - let selfMember = - { Member.create(machineId) with + let selfMember: ClusterMember = + { ClusterMember.create(machineId) with IpAddress = serviceOptions.Machine.BindAddress GitPort = serviceOptions.Machine.GitPort WsPort = serviceOptions.Machine.WsPort diff --git a/src/Disco/Disco/Service/GitServer.fs b/src/Disco/Disco/Service/GitServer.fs index d9ae090f..4f749881 100644 --- a/src/Disco/Disco/Service/GitServer.fs +++ b/src/Disco/Disco/Service/GitServer.fs @@ -118,7 +118,7 @@ module GitServer = // ** create - let create (mem: RaftMember) (project: DiscoProject) = + let create (mem: ClusterMember) (project: DiscoProject) = let mutable status = ServiceStatus.Stopped let cts = new CancellationTokenSource() let subscriptions = Subscriptions() diff --git a/src/Disco/Disco/Service/Persistence.fs b/src/Disco/Disco/Service/Persistence.fs index 36bdaf2a..059958d0 100644 --- a/src/Disco/Disco/Service/Persistence.fs +++ b/src/Disco/Disco/Service/Persistence.fs @@ -42,8 +42,9 @@ module Persistence = let! mems = Config.getMembers options let state = mem + |> ClusterMember.toRaftMember |> Raft.create - |> Raft.addMembers mems + |> Raft.addMembers (Map.map (fun _ -> ClusterMember.toRaftMember) mems) |> Raft.setMaxLogDepth options.Raft.MaxLogDepth |> Raft.setRequestTimeout options.Raft.RequestTimeout |> Raft.setElectionTimeout options.Raft.ElectionTimeout @@ -75,9 +76,9 @@ module Persistence = let! state = Yaml.decode data return { state with - Member = mem + Member = ClusterMember.toRaftMember mem NumMembers = count - Peers = mems + Peers = Map.map (fun _ -> ClusterMember.toRaftMember) mems MaxLogDepth = options.Raft.MaxLogDepth RequestTimeout = options.Raft.RequestTimeout ElectionTimeout = options.Raft.ElectionTimeout } @@ -313,7 +314,7 @@ module Persistence = // ** getRemote let getRemote (project: DiscoProject) (repo: Repository) (leader: RaftMember) = - let uri = Uri.gitUri project.Name leader + let uri = Uri.gitUri project.Name leader.IpAddress leader.GitPort match Git.Config.tryFindRemote repo (string leader.Id) with | None -> leader.Id @@ -335,7 +336,7 @@ module Persistence = // ** ensureRemote let ensureRemote (project: DiscoProject) (repo: Repository) (peer: RaftMember) = - let uri = Uri.gitUri project.Name peer + let uri = Uri.gitUri project.Name peer.IpAddress peer.GitPort match Git.Config.tryFindRemote repo (string peer.Id) with | None -> peer.Id diff --git a/src/Disco/Disco/Service/WebSocket.fs b/src/Disco/Disco/Service/WebSocket.fs index 36d8e993..6ce69273 100644 --- a/src/Disco/Disco/Service/WebSocket.fs +++ b/src/Disco/Disco/Service/WebSocket.fs @@ -261,7 +261,7 @@ module WebSocketServer = // ** create - let create (mem: RaftMember) = + let create (mem: ClusterMember) = either { let status = ref ServiceStatus.Stopped let connections = Connections() diff --git a/src/Disco/Disco/Tests/Core/ApiTests.fs b/src/Disco/Disco/Tests/Core/ApiTests.fs index 27190f5e..4d664f29 100644 --- a/src/Disco/Disco/Tests/Core/ApiTests.fs +++ b/src/Disco/Disco/Tests/Core/ApiTests.fs @@ -57,7 +57,7 @@ module ApiTests = either { let mutable store = Store(mkState ()) - let mem = Member.create (DiscoId.Create()) + let mem = ClusterMember.create (DiscoId.Create()) use! server1 = ApiServer.create mem { new IApiServerCallbacks with @@ -82,7 +82,7 @@ module ApiTests = either { let mutable store = Store(mkState ()) - let mem = Member.create (DiscoId.Create()) + let mem = ClusterMember.create (DiscoId.Create()) use! server = ApiServer.create mem { new IApiServerCallbacks with @@ -150,7 +150,7 @@ module ApiTests = either { let store = Store(mkState ()) - let mem = Member.create (DiscoId.Create()) + let mem = ClusterMember.create (DiscoId.Create()) use! server = ApiServer.create mem { new IApiServerCallbacks with @@ -238,7 +238,7 @@ module ApiTests = let store = Store(mkState ()) - let mem = Member.create (DiscoId.Create()) + let mem = ClusterMember.create (DiscoId.Create()) let srvr : DiscoServer = { Port = mem.ApiPort @@ -356,7 +356,7 @@ module ApiTests = testCase "server should dispose properly" <| fun _ -> either { let store = Store(mkState ()) - let mem = Member.create (DiscoId.Create()) + let mem = ClusterMember.create (DiscoId.Create()) use! server = ApiServer.create mem { new IApiServerCallbacks with diff --git a/src/Disco/Disco/Tests/Core/Disco/Common.fs b/src/Disco/Disco/Tests/Core/Disco/Common.fs index 7d7638e7..b8cee33c 100644 --- a/src/Disco/Disco/Tests/Core/Disco/Common.fs +++ b/src/Disco/Disco/Tests/Core/Disco/Common.fs @@ -80,7 +80,10 @@ module Common = let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = members |> List.map (fun mem -> mem.Id,mem) |> Map.ofList } + Members = + members + |> List.map (fun mem -> mem.Id,ClusterMember.ofRaftMember mem) + |> Map.ofList } let project = List.fold diff --git a/src/Disco/Disco/Tests/Core/Generators.fs b/src/Disco/Disco/Tests/Core/Generators.fs index fa5f3b24..34327b1d 100644 --- a/src/Disco/Disco/Tests/Core/Generators.fs +++ b/src/Disco/Disco/Tests/Core/Generators.fs @@ -247,6 +247,41 @@ module Generators = } } + /// ____ _ _ __ __ _ + /// / ___| |_ _ ___| |_ ___ _ __| \/ | ___ _ __ ___ | |__ ___ _ __ + /// | | | | | | / __| __/ _ \ '__| |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| + /// | |___| | |_| \__ \ || __/ | | | | | __/ | | | | | |_) | __/ | + /// \____|_|\__,_|___/\__\___|_| |_| |_|\___|_| |_| |_|_.__/ \___|_| + + let clusterMemberGen = gen { + let! id = idGen + let! n = nameGen + let! ip = ipGen + let! p = portGen + let! wp = portGen + let! ap = portGen + let! hp = portGen + let! gp = portGen + let! mcst = ipGen + let! mp = portGen + let! state = raftStateGen + let! status = memberStatusGen + return { + Id = id + HostName = n + IpAddress = ip + MulticastAddress = mcst + MulticastPort = mp + RaftPort = p + HttpPort = hp + WsPort = wp + GitPort = gp + ApiPort = ap + State = state + Status = status + } + } + let raftMemArr = Gen.arrayOfLength 2 raftMemberGen // _ _ _ @@ -338,7 +373,7 @@ module Generators = let clusterGen = gen { let! id = idGen let! nm = nameGen - let! mems = mapGen raftMemberGen + let! mems = mapGen clusterMemberGen let! groups = Gen.arrayOf hostgroupGen return { Id = id diff --git a/src/Disco/Disco/Tests/Core/GitTests.fs b/src/Disco/Disco/Tests/Core/GitTests.fs index 97795427..1e10f9d9 100644 --- a/src/Disco/Disco/Tests/Core/GitTests.fs +++ b/src/Disco/Disco/Tests/Core/GitTests.fs @@ -30,7 +30,7 @@ module GitTests = let config = machine |> Config.create - |> Config.setMembers (Map.ofArray [| (mem.Id,mem) |]) + |> Config.setMembers (Map.ofArray [| (mem.Id, ClusterMember.ofRaftMember mem) |]) |> Config.setLogLevel Debug let project = @@ -92,7 +92,7 @@ module GitTests = let uuid, tmpdir, project, mem, path = mkEnvironment 10000us - use gitserver = GitServer.create mem path + use gitserver = GitServer.create (ClusterMember.ofRaftMember mem) path do! gitserver.Start() expect "Should be running" true Service.isRunning gitserver.Status @@ -111,7 +111,7 @@ module GitTests = | DiscoEvent.Started _ -> started.Set() |> ignore | _ -> () - use gitserver1 = GitServer.create mem path + use gitserver1 = GitServer.create (ClusterMember.ofRaftMember mem) path use gobs1 = gitserver1.Subscribe(handleStarted) do! gitserver1.Start() @@ -119,7 +119,7 @@ module GitTests = expect "Should be running" true Service.isRunning gitserver1.Status - use gitserver2 = GitServer.create mem path + use gitserver2 = GitServer.create (ClusterMember.ofRaftMember mem) path do! match gitserver2.Start() with | Right () -> Left (Other("test","Should have failed to start")) | Left error -> Right () @@ -141,7 +141,7 @@ module GitTests = let uuid, tmpdir, project, mem, path = mkEnvironment port - use gitserver = GitServer.create mem path + use gitserver = GitServer.create (ClusterMember.ofRaftMember mem) path use gobs1 = gitserver.Subscribe(handleStarted) do! gitserver.Start() @@ -153,8 +153,7 @@ module GitTests = let target = mkTmpDir () let repo = - mem - |> Uri.gitUri path.Name + Uri.gitUri path.Name mem.IpAddress mem.GitPort |> unwrap |> Git.Repo.clone target diff --git a/src/Disco/Disco/Tests/Core/NetTests.fs b/src/Disco/Disco/Tests/Core/NetTests.fs index ea23580a..7a5506e9 100644 --- a/src/Disco/Disco/Tests/Core/NetTests.fs +++ b/src/Disco/Disco/Tests/Core/NetTests.fs @@ -227,7 +227,7 @@ module NetIntegrationTests = let test_pub_socket_disposes_properly = testCase "pub socket disposes properly" <| fun _ -> either { - let mem = DiscoId.Create() |> Member.create + let mem = DiscoId.Create() |> ClusterMember.create use pub = PubSub.create mem do! pub.Start() } diff --git a/src/Disco/Disco/Tests/Core/ProjectTests.fs b/src/Disco/Disco/Tests/Core/ProjectTests.fs index 9326480e..db3e60a7 100644 --- a/src/Disco/Disco/Tests/Core/ProjectTests.fs +++ b/src/Disco/Disco/Tests/Core/ProjectTests.fs @@ -144,7 +144,11 @@ module ProjectTests = let cluster = { Id = DiscoId.Create() Name = name "A mighty cool cluster" - Members = Map.ofArray [| (memA.Id,memA); (memB.Id,memB) |] + Members = + Map.ofArray [| + (memA.Id, ClusterMember.ofRaftMember memA) + (memB.Id, ClusterMember.ofRaftMember memB) + |] Groups = [| groupA; groupB |] } let! project = Project.create (Project.ofFilePath path) (unwrap fn) machine diff --git a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs index 9fddcd6e..ba470a38 100644 --- a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs +++ b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs @@ -44,8 +44,11 @@ module RaftIntegrationTests = let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem1.Id, mem1) - (mem2.Id, mem2) |] } + Members = + Map.ofArray [| + (mem1.Id, ClusterMember.ofRaftMember mem1) + (mem2.Id, ClusterMember.ofRaftMember mem2) + |] } let leadercfg = machine1 |> Config.create @@ -97,7 +100,7 @@ module RaftIntegrationTests = let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem.Id, mem) |] } + Members = Map.ofArray [| (mem.Id, ClusterMember.ofRaftMember mem) |] } let leadercfg = machine @@ -165,8 +168,8 @@ module RaftIntegrationTests = let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem1.Id, mem1) - (mem2.Id, mem2) |] } + Members = Map.ofArray [| (mem1.Id, ClusterMember.ofRaftMember mem1) + (mem2.Id, ClusterMember.ofRaftMember mem2) |] } let leadercfg = machine1 @@ -224,7 +227,7 @@ module RaftIntegrationTests = let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem1.Id, mem1) |] } + Members = Map.ofArray [| (mem1.Id, ClusterMember.ofRaftMember mem1) |] } let leadercfg = machine1 @@ -311,10 +314,10 @@ module RaftIntegrationTests = let site1 = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem1.Id, mem1) |] } + Members = Map.ofArray [| (mem1.Id, ClusterMember.ofRaftMember mem1) |] } let site2 = - { site1 with Members = Map.ofArray [| (mem2.Id, mem2) |] } + { site1 with Members = Map.ofArray [| (mem2.Id, ClusterMember.ofRaftMember mem2) |] } let leadercfg = machine1 diff --git a/src/Disco/Disco/Tests/Core/SerializationTests.fs b/src/Disco/Disco/Tests/Core/SerializationTests.fs index 81ced217..549097d8 100644 --- a/src/Disco/Disco/Tests/Core/SerializationTests.fs +++ b/src/Disco/Disco/Tests/Core/SerializationTests.fs @@ -280,58 +280,6 @@ module SerializationTests = |> Prop.forAll Generators.raftResponseArb |> Check.QuickThrowOnFailure - // ____ __ _ - // | _ \ __ _ / _| |_ - // | |_) / _` | |_| __| - // | _ < (_| | _| |_ - // |_| \_\__,_|_| \__| - - let test_save_restore_raft_value_correctly = - testCase "save/restore raft value correctly" <| fun _ -> - either { - let machine = MachineConfig.create "127.0.0.1" None - - let self = - machine.MachineId - |> Member.create - - let mem1 = - DiscoId.Create() - |> Member.create - - let mem2 = - DiscoId.Create() - |> Member.create - - let site = - { ClusterConfig.Default with - Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (self.Id,self) - (mem1.Id, mem1) - (mem2.Id, mem2) |] } - - let config = - machine - |> Config.create - |> Config.addSiteAndSetActive site - - let trm = term 666 - - let! raft = - createRaft config - |> Either.map (Raft.setTerm trm) - - saveRaft config raft - |> Either.mapError Error.throw - |> ignore - - let! loaded = loadRaft config - - expect "Member should be correct" self Raft.self loaded - expect "Term should be correct" trm Raft.currentTerm loaded - } - |> noError - // ____ _ _ // | _ \ _ __ ___ (_) ___ ___| |_ // | |_) | '__/ _ \| |/ _ \/ __| __| @@ -614,7 +562,6 @@ module SerializationTests = test_command_batch test_correct_request_serialization tests_parse_state_deserialization - test_save_restore_raft_value_correctly test_validate_config_change test_validate_user_yaml_serialization test_validate_user_binary_serialization diff --git a/src/Disco/Schema/Core.fbs b/src/Disco/Schema/Core.fbs index c194e188..08476449 100644 --- a/src/Disco/Schema/Core.fbs +++ b/src/Disco/Schema/Core.fbs @@ -675,10 +675,25 @@ table HostGroupFB { Members: [ string ]; } +table ClusterMemberFB { + Id: [ubyte]; + HostName: string; + IpAddress: string; + MulticastAddress: string; + MulticastPort: ushort; + HttpPort: ushort; + RaftPort: ushort; + WsPort: ushort; + GitPort: ushort; + ApiPort: ushort; + State: MemberStateFB; + Status: MemberStatusFB; +} + table ClusterConfigFB { Id: [ubyte]; Name: string; - Members: [ RaftMemberFB ]; + Members: [ ClusterMemberFB ]; Groups: [ HostGroupFB ]; } diff --git a/src/Disco/Serialization.csproj b/src/Disco/Serialization.csproj index 311a028f..64753d1b 100644 --- a/src/Disco/Serialization.csproj +++ b/src/Disco/Serialization.csproj @@ -43,6 +43,128 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -63,6 +185,7 @@ + diff --git a/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs b/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs index d8372200..89a43b7b 100644 --- a/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs +++ b/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs @@ -1588,13 +1588,52 @@ type HostGroupFBConstructor = let HostGroupFB: HostGroupFBConstructor = failwith "JS only" +// CLUSTER MEMBER + +type ClusterMemberFB = + abstract Id: int -> byte + abstract IdLength: int + abstract HostName: string + abstract IpAddress: string + abstract MulticastAddress: string + abstract MulticastPort: uint16 + abstract RaftPort: uint16 + abstract HttpPort: uint16 + abstract WsPort: uint16 + abstract GitPort: uint16 + abstract ApiPort: uint16 + abstract State: MemberStateFB + abstract Status: MemberStatusFB + +type ClusterMemberFBConstructor = + abstract prototype: ClusterMemberFB with get, set + abstract StartClusterMemberFB: builder: FlatBufferBuilder -> unit + abstract AddId: builder: FlatBufferBuilder * id: VectorOffset -> unit + abstract AddHostName: builder: FlatBufferBuilder * hostname: Offset -> unit + abstract AddIpAddress: builder: FlatBufferBuilder * ip: Offset -> unit + abstract AddMulticastAddress: builder: FlatBufferBuilder * addr: Offset -> unit + abstract AddMulticastPort: builder: FlatBufferBuilder * port: uint16 -> unit + abstract AddRaftPort: builder: FlatBufferBuilder * port: uint16 -> unit + abstract AddHttpPort: builder: FlatBufferBuilder * port: uint16 -> unit + abstract AddWsPort: builder: FlatBufferBuilder * port: uint16 -> unit + abstract AddGitPort: builder: FlatBufferBuilder * port: uint16 -> unit + abstract AddApiPort: builder: FlatBufferBuilder * port: uint16 -> unit + abstract AddState: builder: FlatBufferBuilder * state: MemberStateFB -> unit + abstract AddStatus: builder: FlatBufferBuilder * state: MemberStatusFB -> unit + abstract EndClusterMemberFB: builder: FlatBufferBuilder -> Offset + abstract GetRootAsClusterMemberFB: bytes: ByteBuffer -> ClusterMemberFB + abstract CreateIdVector: builder: FlatBufferBuilder * id:byte array -> VectorOffset + abstract Create: unit -> ClusterMemberFB + +let ClusterMemberFB: ClusterMemberFBConstructor = failwith "JS only" + // CLUSTER CONFIG type ClusterConfigFB = abstract Id: int -> byte abstract IdLength: int abstract Name: string - abstract Members: int -> RaftMemberFB + abstract Members: int -> ClusterMemberFB abstract MembersLength: int abstract Groups: int -> HostGroupFB abstract GroupsLength: int @@ -1605,7 +1644,7 @@ type ClusterConfigFBConstructor = abstract AddId: builder: FlatBufferBuilder * id:VectorOffset -> unit abstract AddName: builder: FlatBufferBuilder * name:Offset -> unit abstract AddMembers: builder: FlatBufferBuilder * mems:Offset<'a> -> unit - abstract CreateMembersVector: FlatBufferBuilder * Offset array -> Offset<'a> + abstract CreateMembersVector: FlatBufferBuilder * Offset array -> Offset<'a> abstract AddGroups: builder: FlatBufferBuilder * mems:Offset<'a> -> unit abstract CreateIdVector: FlatBufferBuilder * id:byte array -> VectorOffset abstract CreateGroupsVector: FlatBufferBuilder * Offset array -> Offset<'a> diff --git a/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs b/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs index be4b4bca..4b4a7251 100644 --- a/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs +++ b/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs @@ -255,13 +255,13 @@ type AssetBrowserView(props) = // ** renderMachine - member this.renderMachine trees (node:RaftMember) = + member this.renderMachine trees (node:ClusterMember) = let isOpen = match this.state.Machine with | Some id when id = node.Id -> true | _ -> false - let nodeId = Member.id node + let nodeId = ClusterMember.id node let directories = if isOpen then @@ -301,7 +301,7 @@ type AssetBrowserView(props) = |> Option.bind (fun id -> List.tryFind (fun site -> ClusterConfig.id site = id) sites) |> Option.map (ClusterConfig.members >> Map.toList) |> Option.defaultValue List.empty - |> List.sortBy (snd >> Member.hostName) + |> List.sortBy (snd >> ClusterMember.hostName) |> List.map (snd >> this.renderMachine trees) div [ Class "machines" ] members diff --git a/src/Frontend/src/Frontend/Elmish/ClusterView.fs b/src/Frontend/src/Frontend/Elmish/ClusterView.fs index 306de5d0..19735faa 100644 --- a/src/Frontend/src/Frontend/Elmish/ClusterView.fs +++ b/src/Frontend/src/Frontend/Elmish/ClusterView.fs @@ -91,7 +91,11 @@ let activeConfig dispatch state = OnClick (fun ev -> ev.stopPropagation() match Config.findMember config kv.Key with - | Right mem -> RemoveMember mem |> ClientContext.Singleton.Post + | Right mem -> + mem + |> ClusterMember.toRaftMember + |> RemoveMember + |> ClientContext.Singleton.Post | Left error -> printfn "Cannot find member in config: %O" error) ] [] ] diff --git a/src/Frontend/src/Frontend/Elmish/Helpers.fs b/src/Frontend/src/Frontend/Elmish/Helpers.fs index b4c029dc..5568b8af 100644 --- a/src/Frontend/src/Frontend/Elmish/Helpers.fs +++ b/src/Frontend/src/Frontend/Elmish/Helpers.fs @@ -140,7 +140,7 @@ module Select = |> Msg.SelectElement |> dispatch - let clusterMember dispatch (mem: RaftMember) = + let clusterMember dispatch (mem: ClusterMember) = (mem.HostName, mem.Id) |> InspectorSelection.Member |> Msg.SelectElement diff --git a/src/Frontend/src/Frontend/Elmish/Inspectors/MemberInspector.fs b/src/Frontend/src/Frontend/Elmish/Inspectors/MemberInspector.fs index a01640d8..9ecc27a9 100644 --- a/src/Frontend/src/Frontend/Elmish/Inspectors/MemberInspector.fs +++ b/src/Frontend/src/Frontend/Elmish/Inspectors/MemberInspector.fs @@ -23,7 +23,7 @@ module MemberInspector = (string client.Name) (fun _ -> Select.client dispatch client) - let private renderClients tag dispatch (model: Model) (mem: RaftMember) = + let private renderClients tag dispatch (model: Model) (mem: ClusterMember) = match model.state with | None -> Common.row tag [] | Some state -> diff --git a/src/Frontend/src/Frontend/MockData.fs b/src/Frontend/src/Frontend/MockData.fs index bdab0a40..52386cec 100644 --- a/src/Frontend/src/Frontend/MockData.fs +++ b/src/Frontend/src/Frontend/MockData.fs @@ -206,7 +206,7 @@ let project = List.map (fun (machine: DiscoMachine) -> let mem = - { Disco.Raft.Member.create machine.MachineId with + { ClusterMember.create machine.MachineId with HostName = machine.HostName Status = rndState() } (mem.Id, mem)) From b391981ad46ac1ca4a55e3293de4b3f3483de659 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Wed, 10 Jan 2018 18:39:49 +0100 Subject: [PATCH 02/27] minor refactorings in raft --- src/Disco/Disco/Raft/Raft.fs | 75 ++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 38 deletions(-) diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index 412877d6..5fd5e05c 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -1129,34 +1129,34 @@ module rec Raft = let entriesUntilExcludingM (idx: Index) = entriesUntilExcluding idx |> zoomM - // ** handleConfigChange - - let private handleConfigChange (log: RaftLogEntry) (state: RaftState) = - match log with - | Configuration(_,_,_,mems,_) -> - let parting = - mems - |> Array.map (fun (mem: RaftMember) -> mem.Id) - |> Array.contains state.Member.Id - |> not - - let peers = - if parting then // we have been kicked out of the configuration - [| (state.Member.Id, state.Member) |] - |> Map.ofArray - else // we are still part of the new cluster configuration - Array.map toPair mems - |> Map.ofArray - - state - |> setPeers peers - |> setOldPeers None - | JointConsensus(_,_,_,changes,_) -> - let old = state.Peers - state - |> applyChanges changes - |> setOldPeers (Some old) - | _ -> state + // ** handleConfiguration + + let private handleConfiguration mems (state: RaftState) = + let parting = + mems + |> Array.map (fun (mem: RaftMember) -> mem.Id) + |> Array.contains state.Member.Id + |> not + + let peers = + if parting then // we have been kicked out of the configuration + [| (state.Member.Id, state.Member) |] + |> Map.ofArray + else // we are still part of the new cluster configuration + Array.map toPair mems + |> Map.ofArray + + state + |> setPeers peers + |> setOldPeers None + + // ** handleJointConsensus + + let private handleJointConsensus (changes) (state:RaftState) = + let old = state.Peers + state + |> applyChanges changes + |> setOldPeers (Some old) // ** appendEntry @@ -1891,25 +1891,24 @@ module rec Raft = // Apply log chain in the order it arrived let state, change = LogEntry.foldr - (fun (state, current) lg -> - match lg with - | Configuration _ as config -> + (fun (state, current) -> function + | Configuration(_,_,_,mems,_) as config -> // set the peers map - let newstate = handleConfigChange config state + let newstate = handleConfiguration mems state // when a new configuration is added, under certain circumstances a mem change // might not have been applied yet, so calculate those dangling changes let changes = calculateChanges state.Peers newstate.Peers // apply dangling changes - Array.iter (notifyChange cbs) changes + do Array.iter (notifyChange cbs) changes // apply the entry by calling the callback - applyEntry cbs config + do applyEntry cbs config (newstate, None) - | JointConsensus _ as config -> - let state = handleConfigChange config state - applyEntry cbs config + | JointConsensus(_,_,_,changes,_) as config -> + let state = handleJointConsensus changes state + do applyEntry cbs config (state, Some (LogEntry.head config)) | entry -> - applyEntry cbs entry + do applyEntry cbs entry (state, current)) (state, state.ConfigChangeEntry) entries From 3a311b60cefc6ceb3452d186ac8e36af1e884bfc Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Thu, 25 Jan 2018 08:45:55 +0100 Subject: [PATCH 03/27] remove unused buffer manager in tcp server --- src/Disco/Disco/Net/TcpServer.fs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/Disco/Disco/Net/TcpServer.fs b/src/Disco/Disco/Net/TcpServer.fs index 44aad545..0a9c3e4d 100644 --- a/src/Disco/Disco/Net/TcpServer.fs +++ b/src/Disco/Disco/Net/TcpServer.fs @@ -68,7 +68,6 @@ module TcpServer = inherit IDisposable abstract Connections: Connections abstract Subscriptions: Subscriptions - abstract BufferManager: IBufferManager abstract BufferedArgs: BufferedArgs abstract Listener: Socket abstract EndPoint: IPEndPoint @@ -79,7 +78,7 @@ module TcpServer = // *** cleanUp - let cleanUp (connections: Connections) = function + let private cleanUp (connections: Connections) = function | TcpServerEvent.Disconnect id -> match connections.TryRemove id with | true, connection -> @@ -104,17 +103,12 @@ module TcpServer = new SocketAsyncEventArgs() |> args.Add - let manager = BufferManager.create Core.MAX_CONNECTIONS Core.BUFFER_SIZE - let cleaner = connections |> cleanUp |> flip Observable.subscribe subscriptions { new IState with - member state.BufferManager - with get () = manager - member state.BufferedArgs with get () = args From 9c7da16d15ee3da7410f6929240fa7e6b8547e3f Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Tue, 30 Jan 2018 12:02:12 +0100 Subject: [PATCH 04/27] deduplicating RaftMember and ClusterMember types --- src/Disco/Disco/Client/ApiRequest.fs | 56 +++++- src/Disco/Disco/Core/Actor.fs | 4 +- src/Disco/Disco/Core/Interfaces.fs | 46 ++--- src/Disco/Disco/Core/Machine.fs | 6 +- src/Disco/Disco/Core/Project.fs | 184 ++++++++---------- src/Disco/Disco/Core/StateMachine.fs | 143 ++++++++++++-- src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs | 4 - .../Disco/Nodes/Nodes/ClusterConfigNode.fs | 2 +- src/Disco/Disco/Nodes/Nodes/ConfigNode.fs | 8 +- src/Disco/Disco/Nodes/Nodes/MemberNode.fs | 28 +-- src/Disco/Disco/Raft/Member.fs | 124 +----------- src/Disco/Disco/Service/CommandActions.fs | 2 +- src/Disco/Disco/Service/DiscoService.fs | 89 +++++---- src/Disco/Disco/Service/Interfaces.fs | 8 +- src/Disco/Disco/Service/Persistence.fs | 6 +- src/Disco/Disco/Service/RaftServer.fs | 15 +- src/Disco/Disco/Tests/Core/ApiTests.fs | 4 +- src/Disco/Disco/Tests/Core/Disco/Common.fs | 8 +- .../Disco/RemoveMemberShouldSplitCluster.fs | 2 +- src/Disco/Disco/Tests/Core/Generators.fs | 29 +-- src/Disco/Disco/Tests/Core/GitTests.fs | 16 +- src/Disco/Disco/Tests/Core/ProjectTests.fs | 26 +-- .../Disco/Tests/Core/RaftIntegrationTests.fs | 87 +++++---- .../Disco/Tests/Core/SerializationTests.fs | 4 +- src/Disco/Schema/Api.fbs | 1 + src/Disco/Schema/Core.fbs | 1 + src/Disco/Serialization.csproj | 122 ------------ .../src/Core.Frontend/FlatBufferTypes.fs | 2 + .../src/Frontend/Elmish/AssetBrowserView.fs | 2 +- .../src/Frontend/Elmish/ClusterView.fs | 6 +- .../src/Frontend/Elmish/ProjectView.fs | 2 +- src/Frontend/src/Frontend/Lib.fs | 13 +- src/Frontend/src/Frontend/MockData.fs | 2 +- .../src/Tests.Frontend/SerializationTests.fs | 113 ++++++----- 34 files changed, 536 insertions(+), 629 deletions(-) diff --git a/src/Disco/Disco/Client/ApiRequest.fs b/src/Disco/Disco/Client/ApiRequest.fs index abbac646..69d11dd7 100644 --- a/src/Disco/Disco/Client/ApiRequest.fs +++ b/src/Disco/Disco/Client/ApiRequest.fs @@ -157,6 +157,13 @@ type ApiRequest = | Update (AddMember mem as cmd) | Update (UpdateMember mem as cmd) | Update (RemoveMember mem as cmd) -> + mem + |> Binary.toOffset builder + |> withPayload ParameterFB.ClusterMemberFB cmd.ApiCommand + + | Update (AddMachine mem as cmd) + | Update (UpdateMachine mem as cmd) + | Update (RemoveMachine mem as cmd) -> mem |> Binary.toOffset builder |> withPayload ParameterFB.RaftMemberFB cmd.ApiCommand @@ -516,7 +523,7 @@ type ApiRequest = "Empty RaftMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" |> Either.fail - return ApiRequest.Update (AddMember mem) + return ApiRequest.Update (AddMachine mem) } | ApiCommandFB.UpdateFB, ParameterFB.RaftMemberFB -> either { @@ -529,7 +536,7 @@ type ApiRequest = "Empty RaftMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" |> Either.fail - return ApiRequest.Update (UpdateMember mem) + return ApiRequest.Update (UpdateMachine mem) } | ApiCommandFB.RemoveFB, ParameterFB.RaftMemberFB -> either { @@ -542,6 +549,51 @@ type ApiRequest = "Empty RaftMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" |> Either.fail + return ApiRequest.Update (RemoveMachine mem) + } + + // __ __ _ + // | \/ | ___ _ __ ___ | |__ ___ _ __ + // | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| + // | | | | __/ | | | | | |_) | __/ | + // |_| |_|\___|_| |_| |_|_.__/ \___|_| + | ApiCommandFB.AddFB, ParameterFB.ClusterMemberFB -> + either { + let! mem = + let memish = fb.Parameter() + if memish.HasValue then + let value = memish.Value + ClusterMember.FromFB value + else + "Empty ClusterMemberFB payload" + |> Error.asParseError "ApiRequest.FromFB" + |> Either.fail + return ApiRequest.Update (AddMember mem) + } + | ApiCommandFB.UpdateFB, ParameterFB.ClusterMemberFB -> + either { + let! mem = + let memish = fb.Parameter() + if memish.HasValue then + let value = memish.Value + ClusterMember.FromFB value + else + "Empty ClusterMemberFB payload" + |> Error.asParseError "ApiRequest.FromFB" + |> Either.fail + return ApiRequest.Update (UpdateMember mem) + } + | ApiCommandFB.RemoveFB, ParameterFB.ClusterMemberFB -> + either { + let! mem = + let memish = fb.Parameter() + if memish.HasValue then + let value = memish.Value + ClusterMember.FromFB value + else + "Empty ClusterMemberFB payload" + |> Error.asParseError "ApiRequest.FromFB" + |> Either.fail return ApiRequest.Update (RemoveMember mem) } diff --git a/src/Disco/Disco/Core/Actor.fs b/src/Disco/Disco/Core/Actor.fs index 96d2dfd2..da8c683e 100644 --- a/src/Disco/Disco/Core/Actor.fs +++ b/src/Disco/Disco/Core/Actor.fs @@ -70,7 +70,7 @@ module AsyncActor = // ** loop - let private loop<'a> tag actor (f: AsyncActorTask<'a>) (inbox: MailboxProcessor<'a>) = + let private loop<'a> _ actor (f: AsyncActorTask<'a>) (inbox: MailboxProcessor<'a>) = let rec _loop () = async { let! msg = inbox.Receive() @@ -112,7 +112,7 @@ module ThreadActor = // ** loop - let private loop<'a> tag (queue: Queue<'a>) (actor: IActor<'a>) (f: ActorTask<'a>) () = + let private loop<'a> _ (queue: Queue<'a>) (actor: IActor<'a>) (f: ActorTask<'a>) () = let mutable run = true try while run do diff --git a/src/Disco/Disco/Core/Interfaces.fs b/src/Disco/Disco/Core/Interfaces.fs index d02ddb80..de42134f 100644 --- a/src/Disco/Disco/Core/Interfaces.fs +++ b/src/Disco/Disco/Core/Interfaces.fs @@ -166,7 +166,6 @@ type DiscoEvent = // | _| | | | __/___) | |_| \__ \ || __/ | | | | | // |_| |_|_|\___|____/ \__, |___/\__\___|_| |_| |_| // |___/ - | FileSystem _ -> Ignore // ____ __ _ @@ -174,7 +173,6 @@ type DiscoEvent = // | |_) / _` | |_| __| // | _ < (_| | _| |_ // |_| \_\__,_|_| \__| - | ConfigurationDone _ | EnterJointConsensus _ | StateChanged _ @@ -187,7 +185,6 @@ type DiscoEvent = // | | _| | __| // | |_| | | |_ // \____|_|\__| - | GitPull _ | GitPush _ -> Process @@ -196,7 +193,6 @@ type DiscoEvent = // \ \ /\ / / _ \ '_ \___ \ / _ \ / __| |/ / _ \ __| // \ V V / __/ |_) |__) | (_) | (__| < __/ |_ // \_/\_/ \___|_.__/____/ \___/ \___|_|\_\___|\__| - | SessionOpened _ | SessionClosed _ -> Replicate @@ -209,7 +205,6 @@ type DiscoEvent = // | _ \ / _` | __/ __| '_ \ // | |_) | (_| | || (__| | | | // |____/ \__,_|\__\___|_| |_| - | Append (Origin.Client _, CommandBatch _) | Append (Origin.Service _, CommandBatch _) | Append (Origin.Web _, CommandBatch _) -> Replicate @@ -220,7 +215,6 @@ type DiscoEvent = // | | | | (_| | |_) | |_) | | | | | (_| | // |_| |_|\__,_| .__/| .__/|_|_| |_|\__, | // |_| |_| |___/ - | Append (Origin.Client _, AddPinMapping _) | Append (Origin.Service _, AddPinMapping _) | Append (Origin.Web _, AddPinMapping _) @@ -237,7 +231,6 @@ type DiscoEvent = // \ V V / | | (_| | (_| | __/ |_ // \_/\_/ |_|\__,_|\__, |\___|\__| // |___/ - | Append (Origin.Client _, AddPinWidget _) | Append (Origin.Service _, AddPinWidget _) | Append (Origin.Web _, AddPinWidget _) @@ -254,7 +247,6 @@ type DiscoEvent = // | __/| | | (_) | | __/ (__| |_ // |_| |_| \___// |\___|\___|\__| // |__/ - | Append (Origin.Web _, UnloadProject) -> Replicate | Append (Origin.Client _, UnloadProject) -> Ignore | Append (Origin.Service _, UnloadProject) -> Replicate @@ -268,23 +260,33 @@ type DiscoEvent = // | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| // | | | | __/ | | | | | |_) | __/ | // |_| |_|\___|_| |_| |_|_.__/ \___|_| + | Append (Origin.Web _, AddMachine _) -> Replicate + | Append (Origin.Web _, UpdateMachine _) -> Ignore + | Append (Origin.Web _, RemoveMachine _) -> Replicate + | Append (Origin.Client _, AddMachine _) + | Append (Origin.Client _, UpdateMachine _) + | Append (Origin.Client _, RemoveMachine _) -> Ignore + | Append (Origin.Service _, AddMachine _) + | Append (Origin.Service _, UpdateMachine _) + | Append (Origin.Service _, RemoveMachine _) -> Replicate - | Append (Origin.Web _, AddMember _) -> Replicate - | Append (Origin.Web _, UpdateMember _) -> Ignore - | Append (Origin.Web _, RemoveMember _) -> Replicate - | Append (Origin.Client _, AddMember _) - | Append (Origin.Client _, UpdateMember _) - | Append (Origin.Client _, RemoveMember _) -> Ignore + // __ __ _ + // | \/ | ___ _ __ ___ | |__ ___ _ __ + // | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| + // | | | | __/ | | | | | |_) | __/ | + // |_| |_|\___|_| |_| |_|_.__/ \___|_| | Append (Origin.Service _, AddMember _) | Append (Origin.Service _, UpdateMember _) | Append (Origin.Service _, RemoveMember _) -> Replicate + | Append ( _, AddMember _) + | Append ( _, UpdateMember _) + | Append ( _, RemoveMember _) -> Ignore // ____ _ _ _ // / ___| (_) ___ _ __ | |_ // | | | | |/ _ \ '_ \| __| // | |___| | | __/ | | | |_ // \____|_|_|\___|_| |_|\__| - | Append (Origin.Web _, AddClient _) | Append (Origin.Web _, UpdateClient _) | Append (Origin.Web _, RemoveClient _) @@ -301,7 +303,6 @@ type DiscoEvent = // | __/| | | | | |_| | | | (_) | |_| | |_) | // |_| |_|_| |_|\____|_| \___/ \__,_| .__/ // |_| - | Append (Origin.Web _, AddPinGroup _) | Append (Origin.Web _, UpdatePinGroup _) | Append (Origin.Web _, RemovePinGroup _) -> Ignore @@ -317,7 +318,6 @@ type DiscoEvent = // | |_) | | '_ \ // | __/| | | | | // |_| |_|_| |_| - | Append (Origin.Web _, AddPin _) -> Ignore | Append (Origin.Web _, UpdatePin _) -> Replicate | Append (Origin.Web _, RemovePin _) -> Ignore @@ -333,7 +333,6 @@ type DiscoEvent = // | | | | | |/ _ \ // | |__| |_| | __/ // \____\__,_|\___| - | Append (Origin.Web _, AddCue _) | Append (Origin.Web _, UpdateCue _) | Append (Origin.Web _, RemoveCue _) @@ -377,7 +376,6 @@ type DiscoEvent = // | | | | | |/ _ \ | | / __| __| // | |__| |_| | __/ |___| \__ \ |_ // \____\__,_|\___|_____|_|___/\__| - | Append (Origin.Web _, AddCueList _) | Append (Origin.Web _, UpdateCueList _) | Append (Origin.Web _, RemoveCueList _) @@ -394,7 +392,6 @@ type DiscoEvent = // | |__| |_| | __/ __/| | (_| | |_| | __/ | // \____\__,_|\___|_| |_|\__,_|\__, |\___|_| // |___/ - | Append (Origin.Web _, AddCuePlayer _) | Append (Origin.Web _, UpdateCuePlayer _) | Append (Origin.Web _, RemoveCuePlayer _) @@ -410,7 +407,6 @@ type DiscoEvent = // | | | / __|/ _ \ '__| // | |_| \__ \ __/ | // \___/|___/\___|_| - | Append (Origin.Web _, AddUser _) | Append (Origin.Web _, UpdateUser _) | Append (Origin.Web _, RemoveUser _) -> Replicate @@ -426,7 +422,6 @@ type DiscoEvent = // \___ \ / _ \/ __/ __| |/ _ \| '_ \ // ___) | __/\__ \__ \ | (_) | | | | // |____/ \___||___/___/_|\___/|_| |_| - | Append (Origin.Web _, AddSession _) | Append (Origin.Web _, UpdateSession _) | Append (Origin.Web _, RemoveSession _) -> Replicate @@ -442,7 +437,6 @@ type DiscoEvent = // | | | | / __|/ __/ _ \ \ / / _ \ '__/ _ \/ _` | // | |_| | \__ \ (_| (_) \ V / __/ | | __/ (_| | // |____/|_|___/\___\___/ \_/ \___|_| \___|\__,_| - | Append (Origin.Web _, AddDiscoveredService _) | Append (Origin.Web _, UpdateDiscoveredService _) | Append (Origin.Web _, RemoveDiscoveredService _) @@ -458,7 +452,6 @@ type DiscoEvent = // | | | |/ _ \ / __| |/ / // | |___| | (_) | (__| < // \____|_|\___/ \___|_|\_\ - | Append (Origin.Service _, UpdateClock _) -> Publish | Append ( _, UpdateClock _) -> Ignore @@ -467,7 +460,6 @@ type DiscoEvent = // | | / _ \| '_ ` _ \| '_ ` _ \ / _` | '_ \ / _` | // | |__| (_) | | | | | | | | | | | (_| | | | | (_| | // \____\___/|_| |_| |_|_| |_| |_|\__,_|_| |_|\__,_| - | Append (Origin.Web _, Command _) | Append (Origin.Client _, Command _) | Append (Origin.Service _, Command _) -> Replicate @@ -478,7 +470,6 @@ type DiscoEvent = // | |_| | (_| | || (_| |___) | | | | (_| | |_) \__ \ | | | (_) | |_ // |____/ \__,_|\__\__,_|____/|_| |_|\__,_| .__/|___/_| |_|\___/ \__| // |_| - | Append (Origin.Web _, DataSnapshot _) | Append (Origin.Client _, DataSnapshot _) | Append (Origin.Service _, DataSnapshot _) -> Ignore @@ -488,7 +479,6 @@ type DiscoEvent = // | |_ / _` / __| __| |_) | '__/ _ \ / __/ _ \/ __/ __| // | _| (_| \__ \ |_| __/| | | (_) | (_| __/\__ \__ \ // |_| \__,_|___/\__|_| |_| \___/ \___\___||___/___/ - | Append (_, UpdateSlices _) -> Publish | Append (_, CallCue _) -> Publish @@ -498,7 +488,6 @@ type DiscoEvent = // | |__| (_) | (_| | | | \__ \ (_| | // |_____\___/ \__, |_| |_|___/\__, | // |___/ |___/ - | Append (_, LogMsg _) -> Publish // __ __ _ @@ -506,7 +495,6 @@ type DiscoEvent = // | |\/| | / __|/ __| // | | | | \__ \ (__ // |_| |_|_|___/\___| - | Append (_, SetLogLevel _) -> Replicate // * DiscoEvent module diff --git a/src/Disco/Disco/Core/Machine.fs b/src/Disco/Disco/Core/Machine.fs index 2a6ca97e..42fbb4e6 100644 --- a/src/Disco/Disco/Core/Machine.fs +++ b/src/Disco/Disco/Core/Machine.fs @@ -246,7 +246,7 @@ type DiscoMachineYaml () = [] val mutable AssetFilter: string [] val mutable LogDirectory: string [] val mutable CollectMetrics: bool - + [] val mutable MetricsHost: string [] val mutable MetricsPort: uint16 @@ -272,8 +272,8 @@ type DiscoMachineYaml () = yml.LogDirectory <- unwrap cfg.LogDirectory yml.CollectMetrics <- cfg.CollectMetrics yml.MetricsHost <- string cfg.MetricsHost - yml.MetricsPort <- unwrap cfg.MetricsPort - yml.MetricsDb <- cfg.MetricsDb + yml.MetricsPort <- unwrap cfg.MetricsPort + yml.MetricsDb <- cfg.MetricsDb yml.BindAddress <- string cfg.BindAddress yml.MulticastAddress <- string cfg.MulticastAddress yml.MulticastPort <- unwrap cfg.MulticastPort diff --git a/src/Disco/Disco/Core/Project.fs b/src/Disco/Disco/Core/Project.fs index a72563df..49be5753 100644 --- a/src/Disco/Disco/Core/Project.fs +++ b/src/Disco/Disco/Core/Project.fs @@ -738,7 +738,7 @@ module ClusterMember = let setIpAddress = Optic.set ClusterMember.IpAddress_ let setMulticastAddress = Optic.set ClusterMember.MulticastAddress_ let setMulticastPort = Optic.set ClusterMember.MulticastPort_ - let setClusterPort = Optic.set ClusterMember.RaftPort_ + let setRaftPort = Optic.set ClusterMember.RaftPort_ let setHttpPort = Optic.set ClusterMember.HttpPort_ let setWsPort = Optic.set ClusterMember.WsPort_ let setGitPort = Optic.set ClusterMember.GitPort_ @@ -770,38 +770,15 @@ module ClusterMember = // ** toRaftMember let toRaftMember (mem:ClusterMember) = - { Id = mem.Id - HostName = mem.HostName - IpAddress = mem.IpAddress - MulticastAddress = mem.MulticastAddress - MulticastPort = mem.MulticastPort - HttpPort = mem.HttpPort - RaftPort = mem.RaftPort - WsPort = mem.WsPort - GitPort = mem.GitPort - ApiPort = mem.ApiPort - Status = mem.Status - State = mem.State - Voting = true - VotedForMe = false - NextIndex = index 1 - MatchIndex = index 0 } - - // ** ofRaftMember - - let ofRaftMember (mem:RaftMember) = - { Id = mem.Id - HostName = mem.HostName - IpAddress = mem.IpAddress - MulticastAddress = mem.MulticastAddress - MulticastPort = mem.MulticastPort - HttpPort = mem.HttpPort - RaftPort = mem.RaftPort - WsPort = mem.WsPort - GitPort = mem.GitPort - ApiPort = mem.ApiPort - Status = mem.Status - State = mem.State } + { Id = mem.Id + IpAddress = mem.IpAddress + RaftPort = mem.RaftPort + Status = mem.Status + State = mem.State + Voting = true + VotedForMe = false + NextIndex = index 1 + MatchIndex = index 0 } // * ClusterConfig @@ -985,7 +962,7 @@ type DiscoConfig = Clients: ClientConfig Raft: RaftConfig Timing: TimingConfig - Sites: ClusterConfig array } + Sites: Map } // ** optics @@ -1036,7 +1013,7 @@ type DiscoConfig = Clients = ClientConfig.Default Raft = RaftConfig.Default Timing = TimingConfig.Default - Sites = [| |] } + Sites = Map.empty } // ** ToOffset @@ -1061,7 +1038,9 @@ type DiscoConfig = self.ActiveSite let sites = - Array.map (Binary.toOffset builder) self.Sites + self.Sites + |> Map.toArray + |> Array.map (snd >> Binary.toOffset builder) |> fun sites -> ConfigFB.CreateSitesVector(builder, sites) ConfigFB.StartConfigFB(builder) @@ -1160,11 +1139,8 @@ type DiscoConfig = #endif let! (_, sites) = - let arr = - fb.SitesLength - |> Array.zeroCreate Array.fold - (fun (m: Either) _ -> + (fun (m: Either>) _ -> either { let! (idx, sites) = m let! site = @@ -1181,11 +1157,10 @@ type DiscoConfig = |> Error.asParseError "DiscoConfig.FromFB" |> Either.fail #endif - sites.[idx] <- site - return (idx + 1, sites) + return (idx + 1, Map.add site.Id site sites) }) - (Right(0, arr)) - arr + (Right(0, Map.empty)) + [| 0 .. fb.SitesLength - 1 |] return { Machine = machine @@ -1226,6 +1201,11 @@ module DiscoConfig = let setTiming = Optic.set DiscoConfig.Timing_ let setSites = Optic.set DiscoConfig.Sites_ + // ** currentSite + + let currentSite (config:DiscoConfig) = + activeSite config + // * ProjectYaml #if !FABLE_COMPILER && !DISCO_NODES @@ -1651,25 +1631,18 @@ module ProjectYaml = // ** parseSites - let internal parseSites (config: DiscoProjectYaml) : Either = + let internal parseSites (config: DiscoProjectYaml) = either { - let arr = - config.Sites - |> Seq.length - |> Array.zeroCreate - let! (_, sites) = Seq.fold - (fun (m: Either) cfg -> + (fun (m: Either>) cfg -> either { let! (idx, sites) = m let! site = parseCluster cfg - sites.[idx] <- site - return (idx + 1, sites) + return (idx + 1, Map.add site.Id site sites) }) - (Right(0, arr)) + (Right(0, Map.empty)) config.Sites - return sites } @@ -1687,12 +1660,12 @@ module ProjectYaml = | Some id -> file.ActiveSite <- string id | None -> file.ActiveSite <- null - for cluster in config.Sites do + for KeyValue(id, cluster) in config.Sites do let cfg = SiteYaml() let members = ResizeArray() let groups = ResizeArray() - cfg.Id <- string cluster.Id + cfg.Id <- string id cfg.Name <- unwrap cluster.Name for KeyValue(_,mem) in cluster.Members do @@ -1839,7 +1812,7 @@ module Config = Audio = AudioConfig.Default Raft = RaftConfig.Default Timing = TimingConfig.Default - Sites = [| |] } + Sites = Map.empty } // ** updateMachine @@ -1866,33 +1839,14 @@ module Config = let updateTiming (timing: TimingConfig) (config: DiscoConfig) = { config with Timing = timing } - // ** updateCluster - - let updateCluster (cluster: ClusterConfig) (config: DiscoConfig) = - let sites = - Array.map - (fun (site: ClusterConfig) -> - if cluster.Id = site.Id - then cluster - else site) - config.Sites - { config with Sites = sites } - // ** updateSite let updateSite (site: ClusterConfig) (config: DiscoConfig) = - let sites = - Array.map - (fun existing -> - if ClusterConfig.id existing = ClusterConfig.id site - then site - else existing) - config.Sites - { config with Sites = sites } + { config with Sites = Map.add site.Id site config.Sites } // ** updateSites - let updateSites (sites: ClusterConfig array) (config: DiscoConfig) = + let updateSites (sites: Map) (config: DiscoConfig) = { config with Sites = sites } // ** findMember @@ -1900,7 +1854,7 @@ module Config = let findMember (config: DiscoConfig) (id: MemberId) = match config.ActiveSite with | Some active -> - match Array.tryFind (fun (clst: ClusterConfig) -> clst.Id = active) config.Sites with + match Map.tryFind active config.Sites with | Some cluster -> match Map.tryFind id cluster.Members with | Some mem -> Either.succeed mem @@ -1926,10 +1880,10 @@ module Config = // ** getMembers - let getMembers (config: DiscoConfig) : Either> = + let getMembers (config: DiscoConfig) = match config.ActiveSite with | Some active -> - match Array.tryFind (fun (clst: ClusterConfig) -> clst.Id = active) config.Sites with + match Map.tryFind active config.Sites with | Some site -> site.Members |> Either.succeed | None -> ErrorMessages.PROJECT_MISSING_CLUSTER + ": " + (string active) @@ -1943,7 +1897,7 @@ module Config = // ** setActiveSite let setActiveSite (id: SiteId) (config: DiscoConfig) = - if config.Sites |> Array.exists (fun x -> x.Id = id) + if Map.containsKey id config.Sites then Right { config with ActiveSite = Some id } else ErrorMessages.PROJECT_MISSING_MEMBER + ": " + (string id) @@ -1954,7 +1908,7 @@ module Config = let getActiveSite (config: DiscoConfig) = match config.ActiveSite with - | Some id -> Array.tryFind (fun (site: ClusterConfig) -> site.Id = id) config.Sites + | Some id -> Map.tryFind id config.Sites | None -> None // ** getActiveMember @@ -1969,9 +1923,9 @@ module Config = let setMembers (mems: Map) (config: DiscoConfig) = match config.ActiveSite with | Some active -> - match Array.tryFind (fun (clst: ClusterConfig) -> clst.Id = active) config.Sites with + match Map.tryFind active config.Sites with | Some site -> - updateCluster { site with Members = mems } config + updateSite { site with Members = mems } config | None -> config | None -> config @@ -2010,13 +1964,10 @@ module Config = // ** addSitePrivate let private addSitePrivate (site: ClusterConfig) setActive (config: DiscoConfig) = - let i = config.Sites |> Array.tryFindIndex (fun s -> s.Id = site.Id) - let copy = Array.zeroCreate (config.Sites.Length + (if Option.isSome i then 0 else 1)) - Array.iteri (fun i s -> copy.[i] <- s) config.Sites - copy.[match i with Some i -> i | None -> config.Sites.Length] <- site + let sites = Map.add site.Id site config.Sites if setActive - then { config with ActiveSite = Some site.Id; Sites = copy } - else { config with Sites = copy } + then { config with ActiveSite = Some site.Id; Sites = sites } + else { config with Sites = sites } // ** addSite @@ -2033,19 +1984,18 @@ module Config = // ** removeSite let removeSite (id: SiteId) (config: DiscoConfig) = - let sites = Array.filter (fun (site: ClusterConfig) -> site.Id <> id) config.Sites - { config with Sites = sites } + { config with Sites = Map.remove id config.Sites } // ** siteByMember let siteByMember (memid: SiteId) (config: DiscoConfig) = - Array.fold - (fun (m: ClusterConfig option) site -> + Map.fold + (fun (m: ClusterConfig option) _ site -> match m with | Some _ -> m | None -> - if Map.containsKey memid site.Members then - Some site + if Map.containsKey memid site.Members + then Some site else None) None config.Sites @@ -2053,17 +2003,17 @@ module Config = // ** findSite let findSite (id: SiteId) (config: DiscoConfig) = - Array.tryFind (fun (site: ClusterConfig) -> site.Id = id) config.Sites + Map.tryFind id config.Sites // ** addMember let addMember (mem: ClusterMember) (config: DiscoConfig) = match config.ActiveSite with | Some active -> - match Array.tryFind (fun clst -> ClusterConfig.id clst = active) config.Sites with + match Map.tryFind active config.Sites with | Some site -> let mems = Map.add mem.Id mem site.Members - updateCluster { site with Members = mems } config + updateSite { site with Members = mems } config | None -> config | None -> config @@ -2072,10 +2022,10 @@ module Config = let removeMember (id: MemberId) (config: DiscoConfig) = match config.ActiveSite with | Some active -> - match Array.tryFind (fun (clst:ClusterConfig) -> clst.Id = active) config.Sites with + match Map.tryFind active config.Sites with | Some site -> let mems = Map.remove id site.Members - updateCluster { site with Members = mems } config + updateSite { site with Members = mems } config | None -> config | None -> config @@ -2442,6 +2392,7 @@ module Project = let id = Optic.get DiscoProject.Id_ let name = Optic.get DiscoProject.Name_ + // ** setters let setId = Optic.set DiscoProject.Id_ @@ -2883,3 +2834,30 @@ module Project = } #endif + +// * Machine module + +module Machine = + + // ** toClusterMember + + let toClusterMember (machine: DiscoMachine) = + { Id = machine.MachineId + HostName = machine.HostName + IpAddress = machine.BindAddress + MulticastAddress = machine.MulticastAddress + MulticastPort = machine.MulticastPort + HttpPort = machine.WebPort + RaftPort = machine.RaftPort + WsPort = machine.WsPort + GitPort = machine.GitPort + ApiPort = machine.ApiPort + State = MemberState.Follower + Status = MemberStatus.Running } + + // ** toRaftMember + + let toRaftMember (machine: DiscoMachine) = + { Member.create machine.MachineId with + IpAddress = machine.BindAddress + RaftPort = machine.RaftPort } diff --git a/src/Disco/Disco/Core/StateMachine.fs b/src/Disco/Disco/Core/StateMachine.fs index 6490ad43..0b3ee5ad 100644 --- a/src/Disco/Disco/Core/StateMachine.fs +++ b/src/Disco/Disco/Core/StateMachine.fs @@ -1106,15 +1106,13 @@ module State = // ** addMember - let addMember (mem: RaftMember) (state: State) = - let mem = ClusterMember.ofRaftMember mem - in { state with Project = Project.addMember mem state.Project } + let addMember (mem: ClusterMember) (state: State) = + { state with Project = Project.addMember mem state.Project } // ** updateMember - let updateMember (mem: RaftMember) (state: State) = - let mem = ClusterMember.ofRaftMember mem - in { state with Project = Project.updateMember mem state.Project } + let updateMember (mem: ClusterMember) (state: State) = + { state with Project = Project.updateMember mem state.Project } // ** removeMember @@ -1792,9 +1790,14 @@ type StateMachine = | UnloadProject // Member - | AddMember of RaftMember - | UpdateMember of RaftMember - | RemoveMember of RaftMember + | AddMember of ClusterMember + | UpdateMember of ClusterMember + | RemoveMember of ClusterMember + + // Machine + | AddMachine of RaftMember + | UpdateMachine of RaftMember + | RemoveMachine of RaftMember // Client | AddClient of DiscoClient @@ -1887,6 +1890,11 @@ type StateMachine = | UpdateMember _ -> "UpdateMember" | RemoveMember _ -> "RemoveMember" + // Machine + | AddMachine _ -> "AddMachine" + | UpdateMachine _ -> "UpdateMachine" + | RemoveMachine _ -> "RemoveMachine" + // Client | AddClient _ -> "AddClient" | UpdateClient _ -> "UpdateClient" @@ -1975,6 +1983,11 @@ type StateMachine = | AddMember _ | RemoveMember _ -> Commit + // Machine + | AddMachine _ + | UpdateMachine _ + | RemoveMachine _ -> Save + // Client | AddClient _ | UpdateClient _ @@ -2066,6 +2079,10 @@ type StateMachine = | UpdateMember _ | RemoveMember _ -> ParameterFB.RaftMemberFB + | AddMachine _ + | UpdateMachine _ + | RemoveMachine _ -> ParameterFB.ClusterMemberFB + | AddClient _ | UpdateClient _ | RemoveClient _ -> ParameterFB.DiscoClientFB @@ -2152,6 +2169,7 @@ type StateMachine = | AddClient _ | AddFsEntry _ | AddFsTree _ + | AddMachine _ | AddMember _ -> ApiCommandFB.AddFB | UpdateClock _ @@ -2168,6 +2186,7 @@ type StateMachine = | UpdatePinWidget _ | UpdateClient _ | UpdateMember _ + | UpdateMachine _ | UpdateFsEntry _ | UpdateProject _ -> ApiCommandFB.UpdateFB @@ -2184,6 +2203,7 @@ type StateMachine = | RemoveClient _ | RemoveFsEntry _ | RemoveFsTree _ + | RemoveMachine _ | RemoveMember _ -> ApiCommandFB.RemoveFB | CallCue _ -> ApiCommandFB.CallCueFB @@ -2242,6 +2262,25 @@ type StateMachine = | x when x = StateMachinePayloadFB.RaftMemberFB -> let mem = fb.RaftMemberFB |> RaftMember.FromFB match fb.Action with + | x when x = StateMachineActionFB.AddFB -> + Either.map AddMachine mem + | x when x = StateMachineActionFB.UpdateFB -> + Either.map UpdateMachine mem + | x when x = StateMachineActionFB.RemoveFB -> + Either.map RemoveMachine mem + | x -> + sprintf "Could not parse unknown StateMachineActionFB %A" x + |> Error.asParseError "StateMachine.FromFB" + |> Either.fail + + // __ __ _ + // | \/ | ___ _ __ ___ | |__ ___ _ __ + // | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| + // | | | | __/ | | | | | |_) | __/ | + // |_| |_|\___|_| |_| |_|_.__/ \___|_| + | x when x = StateMachinePayloadFB.ClusterMemberFB -> + let mem = fb.ClusterMemberFB |> ClusterMember.FromFB + match fb.Action with | x when x = StateMachineActionFB.AddFB -> Either.map AddMember mem | x when x = StateMachineActionFB.UpdateFB -> @@ -2887,11 +2926,11 @@ type StateMachine = |> Either.fail } - // _ _ _ - // | \ | | ___ __| | ___ - // | \| |/ _ \ / _` |/ _ \ - // | |\ | (_) | (_| | __/ - // |_| \_|\___/ \__,_|\___| + /// __ __ _ + /// | \/ | ___ _ __ ___ | |__ ___ _ __ + /// | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| + /// | | | | __/ | | | | | |_) | __/ | + /// |_| |_|\___|_| |_| |_|_.__/ \___|_| | StateMachinePayloadFB.RaftMemberFB -> either { let! mem = @@ -2904,7 +2943,34 @@ type StateMachine = |> Error.asParseError "StateMachine.FromFB" |> Either.fail match fb.Action with - | StateMachineActionFB.AddFB -> return (AddMember mem) + | StateMachineActionFB.AddFB -> return (AddMachine mem) + | StateMachineActionFB.UpdateFB -> return (UpdateMachine mem) + | StateMachineActionFB.RemoveFB -> return (RemoveMachine mem) + | x -> + return! + sprintf "Could not parse command. Unknown ActionTypeFB: %A" x + |> Error.asParseError "StateMachine.FromFB" + |> Either.fail + } + + /// __ __ _ + /// | \/ | ___ _ __ ___ | |__ ___ _ __ + /// | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| + /// | | | | __/ | | | | | |_) | __/ | + /// |_| |_|\___|_| |_| |_|_.__/ \___|_| + | StateMachinePayloadFB.ClusterMemberFB -> + either { + let! mem = + let memish = fb.Payload() + if memish.HasValue then + memish.Value + |> ClusterMember.FromFB + else + "Could not parse empty mem payload" + |> Error.asParseError "StateMachine.FromFB" + |> Either.fail + match fb.Action with + | StateMachineActionFB.AddFB -> return (AddMember mem) | StateMachineActionFB.UpdateFB -> return (UpdateMember mem) | StateMachineActionFB.RemoveFB -> return (RemoveMember mem) | x -> @@ -3244,7 +3310,48 @@ type StateMachine = // | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| // | | | | __/ | | | | | |_) | __/ | // |_| |_|\___|_| |_| |_|_.__/ \___|_| - | AddMember mem -> + | AddMember mem -> + let mem = mem.ToOffset(builder) + StateMachineFB.StartStateMachineFB(builder) + StateMachineFB.AddAction(builder, StateMachineActionFB.AddFB) + StateMachineFB.AddPayloadType(builder, StateMachinePayloadFB.ClusterMemberFB) +#if FABLE_COMPILER + StateMachineFB.AddPayload(builder, mem) +#else + StateMachineFB.AddPayload(builder, mem.Value) +#endif + StateMachineFB.EndStateMachineFB(builder) + + | UpdateMember mem -> + let mem = mem.ToOffset(builder) + StateMachineFB.StartStateMachineFB(builder) + StateMachineFB.AddAction(builder, StateMachineActionFB.UpdateFB) + StateMachineFB.AddPayloadType(builder, StateMachinePayloadFB.ClusterMemberFB) +#if FABLE_COMPILER + StateMachineFB.AddPayload(builder, mem) +#else + StateMachineFB.AddPayload(builder, mem.Value) +#endif + StateMachineFB.EndStateMachineFB(builder) + + | RemoveMember mem -> + let mem = mem.ToOffset(builder) + StateMachineFB.StartStateMachineFB(builder) + StateMachineFB.AddAction(builder, StateMachineActionFB.RemoveFB) + StateMachineFB.AddPayloadType(builder, StateMachinePayloadFB.ClusterMemberFB) +#if FABLE_COMPILER + StateMachineFB.AddPayload(builder, mem) +#else + StateMachineFB.AddPayload(builder, mem.Value) +#endif + StateMachineFB.EndStateMachineFB(builder) + + // __ __ _ + // | \/ | ___ _ __ ___ | |__ ___ _ __ + // | |\/| |/ _ \ '_ ` _ \| '_ \ / _ \ '__| + // | | | | __/ | | | | | |_) | __/ | + // |_| |_|\___|_| |_| |_|_.__/ \___|_| + | AddMachine mem -> let mem = mem.ToOffset(builder) StateMachineFB.StartStateMachineFB(builder) StateMachineFB.AddAction(builder, StateMachineActionFB.AddFB) @@ -3256,7 +3363,7 @@ type StateMachine = #endif StateMachineFB.EndStateMachineFB(builder) - | UpdateMember mem -> + | UpdateMachine mem -> let mem = mem.ToOffset(builder) StateMachineFB.StartStateMachineFB(builder) StateMachineFB.AddAction(builder, StateMachineActionFB.UpdateFB) @@ -3268,7 +3375,7 @@ type StateMachine = #endif StateMachineFB.EndStateMachineFB(builder) - | RemoveMember mem -> + | RemoveMachine mem -> let mem = mem.ToOffset(builder) StateMachineFB.StartStateMachineFB(builder) StateMachineFB.AddAction(builder, StateMachineActionFB.RemoveFB) diff --git a/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs b/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs index 4f362e46..d057908f 100644 --- a/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs @@ -453,10 +453,6 @@ type ApiClientNode() = [] val mutable OutConnected: ISpread - [] - [] - val mutable OutCount: ISpread - [] [] val mutable OutUpdate: ISpread diff --git a/src/Disco/Disco/Nodes/Nodes/ClusterConfigNode.fs b/src/Disco/Disco/Nodes/Nodes/ClusterConfigNode.fs index 875e6ced..45354eb0 100644 --- a/src/Disco/Disco/Nodes/Nodes/ClusterConfigNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/ClusterConfigNode.fs @@ -48,7 +48,7 @@ type ClusterConfigNode() = [] [] - val mutable OutMembers: ISpread> + val mutable OutMembers: ISpread> [] [] diff --git a/src/Disco/Disco/Nodes/Nodes/ConfigNode.fs b/src/Disco/Disco/Nodes/Nodes/ConfigNode.fs index 59a59105..9a48dde5 100644 --- a/src/Disco/Disco/Nodes/Nodes/ConfigNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/ConfigNode.fs @@ -79,14 +79,18 @@ type ConfigNode() = member self.Evaluate (_: int) : unit = if self.InUpdate.[0] && not (Util.isNullReference self.InConfig.[0]) then let config = self.InConfig.[0] + let sites = + config.Sites + |> Map.toArray + |> Array.map snd self.OutMachine.[0] <- config.Machine self.OutAudio.[0] <- config.Audio self.OutClients.[0] <- config.Clients self.OutRaft.[0] <- config.Raft self.OutTiming.[0] <- config.Timing - self.OutSites.SliceCount <- Array.length config.Sites - self.OutSites.AssignFrom config.Sites + self.OutSites.SliceCount <- Map.count config.Sites + self.OutSites.AssignFrom sites self.OutVersion.[0] <- string config.Version if self.InUpdate.IsChanged then diff --git a/src/Disco/Disco/Nodes/Nodes/MemberNode.fs b/src/Disco/Disco/Nodes/Nodes/MemberNode.fs index 730c47ba..0cba2ab6 100644 --- a/src/Disco/Disco/Nodes/Nodes/MemberNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/MemberNode.fs @@ -42,10 +42,6 @@ type MemberNode() = [] val mutable OutId: ISpread - [] - [] - val mutable OutHostName: ISpread - [] [] val mutable OutIpAddress: ISpread @@ -55,16 +51,8 @@ type MemberNode() = val mutable OutRaftPort: ISpread [] - [] - val mutable OutWsPort: ISpread - - [] - [] - val mutable OutGitPort: ISpread - - [] - [] - val mutable OutApiPort: ISpread + [] + val mutable OutState: ISpread [] [] @@ -78,25 +66,17 @@ type MemberNode() = member self.Evaluate (spreadMax: int) : unit = if self.InUpdate.[0] then self.OutId.SliceCount <- self.InMember.SliceCount - self.OutHostName.SliceCount <- self.InMember.SliceCount self.OutIpAddress.SliceCount <- self.InMember.SliceCount + self.OutState.SliceCount <- self.InMember.SliceCount self.OutStatus.SliceCount <- self.InMember.SliceCount self.OutRaftPort.SliceCount <- self.InMember.SliceCount - self.OutWsPort.SliceCount <- self.InMember.SliceCount - self.OutGitPort.SliceCount <- self.InMember.SliceCount - self.OutApiPort.SliceCount <- self.InMember.SliceCount - for n in 0 .. (spreadMax - 1) do if not (Util.isNullReference self.InMember.[n]) then let mem = self.InMember.[n] self.OutId.[n] <- string mem.Id - self.OutHostName.[n] <- unwrap mem.HostName self.OutIpAddress.[n] <- string mem.IpAddress self.OutStatus.[n] <- string mem.Status + self.OutState.[n] <- string mem.State self.OutRaftPort.[n] <- int mem.RaftPort - self.OutWsPort.[n] <- int mem.WsPort - self.OutGitPort.[n] <- int mem.GitPort - self.OutApiPort.[n] <- int mem.ApiPort - if self.InUpdate.IsChanged then self.OutUpdate.[0] <- self.InUpdate.[0] diff --git a/src/Disco/Disco/Raft/Member.fs b/src/Disco/Disco/Raft/Member.fs index ed2b50e1..171699e9 100644 --- a/src/Disco/Disco/Raft/Member.fs +++ b/src/Disco/Disco/Raft/Member.fs @@ -187,15 +187,8 @@ type MemberState = type RaftMember = { Id: MemberId - HostName: Name IpAddress: IpAddress - MulticastAddress: IpAddress - MulticastPort: Port - HttpPort: Port RaftPort: Port - WsPort: Port - GitPort: Port - ApiPort: Port Voting: bool VotedForMe: bool State: MemberState @@ -209,42 +202,14 @@ type RaftMember = (fun (mem:RaftMember) -> mem.Id), (fun id (mem:RaftMember) -> { mem with Id = id }) - static member HostName_ = - (fun (mem:RaftMember) -> mem.HostName), - (fun hostName (mem:RaftMember) -> { mem with HostName = hostName }) - static member IpAddress_ = (fun (mem:RaftMember) -> mem.IpAddress), (fun ipAddress (mem:RaftMember) -> { mem with IpAddress = ipAddress }) - static member MulticastAddress_ = - (fun (mem:RaftMember) -> mem.MulticastAddress), - (fun multicastAddress (mem:RaftMember) -> { mem with MulticastAddress = multicastAddress }) - - static member MulticastPort_ = - (fun (mem:RaftMember) -> mem.MulticastPort), - (fun multicastPort (mem:RaftMember) -> { mem with MulticastPort = multicastPort }) - static member RaftPort_ = (fun (mem:RaftMember) -> mem.RaftPort), (fun raftPort (mem:RaftMember) -> { mem with RaftPort = raftPort }) - static member HttpPort_ = - (fun (mem:RaftMember) -> mem.HttpPort), - (fun httpPort (mem:RaftMember) -> { mem with HttpPort = httpPort }) - - static member WsPort_ = - (fun (mem:RaftMember) -> mem.WsPort), - (fun wsPort (mem:RaftMember) -> { mem with WsPort = wsPort }) - - static member GitPort_ = - (fun (mem:RaftMember) -> mem.GitPort), - (fun gitPort (mem:RaftMember) -> { mem with GitPort = gitPort }) - - static member ApiPort_ = - (fun (mem:RaftMember) -> mem.ApiPort), - (fun apiPort (mem:RaftMember) -> { mem with ApiPort = apiPort }) - static member Voting_ = (fun (mem:RaftMember) -> mem.Voting), (fun voting (mem:RaftMember) -> { mem with Voting = voting }) @@ -272,15 +237,12 @@ type RaftMember = // ** ToString override self.ToString() = - sprintf "%O (%O, %O) on %A (%O:%d) (group:%O:%d) (NextIdx: %A) (MatchId: %d)" + sprintf "%O (%O) on %A (%O:%d) (NextIdx: %A) (MatchId: %d)" self.Id - self.HostName self.State self.Status self.IpAddress self.RaftPort - self.MulticastAddress - self.MulticastPort self.NextIndex self.MatchIndex @@ -297,15 +259,8 @@ type RaftMember = member self.ToYaml () = let yaml = RaftMemberYaml() yaml.Id <- string self.Id - yaml.HostName <- unwrap self.HostName yaml.IpAddress <- string self.IpAddress - yaml.MulticastAddress <- string self.MulticastAddress - yaml.MulticastPort <- unwrap self.MulticastPort - yaml.HttpPort <- unwrap self.HttpPort yaml.RaftPort <- unwrap self.RaftPort - yaml.WsPort <- unwrap self.WsPort - yaml.GitPort <- unwrap self.GitPort - yaml.ApiPort <- unwrap self.ApiPort yaml.State <- string self.State yaml.Status <- string self.Status yaml.NextIndex <- self.NextIndex @@ -325,15 +280,8 @@ type RaftMember = let! status = MemberStatus.TryParse yaml.Status return { Id = id - HostName = name yaml.HostName - MulticastAddress = mcastip - MulticastPort = port yaml.MulticastPort IpAddress = ip - HttpPort = port yaml.HttpPort RaftPort = port yaml.RaftPort - WsPort = port yaml.WsPort - GitPort = port yaml.GitPort - ApiPort = port yaml.ApiPort Voting = yaml.Voting VotedForMe = yaml.VotedForMe NextIndex = yaml.NextIndex @@ -350,14 +298,6 @@ type RaftMember = member mem.ToOffset (builder: FlatBufferBuilder) = let id = RaftMemberFB.CreateIdVector(builder,mem.Id.ToByteArray()) let ip = string mem.IpAddress |> builder.CreateString - let mcastip = string mem.MulticastAddress |> builder.CreateString - - let hostname = - let unwrapped = unwrap mem.HostName - if isNull unwrapped then - None - else - unwrapped |> builder.CreateString |> Some let state = mem.State.ToOffset(builder) let status = mem.Status.ToOffset() @@ -365,18 +305,8 @@ type RaftMember = RaftMemberFB.StartRaftMemberFB(builder) RaftMemberFB.AddId(builder, id) - match hostname with - | Some hostname -> RaftMemberFB.AddHostName(builder, hostname) - | None -> () - - RaftMemberFB.AddMulticastAddress(builder, mcastip) - RaftMemberFB.AddMulticastPort(builder, unwrap mem.MulticastPort) RaftMemberFB.AddIpAddress(builder, ip) RaftMemberFB.AddRaftPort(builder, unwrap mem.RaftPort) - RaftMemberFB.AddHttpPort(builder, unwrap mem.HttpPort) - RaftMemberFB.AddWsPort(builder, unwrap mem.WsPort) - RaftMemberFB.AddGitPort(builder, unwrap mem.GitPort) - RaftMemberFB.AddApiPort(builder, unwrap mem.ApiPort) RaftMemberFB.AddVoting(builder, mem.Voting) RaftMemberFB.AddVotedForMe(builder, mem.VotedForMe) RaftMemberFB.AddState(builder, state) @@ -393,20 +323,12 @@ type RaftMember = let! state = MemberState.FromFB fb.State let! status = MemberStatus.FromFB fb.Status let! ip = IpAddress.TryParse fb.IpAddress - let! mcastip = IpAddress.TryParse fb.MulticastAddress return { Id = id State = state Status = status - HostName = name fb.HostName IpAddress = ip - MulticastAddress = mcastip - MulticastPort = port fb.MulticastPort - HttpPort = port fb.HttpPort RaftPort = port fb.RaftPort - WsPort = port fb.WsPort - GitPort = port fb.GitPort - ApiPort = port fb.ApiPort Voting = fb.Voting VotedForMe = fb.VotedForMe NextIndex = index fb.NextIndex @@ -564,15 +486,8 @@ module Member = // ** getters let id = Optic.get RaftMember.Id_ - let hostName = Optic.get RaftMember.HostName_ let ipAddress = Optic.get RaftMember.IpAddress_ - let multicastAddress = Optic.get RaftMember.MulticastAddress_ - let multicastPort = Optic.get RaftMember.MulticastPort_ let raftPort = Optic.get RaftMember.RaftPort_ - let httpPort = Optic.get RaftMember.HttpPort_ - let wsPort = Optic.get RaftMember.WsPort_ - let gitPort = Optic.get RaftMember.GitPort_ - let apiPort = Optic.get RaftMember.ApiPort_ let voting = Optic.get RaftMember.Voting_ let votedForMe = Optic.get RaftMember.VotedForMe_ let status = Optic.get RaftMember.Status_ @@ -583,15 +498,8 @@ module Member = // ** setters let setId = Optic.set RaftMember.Id_ - let setHostName = Optic.set RaftMember.HostName_ let setIpAddress = Optic.set RaftMember.IpAddress_ - let setMulticastAddress = Optic.set RaftMember.MulticastAddress_ - let setMulticastPort = Optic.set RaftMember.MulticastPort_ let setRaftPort = Optic.set RaftMember.RaftPort_ - let setHttpPort = Optic.set RaftMember.HttpPort_ - let setWsPort = Optic.set RaftMember.WsPort_ - let setGitPort = Optic.set RaftMember.GitPort_ - let setApiPort = Optic.set RaftMember.ApiPort_ let setVoting = Optic.set RaftMember.Voting_ let setVotedForMe = Optic.set RaftMember.VotedForMe_ let setStatus = Optic.set RaftMember.Status_ @@ -602,27 +510,15 @@ module Member = // ** create let create id = - #if FABLE_COMPILER - let hostname = Fable.Import.Browser.window.location.host - #else - let hostname = Network.getHostName () - #endif - { Id = id - HostName = name hostname - IpAddress = IPv4Address "127.0.0.1" - MulticastAddress = IpAddress.Parse Constants.DEFAULT_MCAST_ADDRESS - MulticastPort = Measure.port Constants.DEFAULT_MCAST_PORT - HttpPort = Measure.port Constants.DEFAULT_HTTP_PORT - RaftPort = Measure.port Constants.DEFAULT_RAFT_PORT - WsPort = Measure.port Constants.DEFAULT_WEB_SOCKET_PORT - GitPort = Measure.port Constants.DEFAULT_GIT_PORT - ApiPort = Measure.port Constants.DEFAULT_API_PORT - Status = Running - State = Follower - Voting = true - VotedForMe = false - NextIndex = index 1 - MatchIndex = index 0 } + { Id = id + IpAddress = IPv4Address "127.0.0.1" + RaftPort = Measure.port Constants.DEFAULT_RAFT_PORT + Status = Running + State = Follower + Voting = true + VotedForMe = false + NextIndex = index 1 + MatchIndex = index 0 } // ** isVoting diff --git a/src/Disco/Disco/Service/CommandActions.fs b/src/Disco/Disco/Service/CommandActions.fs index 75fdcfb9..c08e3c08 100644 --- a/src/Disco/Disco/Service/CommandActions.fs +++ b/src/Disco/Disco/Service/CommandActions.fs @@ -163,7 +163,7 @@ let getProjectSites machine projectName = // TODO: Check username and password? return state.Project.Config.Sites - |> Array.map (fun x -> { Name = x.Name; Id = x.Id }) + |> Map.map (fun id x -> { Name = x.Name; Id = id }) |> serializeJson } diff --git a/src/Disco/Disco/Service/DiscoService.fs b/src/Disco/Disco/Service/DiscoService.fs index e69bd306..43ec23ea 100644 --- a/src/Disco/Disco/Service/DiscoService.fs +++ b/src/Disco/Disco/Service/DiscoService.fs @@ -150,32 +150,40 @@ module DiscoService = | DiscoEvent.Append(_, sm) when sm.PersistenceStrategy = PersistenceStrategy.Commit -> if isLeader store then do persistWithLogging store sm - let state= store.State + + let state = store.State + // ____ _ _ // / ___|___ _ __ ___ _ __ ___ (_) |_ // | | / _ \| '_ ` _ \| '_ ` _ \| | __| // | |__| (_) | | | | | | | | | | | | |_ // \____\___/|_| |_| |_|_| |_| |_|_|\__| - match Persistence.commitChanges state.Store.State with - | Right (repo, commit) -> - commit.Sha - |> String.format "Successfully committed changes in: {0}" - |> Logger.debug (tag "statePersistor") - repo - |> Persistence.ensureRemotes - state.RaftServer.MemberId - state.Store.State.Project - state.RaftServer.Raft.Peers - |> Persistence.pushChanges - |> Map.iter - (fun name err -> - sprintf "could not push to %s: %O" name err - |> Logger.err (tag "statePersistor")) - dispose repo + match Config.getMembers state.Store.State.Project.Config with | Left error -> - error + error.Message |> String.format "Error committing changes to disk: {0}" |> Logger.err (tag "statePersistor") + | Right members -> + match Persistence.commitChanges state.Store.State with + | Right (repo, commit) -> + commit.Sha + |> String.format "Successfully committed changes in: {0}" + |> Logger.debug (tag "statePersistor") + repo + |> Persistence.ensureRemotes + state.RaftServer.MemberId + state.Store.State.Project + members + |> Persistence.pushChanges + |> Map.iter + (fun name err -> + sprintf "could not push to %s: %O" name err + |> Logger.err (tag "statePersistor")) + dispose repo + | Left error -> + error + |> String.format "Error committing changes to disk: {0}" + |> Logger.err (tag "statePersistor") | _ -> () // ** mappingResolver @@ -352,6 +360,10 @@ module DiscoService = /// will simply be ignored. let private sendLocalData (socket: ITcpClient) (store: IAgentStore) = if (store.State.SocketServer.Sessions.Count + store.State.ApiServer.Clients.Count) > 0 then + let mem = + match Config.getActiveMember store.State.Store.State.Project.Config with + | Some clusterMem -> [ AddMember clusterMem ] + | None -> List.empty let sessions = store.State.SocketServer.Sessions |> Map.toList @@ -365,7 +377,13 @@ module DiscoService = |> Option.map (fun tree -> [ AddFsTree tree ]) |> Option.defaultValue List.empty - let batch = List.concat [ sessions; clients; tree ] + let batch = + List.concat [ + mem + sessions + clients + tree + ] /// send a batched state machine command to leader if non-empty if not (List.isEmpty batch) then @@ -526,11 +544,11 @@ module DiscoService = // | | | | __/ | | | | | |_) | __/ | \__ \ // |_| |_|\___|_| |_| |_|_.__/ \___|_| |___/ - | Append (_, AddMember mem) -> - if isLeader store then store.State.RaftServer.AddMember mem + | Append (_, AddMachine mem) -> + if isLeader store then store.State.RaftServer.AddMachine mem - | Append (_, RemoveMember mem) -> - if isLeader store then store.State.RaftServer.RemoveMember mem.Id + | Append (_, RemoveMachine mem) -> + if isLeader store then store.State.RaftServer.RemoveMachine mem.Id // ____ _ _ // / ___| ___ ___| | _____| |_ @@ -624,9 +642,10 @@ module DiscoService = // ** retrieveSnapshot let private retrieveSnapshot (state: DiscoState) = - let path = Constants.RAFT_DIRECTORY <.> - Constants.SNAPSHOT_FILENAME + - Constants.ASSET_EXTENSION + let path = + Constants.RAFT_DIRECTORY <.> + Constants.SNAPSHOT_FILENAME + + Constants.ASSET_EXTENSION match DiscoData.read path with | Right str -> try @@ -699,7 +718,7 @@ module DiscoService = | Some (name, site) -> let site = state.Project.Config.Sites - |> Array.tryFind (fun s -> s.Id = site) + |> Map.tryFind site |> function | Some s -> s | None -> { ClusterConfig.Default with Name = name } @@ -875,19 +894,19 @@ module DiscoService = dispose store.State // dispose the state store.Update { store.State with Status = ServiceStatus.Disposed } - // ** addMember + // ** addMachine - let private addMember (store: IAgentStore) (mem: RaftMember) = - AddMember mem + let private addMachine (store: IAgentStore) (mem: RaftMember) = + AddMachine mem |> DiscoEvent.appendService |> store.State.Dispatcher.Dispatch - // ** removeMember + // ** removeMachine - let private removeMember (store: IAgentStore) (id: MemberId) = + let private removeMachine (store: IAgentStore) (id: MemberId) = store.State.RaftServer.Raft.Peers |> Map.tryFind id - |> Option.iter (RemoveMember >> DiscoEvent.appendService >> store.State.Dispatcher.Dispatch) + |> Option.iter (RemoveMachine >> DiscoEvent.appendService >> store.State.Dispatcher.Dispatch) // ** append @@ -919,9 +938,9 @@ module DiscoService = member self.Periodic () = store.State.RaftServer.Periodic() - member self.AddMember mem = addMember store mem + member self.AddMachine mem = addMachine store mem - member self.RemoveMember id = removeMember store id + member self.RemoveMachine id = removeMachine store id member self.Append cmd = append store cmd diff --git a/src/Disco/Disco/Service/Interfaces.fs b/src/Disco/Disco/Service/Interfaces.fs index f76ec3fa..72de95cc 100644 --- a/src/Disco/Disco/Service/Interfaces.fs +++ b/src/Disco/Disco/Service/Interfaces.fs @@ -124,8 +124,8 @@ type IRaftServer = abstract Status : ServiceStatus abstract Subscribe : (DiscoEvent -> unit) -> IDisposable abstract Periodic : unit -> unit - abstract AddMember : RaftMember -> unit - abstract RemoveMember : MemberId -> unit + abstract AddMachine : RaftMember -> unit + abstract RemoveMachine : MemberId -> unit abstract Connections : ConcurrentDictionary abstract Leader : RaftMember option abstract IsLeader : bool @@ -193,7 +193,7 @@ type DiscoServiceOptions = /// Interface type to close over internal actors and state. type IDiscoService = inherit IDisposable - abstract AddMember: RaftMember -> unit + abstract AddMachine: RaftMember -> unit abstract Append: StateMachine -> unit abstract Config: DiscoConfig with get, set abstract ForceElection: unit -> unit @@ -203,7 +203,7 @@ type IDiscoService = abstract Project: DiscoProject abstract RaftServer: IRaftServer abstract AssetService: IAssetService - abstract RemoveMember: MemberId -> unit + abstract RemoveMachine: MemberId -> unit abstract SocketServer: IWebSocketServer abstract Start: unit -> Either abstract State: State diff --git a/src/Disco/Disco/Service/Persistence.fs b/src/Disco/Disco/Service/Persistence.fs index 059958d0..38a0c815 100644 --- a/src/Disco/Disco/Service/Persistence.fs +++ b/src/Disco/Disco/Service/Persistence.fs @@ -313,7 +313,7 @@ module Persistence = // ** getRemote - let getRemote (project: DiscoProject) (repo: Repository) (leader: RaftMember) = + let getRemote (project: DiscoProject) (repo: Repository) (leader: ClusterMember) = let uri = Uri.gitUri project.Name leader.IpAddress leader.GitPort match Git.Config.tryFindRemote repo (string leader.Id) with | None -> @@ -335,7 +335,7 @@ module Persistence = // ** ensureRemote - let ensureRemote (project: DiscoProject) (repo: Repository) (peer: RaftMember) = + let ensureRemote (project: DiscoProject) (repo: Repository) (peer: ClusterMember) = let uri = Uri.gitUri project.Name peer.IpAddress peer.GitPort match Git.Config.tryFindRemote repo (string peer.Id) with | None -> @@ -359,7 +359,7 @@ module Persistence = let ensureRemotes (leader: MemberId) (project: DiscoProject) - (peers: Map) + (peers: Map) (repo: Repository) = peers |> Map.toArray diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index 5e6b6ce5..b6a80a28 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -252,8 +252,9 @@ module rec RaftServer = |> sendRequest peer connections agent member self.PrepareSnapshot raft = - callbacks.PrepareSnapshot () - |> Option.map (DataSnapshot >> Raft.createSnapshot raft) + Option.map + (DataSnapshot >> Raft.createSnapshot raft) + (callbacks.PrepareSnapshot()) member self.RetrieveSnapshot () = callbacks.RetrieveSnapshot() @@ -270,19 +271,19 @@ module rec RaftServer = |> agent.Post member self.MemberAdded mem = - AddMember mem + AddMachine mem |> DiscoEvent.appendRaft |> Msg.Notify |> agent.Post member self.MemberUpdated mem = - UpdateMember mem + UpdateMachine mem |> DiscoEvent.appendRaft |> Msg.Notify |> agent.Post member self.MemberRemoved mem = - RemoveMember mem + RemoveMachine mem |> DiscoEvent.appendRaft |> Msg.Notify |> agent.Post @@ -1538,10 +1539,10 @@ module rec RaftServer = // member self.LeaveCluster () = // agent.Post Msg.Leave - member self.AddMember mem = + member self.AddMachine mem = mem |> Msg.AddMember |> agent.Post - member self.RemoveMember id = + member self.RemoveMachine id = id |> Msg.RemoveMember |> agent.Post member self.Subscribe (callback: DiscoEvent -> unit) = diff --git a/src/Disco/Disco/Tests/Core/ApiTests.fs b/src/Disco/Disco/Tests/Core/ApiTests.fs index 4d664f29..374057d1 100644 --- a/src/Disco/Disco/Tests/Core/ApiTests.fs +++ b/src/Disco/Disco/Tests/Core/ApiTests.fs @@ -190,7 +190,6 @@ module ApiTests = AddCue (mkCue ()) AddPin (mkPin ()) AddCueList (mkCueList ()) - AddMember (mkMember ()) AddUser (mkUser ()) ] @@ -369,7 +368,8 @@ module ApiTests = let test_client_should_dispose_properly = testCase "client should dispose properly" <| fun _ -> either { - let mem = Member.create (DiscoId.Create()) + let machine = MachineConfig.create "127.0.0.1" None + let mem = Machine.toClusterMember machine let srvr : DiscoServer = { Port = mem.ApiPort diff --git a/src/Disco/Disco/Tests/Core/Disco/Common.fs b/src/Disco/Disco/Tests/Core/Disco/Common.fs index b8cee33c..fc1227c9 100644 --- a/src/Disco/Disco/Tests/Core/Disco/Common.fs +++ b/src/Disco/Disco/Tests/Core/Disco/Common.fs @@ -60,11 +60,7 @@ module Common = } let mkMember (machine: DiscoMachine) = - { Member.create machine.MachineId with - RaftPort = machine.RaftPort - ApiPort = machine.ApiPort - GitPort = machine.GitPort - WsPort = machine.WsPort } + Machine.toClusterMember machine let mkCluster (num: int) = either { @@ -82,7 +78,7 @@ module Common = Name = name "Cool Cluster Yo" Members = members - |> List.map (fun mem -> mem.Id,ClusterMember.ofRaftMember mem) + |> List.map (fun mem -> mem.Id, mem) |> Map.ofList } let project = diff --git a/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs b/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs index f1bba6f0..7faf16cc 100644 --- a/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs +++ b/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs @@ -101,7 +101,7 @@ module RemoveMemberShouldSplitCluster = | false, false -> failwith "no leader" | true, true -> failwith "two leaders!!" - do leader.RemoveMember otherId + do leader.RemoveMachine otherId do! waitFor "removeDone" removeDone /// remove done on first service do! waitFor "removeDone" removeDone /// remove done on other service diff --git a/src/Disco/Disco/Tests/Core/Generators.fs b/src/Disco/Disco/Tests/Core/Generators.fs index 34327b1d..e41bdaf9 100644 --- a/src/Disco/Disco/Tests/Core/Generators.fs +++ b/src/Disco/Disco/Tests/Core/Generators.fs @@ -168,7 +168,7 @@ module Generators = LogDirectory = logpth CollectMetrics = cm MetricsHost = mh - MetricsPort = mhp + MetricsPort = mhp MetricsDb = mdb AssetDirectory = assetpth AssetFilter = assetFilter @@ -212,15 +212,8 @@ module Generators = let raftMemberGen = gen { let! id = idGen - let! n = nameGen let! ip = ipGen let! p = portGen - let! wp = portGen - let! ap = portGen - let! hp = portGen - let! gp = portGen - let! mcst = ipGen - let! mp = portGen let! voting = boolGen let! vfm = boolGen let! state = raftStateGen @@ -229,15 +222,8 @@ module Generators = let! midx = indexGen return { Id = id - HostName = n IpAddress = ip - MulticastAddress = mcst - MulticastPort = mp RaftPort = p - HttpPort = hp - WsPort = wp - GitPort = gp - ApiPort = ap Voting = voting VotedForMe = vfm State = state @@ -399,7 +385,7 @@ module Generators = Clients = clients Raft = raft Timing = timing - Sites = sites } + Sites = Array.fold (fun m (site:ClusterConfig) -> Map.add site.Id site m) Map.empty sites } } // ____ _ _ @@ -1177,9 +1163,12 @@ module Generators = let simpleStateMachineGen = [ Gen.map UpdateProject projectGen Gen.constant UnloadProject - Gen.map AddMember raftMemberGen - Gen.map UpdateMember raftMemberGen - Gen.map RemoveMember raftMemberGen + Gen.map AddMember clusterMemberGen + Gen.map UpdateMember clusterMemberGen + Gen.map RemoveMember clusterMemberGen + Gen.map AddMachine raftMemberGen + Gen.map UpdateMachine raftMemberGen + Gen.map RemoveMachine raftMemberGen Gen.map AddClient clientGen Gen.map UpdateClient clientGen Gen.map RemoveClient clientGen @@ -1441,7 +1430,7 @@ module Generators = // |___/ let machineArb = Arb.fromGen machineGen - + let changeArb = Arb.fromGen changesGen let raftRequestArb = Arb.fromGen raftRequestGen let raftResponseArb = Arb.fromGen raftResponseGen diff --git a/src/Disco/Disco/Tests/Core/GitTests.fs b/src/Disco/Disco/Tests/Core/GitTests.fs index 1e10f9d9..fb1ef5eb 100644 --- a/src/Disco/Disco/Tests/Core/GitTests.fs +++ b/src/Disco/Disco/Tests/Core/GitTests.fs @@ -23,14 +23,14 @@ module GitTests = let tmpdir = mkTmpDir () let mem = - machine.MachineId - |> Member.create - |> Member.setGitPort (port p) + machine + |> Machine.toClusterMember + |> ClusterMember.setGitPort (port p) let config = machine |> Config.create - |> Config.setMembers (Map.ofArray [| (mem.Id, ClusterMember.ofRaftMember mem) |]) + |> Config.setMembers (Map.ofArray [| (mem.Id, mem) |]) |> Config.setLogLevel Debug let project = @@ -92,7 +92,7 @@ module GitTests = let uuid, tmpdir, project, mem, path = mkEnvironment 10000us - use gitserver = GitServer.create (ClusterMember.ofRaftMember mem) path + use gitserver = GitServer.create mem path do! gitserver.Start() expect "Should be running" true Service.isRunning gitserver.Status @@ -111,7 +111,7 @@ module GitTests = | DiscoEvent.Started _ -> started.Set() |> ignore | _ -> () - use gitserver1 = GitServer.create (ClusterMember.ofRaftMember mem) path + use gitserver1 = GitServer.create mem path use gobs1 = gitserver1.Subscribe(handleStarted) do! gitserver1.Start() @@ -119,7 +119,7 @@ module GitTests = expect "Should be running" true Service.isRunning gitserver1.Status - use gitserver2 = GitServer.create (ClusterMember.ofRaftMember mem) path + use gitserver2 = GitServer.create mem path do! match gitserver2.Start() with | Right () -> Left (Other("test","Should have failed to start")) | Left error -> Right () @@ -141,7 +141,7 @@ module GitTests = let uuid, tmpdir, project, mem, path = mkEnvironment port - use gitserver = GitServer.create (ClusterMember.ofRaftMember mem) path + use gitserver = GitServer.create mem path use gobs1 = gitserver.Subscribe(handleStarted) do! gitserver.Start() diff --git a/src/Disco/Disco/Tests/Core/ProjectTests.fs b/src/Disco/Disco/Tests/Core/ProjectTests.fs index db3e60a7..5fdcc897 100644 --- a/src/Disco/Disco/Tests/Core/ProjectTests.fs +++ b/src/Disco/Disco/Tests/Core/ProjectTests.fs @@ -117,37 +117,41 @@ module ProjectTests = Version = version "1.2.34.4" Required = false }] - let memA = + let raftMemA = { Member.create (DiscoId.Create()) with - HostName = name "moomoo" IpAddress = IpAddress.Parse "182.123.18.2" Status = Running RaftPort = port 1234us } - let memB = + let raftMemB = { Member.create (DiscoId.Create()) with - HostName = name "taataaa" IpAddress = IpAddress.Parse "118.223.8.12" Status = Joining RaftPort = port 1234us } + let clusterMemA = + { Machine.toClusterMember machine with + Id = raftMemA.Id } + + let clusterMemB = + { Machine.toClusterMember machine with + Id = raftMemB.Id } + let groupA: HostGroup = { Name = name "Group A" - ; Members = [| DiscoId.Create() |] - } + Members = [| DiscoId.Create() |] } let groupB: HostGroup = { Name = name "Group B" - ; Members = [| DiscoId.Create() |] - } + Members = [| DiscoId.Create() |] } let cluster = { Id = DiscoId.Create() Name = name "A mighty cool cluster" Members = Map.ofArray [| - (memA.Id, ClusterMember.ofRaftMember memA) - (memB.Id, ClusterMember.ofRaftMember memB) + (raftMemA.Id, clusterMemA) + (raftMemB.Id, clusterMemB) |] Groups = [| groupA; groupB |] } @@ -159,7 +163,7 @@ module ProjectTests = Raft = engineCfg Clients = clientCfg ActiveSite = Some cluster.Id - Sites = [| cluster |] } + Sites = Map [ cluster.Id,cluster ] } project let! commit = DiscoData.saveWithCommit path User.Admin.Signature updated diff --git a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs index ba470a38..88df605c 100644 --- a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs +++ b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs @@ -32,22 +32,22 @@ module RaftIntegrationTests = let machine2 = MachineConfig.create "127.0.0.1" None let mem1 = - machine1.MachineId - |> Member.create - |> Member.setRaftPort (port 8000us) + machine1 + |> Machine.toClusterMember + |> ClusterMember.setRaftPort (port 8000us) let mem2 = - machine2.MachineId - |> Member.create - |> Member.setRaftPort (port 8001us) + machine2 + |> Machine.toClusterMember + |> ClusterMember.setRaftPort (port 8001us) let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" Members = Map.ofArray [| - (mem1.Id, ClusterMember.ofRaftMember mem1) - (mem2.Id, ClusterMember.ofRaftMember mem2) + (mem1.Id, mem1) + (mem2.Id, mem2) |] } let leadercfg = machine1 @@ -93,14 +93,14 @@ module RaftIntegrationTests = let machine = MachineConfig.create "127.0.0.1" None let mem = - machine.MachineId - |> Member.create - |> Member.setRaftPort port + machine + |> Machine.toClusterMember + |> ClusterMember.setRaftPort port let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem.Id, ClusterMember.ofRaftMember mem) |] } + Members = Map.ofArray [| (mem.Id, mem) |] } let leadercfg = machine @@ -156,20 +156,20 @@ module RaftIntegrationTests = let machine2 = MachineConfig.create "127.0.0.1" None let mem1 = - machine1.MachineId - |> Member.create - |> Member.setRaftPort (port 8000us) + machine1 + |> Machine.toClusterMember + |> ClusterMember.setRaftPort (port 8000us) let mem2 = - machine2.MachineId - |> Member.create - |> Member.setRaftPort (port 8001us) + machine2 + |> Machine.toClusterMember + |> ClusterMember.setRaftPort (port 8001us) let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem1.Id, ClusterMember.ofRaftMember mem1) - (mem2.Id, ClusterMember.ofRaftMember mem2) |] } + Members = Map.ofArray [| (mem1.Id, mem1) + (mem2.Id, mem2) |] } let leadercfg = machine1 @@ -220,14 +220,14 @@ module RaftIntegrationTests = let store = Store(State.Empty) let mem1 = - machine1.MachineId - |> Member.create - |> Member.setRaftPort (port 8000us) + machine1 + |> Machine.toClusterMember + |> ClusterMember.setRaftPort (port 8000us) let site = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem1.Id, ClusterMember.ofRaftMember mem1) |] } + Members = Map.ofArray [| (mem1.Id, mem1) |] } let leadercfg = machine1 @@ -286,7 +286,7 @@ module RaftIntegrationTests = |> sprintf "%O became follower" |> Logger.debug "test" are.Set() |> ignore - | DiscoEvent.Append(Origin.Raft, AddMember mem) -> + | DiscoEvent.Append(Origin.Raft, AddMachine mem) -> mem.Id |> sprintf "%O was added" |> Logger.debug "test" @@ -302,22 +302,27 @@ module RaftIntegrationTests = let machine2 = MachineConfig.create "127.0.0.1" None let mem1 = - machine1.MachineId - |> Member.create - |> Member.setRaftPort (port 8000us) + machine1 + |> Machine.toClusterMember + |> ClusterMember.setRaftPort (port 8000us) let mem2 = - machine2.MachineId - |> Member.create + machine2 + |> Machine.toClusterMember + |> ClusterMember.setRaftPort (port 8001us) + + let raftMem2 = + machine2 + |> Machine.toRaftMember |> Member.setRaftPort (port 8001us) let site1 = { ClusterConfig.Default with Name = name "Cool Cluster Yo" - Members = Map.ofArray [| (mem1.Id, ClusterMember.ofRaftMember mem1) |] } + Members = Map.ofArray [| (mem1.Id, mem1) |] } let site2 = - { site1 with Members = Map.ofArray [| (mem2.Id, ClusterMember.ofRaftMember mem2) |] } + { site1 with Members = Map.ofArray [| (mem2.Id, mem2) |] } let leadercfg = machine1 @@ -332,20 +337,20 @@ module RaftIntegrationTests = |> Config.setLogLevel (LogLevel.Debug) use! leader = RaftServer.create leadercfg { - new IRaftSnapshotCallbacks with - member self.RetrieveSnapshot() = None - member self.PrepareSnapshot() = None - } + new IRaftSnapshotCallbacks with + member self.RetrieveSnapshot() = None + member self.PrepareSnapshot() = None + } use obs1 = leader.Subscribe (setState mem1.Id check1) do! leader.Start() use! follower = RaftServer.create followercfg { - new IRaftSnapshotCallbacks with - member self.RetrieveSnapshot() = None - member self.PrepareSnapshot() = None - } + new IRaftSnapshotCallbacks with + member self.RetrieveSnapshot() = None + member self.PrepareSnapshot() = None + } use obs2 = follower.Subscribe (setState mem2.Id check2) @@ -354,7 +359,7 @@ module RaftIntegrationTests = do! waitFor "check1" check1 do! waitFor "check2" check2 - leader.AddMember mem2 // add mem2 to cluster + leader.AddMachine raftMem2 // add mem2 to cluster do! waitFor "added" added do! waitFor "configured" configured diff --git a/src/Disco/Disco/Tests/Core/SerializationTests.fs b/src/Disco/Disco/Tests/Core/SerializationTests.fs index 549097d8..557d2817 100644 --- a/src/Disco/Disco/Tests/Core/SerializationTests.fs +++ b/src/Disco/Disco/Tests/Core/SerializationTests.fs @@ -24,9 +24,9 @@ module SerializationTests = let test_binary_machine = testCase "DiscoMachine binary serialization should work" <| fun _ -> - binaryEncDec + binaryEncDec |> Prop.forAll Generators.machineArb - |> Check.QuickThrowOnFailure + |> Check.QuickThrowOnFailure /// _____ ___ __ /// | ___|__|_ _|_ __ / _| ___ diff --git a/src/Disco/Schema/Api.fbs b/src/Disco/Schema/Api.fbs index 19460ac7..1ec57bac 100644 --- a/src/Disco/Schema/Api.fbs +++ b/src/Disco/Schema/Api.fbs @@ -38,6 +38,7 @@ union ParameterFB { StateFB, ProjectFB, RaftMemberFB, + ClusterMemberFB, PinGroupFB, PinMappingFB, PinWidgetFB, diff --git a/src/Disco/Schema/Core.fbs b/src/Disco/Schema/Core.fbs index 08476449..9f14286d 100644 --- a/src/Disco/Schema/Core.fbs +++ b/src/Disco/Schema/Core.fbs @@ -830,6 +830,7 @@ union StateMachinePayloadFB { PinGroupMapFB, DiscoClientFB, RaftMemberFB, + ClusterMemberFB, UserFB, SessionFB, LogEventFB, diff --git a/src/Disco/Serialization.csproj b/src/Disco/Serialization.csproj index 64753d1b..4b689f0b 100644 --- a/src/Disco/Serialization.csproj +++ b/src/Disco/Serialization.csproj @@ -43,128 +43,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs b/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs index 89a43b7b..495bf170 100644 --- a/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs +++ b/src/Frontend/src/Core.Frontend/FlatBufferTypes.fs @@ -2177,6 +2177,7 @@ type StateMachinePayloadFBConstructor = abstract PinMappingFB: StateMachinePayloadFB abstract PinWidgetFB: StateMachinePayloadFB abstract RaftMemberFB: StateMachinePayloadFB + abstract ClusterMemberFB: StateMachinePayloadFB abstract UserFB: StateMachinePayloadFB abstract SessionFB: StateMachinePayloadFB abstract LogEventFB: StateMachinePayloadFB @@ -2205,6 +2206,7 @@ type StateMachineFB = abstract PinMappingFB: PinMappingFB abstract PinWidgetFB: PinWidgetFB abstract RaftMemberFB: RaftMemberFB + abstract ClusterMemberFB: ClusterMemberFB abstract UserFB: UserFB abstract SessionFB: SessionFB abstract LogEventFB: LogEventFB diff --git a/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs b/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs index 4b4a7251..6d222043 100644 --- a/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs +++ b/src/Frontend/src/Frontend/Elmish/AssetBrowserView.fs @@ -292,7 +292,7 @@ type AssetBrowserView(props) = member this.renderMachineBrowser trees = let sites = this.props.Model.state - |> Option.map (State.sites >> Array.toList) + |> Option.map (State.sites >> Map.toList >> List.map snd) |> Option.defaultValue List.empty let members = diff --git a/src/Frontend/src/Frontend/Elmish/ClusterView.fs b/src/Frontend/src/Frontend/Elmish/ClusterView.fs index 19735faa..e4a5122a 100644 --- a/src/Frontend/src/Frontend/Elmish/ClusterView.fs +++ b/src/Frontend/src/Frontend/Elmish/ClusterView.fs @@ -27,8 +27,8 @@ let activeConfig dispatch state = let config = state.Project.Config let current = state.Project.Config.Machine let members = - config.ActiveSite |> Option.bind (fun activeSite -> - config.Sites |> Seq.tryFind (fun site -> site.Id = activeSite)) + config.ActiveSite + |> Option.bind (flip Map.tryFind config.Sites) |> Option.map (fun site -> site.Members) |> Option.defaultValue Map.empty table [Class "disco-table"] [ @@ -94,7 +94,7 @@ let activeConfig dispatch state = | Right mem -> mem |> ClusterMember.toRaftMember - |> RemoveMember + |> RemoveMachine |> ClientContext.Singleton.Post | Left error -> printfn "Cannot find member in config: %O" error) ] [] diff --git a/src/Frontend/src/Frontend/Elmish/ProjectView.fs b/src/Frontend/src/Frontend/Elmish/ProjectView.fs index d11a3cef..93ba82c4 100644 --- a/src/Frontend/src/Frontend/Elmish/ProjectView.fs +++ b/src/Frontend/src/Frontend/Elmish/ProjectView.fs @@ -47,7 +47,7 @@ let project2tree (p: DiscoProject) = ; obj2tree "Raft" c.Raft ; obj2tree "Timing" c.Timing ; leaf ("ActiveSite" + string c.ActiveSite) - ; arr2tree "Sites" (Array.map box c.Sites) + ; arr2tree "Sites" (Map.map (snd >> box) c.Sites) |] |> node "Config" [| leaf ("Id: " + string p.Id) ; leaf ("Name: " + unwrap p.Name) diff --git a/src/Frontend/src/Frontend/Lib.fs b/src/Frontend/src/Frontend/Lib.fs index d8d8c0c9..6d35d84a 100644 --- a/src/Frontend/src/Frontend/Lib.fs +++ b/src/Frontend/src/Frontend/Lib.fs @@ -166,16 +166,9 @@ let addMember(memberIpAddr: string, memberHttpPort: uint16) = // Add member B to the leader (A) cluster { Member.create machine.MachineId with - HostName = machine.HostName - MulticastAddress = machine.MulticastAddress - MulticastPort = machine.MulticastPort - IpAddress = machine.BindAddress - HttpPort = machine.WebPort - RaftPort = machine.RaftPort - WsPort = machine.WsPort - GitPort = machine.GitPort - ApiPort = machine.ApiPort } - |> AddMember + IpAddress = machine.BindAddress + RaftPort = machine.RaftPort } + |> AddMachine |> ClientContext.Singleton.Post with | exn -> diff --git a/src/Frontend/src/Frontend/MockData.fs b/src/Frontend/src/Frontend/MockData.fs index 52386cec..9162b354 100644 --- a/src/Frontend/src/Frontend/MockData.fs +++ b/src/Frontend/src/Frontend/MockData.fs @@ -226,7 +226,7 @@ let project = Clients = ClientConfig.Default Raft = RaftConfig.Default Timing = TimingConfig.Default - Sites = [| clusterConfig |] } + Sites = Map [ clusterConfig.Id, clusterConfig ] } { Id = DiscoId.Create() Name = name "mockproject" Path = filepath "/Disco/mockproject" diff --git a/src/Frontend/src/Tests.Frontend/SerializationTests.fs b/src/Frontend/src/Tests.Frontend/SerializationTests.fs index 61d77c20..aa304506 100644 --- a/src/Frontend/src/Tests.Frontend/SerializationTests.fs +++ b/src/Frontend/src/Tests.Frontend/SerializationTests.fs @@ -171,12 +171,24 @@ module SerializationTests = [| for n in 0 .. rand.Next(1,20) do yield mkClient() |] - let mkMember _ = DiscoId.Create() |> Member.create + let mkMember _ : ClusterMember = + { Id = DiscoId.Create() + HostName = rndname () + IpAddress = IPv4Address "127.0.0.1" + MulticastAddress = IPv4Address "224.0.0.1" + MulticastPort = rndport() + HttpPort = rndport() + RaftPort = rndport() + WsPort = rndport() + GitPort = rndport() + ApiPort = rndport() + State = Follower + Status = Running } let mkSession _ = { Id = DiscoId.Create() - ; IpAddress = IPv4Address "127.0.0.1" - ; UserAgent = "Oh my goodness" } + IpAddress = IPv4Address "127.0.0.1" + UserAgent = "Oh my goodness" } let mkPinMapping _ = { Id = DiscoId.Create() @@ -314,9 +326,12 @@ module SerializationTests = RemoveFsEntry (DiscoId.Create(), mkFsPath ()) AddFsTree <| mkFsTree() RemoveFsTree <| DiscoId.Create() - AddMember <| Member.create (DiscoId.Create()) - UpdateMember <| Member.create (DiscoId.Create()) - RemoveMember <| Member.create (DiscoId.Create()) + AddMachine <| Member.create (DiscoId.Create()) + UpdateMachine <| Member.create (DiscoId.Create()) + RemoveMachine <| Member.create (DiscoId.Create()) + AddMember <| mkMember() + UpdateMember <| mkMember() + RemoveMember <| mkMember() AddDiscoveredService <| mkDiscoveredService () UpdateDiscoveredService <| mkDiscoveredService () RemoveDiscoveredService <| mkDiscoveredService () @@ -328,8 +343,7 @@ module SerializationTests = finish() test "should serialize/deserialize cue correctly" <| fun finish -> - [| for i in 0 .. 20 do - yield mkCue () |] + [| for _ in 0 .. 20 -> mkCue () |] |> Array.iter check finish() @@ -431,46 +445,49 @@ module SerializationTests = test "Validate StateMachine Serialization" <| fun finish -> [ AddCue <| mkCue () - ; UpdateCue <| mkCue () - ; RemoveCue <| mkCue () - ; AddCueList <| mkCueList () - ; UpdateCueList <| mkCueList () - ; RemoveCueList <| mkCueList () - ; AddCuePlayer <| mkCuePlayer () - ; UpdateCuePlayer <| mkCuePlayer () - ; RemoveCuePlayer <| mkCuePlayer () - ; AddSession <| mkSession () - ; UpdateSession <| mkSession () - ; RemoveSession <| mkSession () - ; AddUser <| mkUser () - ; UpdateUser <| mkUser () - ; RemoveUser <| mkUser () - ; AddPinGroup <| mkPinGroup () - ; UpdatePinGroup <| mkPinGroup () - ; RemovePinGroup <| mkPinGroup () - ; AddPinMapping <| mkPinMapping () - ; UpdatePinMapping <| mkPinMapping () - ; RemovePinMapping <| mkPinMapping () - ; AddPinWidget <| mkPinWidget () - ; UpdatePinWidget <| mkPinWidget () - ; RemovePinWidget <| mkPinWidget () - ; AddClient <| mkClient () - ; UpdateSlices <| mkSlicesMap () - ; UpdateClient <| mkClient () - ; RemoveClient <| mkClient () - ; AddPin <| mkPin () - ; UpdatePin <| mkPin () - ; RemovePin <| mkPin () - ; AddMember <| Member.create (DiscoId.Create()) - ; UpdateMember <| Member.create (DiscoId.Create()) - ; RemoveMember <| Member.create (DiscoId.Create()) - ; AddDiscoveredService <| mkDiscoveredService () - ; UpdateDiscoveredService <| mkDiscoveredService () - ; RemoveDiscoveredService <| mkDiscoveredService () - ; DataSnapshot <| mkState () - ; Command AppCommand.Undo - ; LogMsg(Logger.create Debug "bla" "ohai") - ; SetLogLevel Warn + UpdateCue <| mkCue () + RemoveCue <| mkCue () + AddCueList <| mkCueList () + UpdateCueList <| mkCueList () + RemoveCueList <| mkCueList () + AddCuePlayer <| mkCuePlayer () + UpdateCuePlayer <| mkCuePlayer () + RemoveCuePlayer <| mkCuePlayer () + AddSession <| mkSession () + UpdateSession <| mkSession () + RemoveSession <| mkSession () + AddUser <| mkUser () + UpdateUser <| mkUser () + RemoveUser <| mkUser () + AddPinGroup <| mkPinGroup () + UpdatePinGroup <| mkPinGroup () + RemovePinGroup <| mkPinGroup () + AddPinMapping <| mkPinMapping () + UpdatePinMapping <| mkPinMapping () + RemovePinMapping <| mkPinMapping () + AddPinWidget <| mkPinWidget () + UpdatePinWidget <| mkPinWidget () + RemovePinWidget <| mkPinWidget () + AddClient <| mkClient () + UpdateSlices <| mkSlicesMap () + UpdateClient <| mkClient () + RemoveClient <| mkClient () + AddPin <| mkPin () + UpdatePin <| mkPin () + RemovePin <| mkPin () + AddMachine <| Member.create (DiscoId.Create()) + UpdateMachine <| Member.create (DiscoId.Create()) + RemoveMachine <| Member.create (DiscoId.Create()) + AddMember <| mkMember() + UpdateMember <| mkMember() + RemoveMember <| mkMember() + AddDiscoveredService <| mkDiscoveredService () + UpdateDiscoveredService <| mkDiscoveredService () + RemoveDiscoveredService <| mkDiscoveredService () + DataSnapshot <| mkState () + Command AppCommand.Undo + LogMsg(Logger.create Debug "bla" "ohai") + SetLogLevel Warn ] |> List.iter (fun ting -> From f68dfb11e5d05c246dcb7c19a9168b3fe21241c9 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Wed, 31 Jan 2018 15:33:00 +0100 Subject: [PATCH 05/27] use optics in Project module --- src/Disco/Disco/Core/Project.fs | 41 +++++-------------- src/Disco/Disco/Core/StateMachine.fs | 2 +- src/Disco/Disco/Service/CommandActions.fs | 4 +- src/Disco/Disco/Service/DiscoService.fs | 5 +-- src/Disco/Disco/Service/Persistence.fs | 2 +- src/Disco/Disco/Tests/Core/ApiTests.fs | 2 +- src/Disco/Disco/Tests/Core/Disco/Common.fs | 22 +++++----- .../Tests/Core/Disco/DiscoServiceTests.fs | 1 + src/Disco/Disco/Tests/Core/GitTests.fs | 2 +- .../Disco/Tests/Core/PersistenceTests.fs | 30 +++++++------- src/Disco/Disco/Tests/Core/ProjectTests.fs | 30 +++++++------- .../Disco/Tests/Core/RaftIntegrationTests.fs | 20 --------- src/Disco/Disco/Tests/Raft/RaftTestUtils.fs | 1 - src/Disco/Disco/Tests/TestUtilities.fs | 2 +- 14 files changed, 61 insertions(+), 103 deletions(-) diff --git a/src/Disco/Disco/Core/Project.fs b/src/Disco/Disco/Core/Project.fs index 49be5753..33f1fb13 100644 --- a/src/Disco/Disco/Core/Project.fs +++ b/src/Disco/Disco/Core/Project.fs @@ -2391,22 +2391,15 @@ module Project = let id = Optic.get DiscoProject.Id_ let name = Optic.get DiscoProject.Name_ - + let config = Optic.get DiscoProject.Config_ + let path = Optic.get DiscoProject.Path_ // ** setters let setId = Optic.set DiscoProject.Id_ let setName = Optic.set DiscoProject.Name_ - - // ** toFilePath - - let toFilePath (path: FilePath) = - path |> unwrap |> filepath - - // ** ofFilePath - - let ofFilePath (path: FilePath) = - path |> unwrap |> filepath + let setConfig = Optic.set DiscoProject.Config_ + let setPath = Optic.set DiscoProject.Path_ // ** repository @@ -2564,7 +2557,7 @@ module Project = if Path.isPathRooted filepath then filepath else - toFilePath project.Path filepath + project.Path filepath do! Git.Repo.stage repo abspath let! commit = Git.Repo.commit repo msg committer return commit, project @@ -2724,39 +2717,25 @@ module Project = Config = Config.create machine } do! initRepo project - let! _ = DiscoData.saveWithCommit (toFilePath path) User.Admin.Signature project + let! _ = DiscoData.saveWithCommit path User.Admin.Signature project return project } #endif - // ** config - - let config (project: DiscoProject) : DiscoConfig = project.Config - - // ** updatePath - - let updatePath (path: FilePath) (project: DiscoProject) : DiscoProject = - { project with Path = path } - - // ** updateConfig - - let updateConfig (config: DiscoConfig) (project: DiscoProject) : DiscoProject = - { project with Config = config } - // ** updateDataDir let updateDataDir (raftDir: FilePath) (project: DiscoProject) : DiscoProject = { project.Config.Raft with DataDir = raftDir } |> flip Config.updateEngine project.Config - |> flip updateConfig project + |> flip setConfig project // ** addMember let addMember (mem: ClusterMember) (project: DiscoProject) : DiscoProject = project.Config |> Config.addMember mem - |> flip updateConfig project + |> flip setConfig project // ** updateMember @@ -2768,7 +2747,7 @@ module Project = let removeMember (mem: MemberId) (project: DiscoProject) : DiscoProject = project.Config |> Config.removeMember mem - |> flip updateConfig project + |> flip setConfig project // ** findMember @@ -2788,7 +2767,7 @@ module Project = Config.addMember mem config) project.Config mems - |> flip updateConfig project + |> flip setConfig project // ** updateMachine diff --git a/src/Disco/Disco/Core/StateMachine.fs b/src/Disco/Disco/Core/StateMachine.fs index 0b3ee5ad..451a910b 100644 --- a/src/Disco/Disco/Core/StateMachine.fs +++ b/src/Disco/Disco/Core/StateMachine.fs @@ -1199,7 +1199,7 @@ module State = // ** updateConfig let updateConfig (config: DiscoConfig) (state: State) = - { state with Project = Project.updateConfig config state.Project } + { state with Project = Project.setConfig config state.Project } // ** updateProject diff --git a/src/Disco/Disco/Service/CommandActions.fs b/src/Disco/Disco/Service/CommandActions.fs index c08e3c08..4d4d3dee 100644 --- a/src/Disco/Disco/Service/CommandActions.fs +++ b/src/Disco/Disco/Service/CommandActions.fs @@ -95,7 +95,7 @@ let buildProject (machine: DiscoMachine) (raftDir: FilePath) (mem: ClusterMember) = either { - let! project = Project.create (Project.ofFilePath path) name machine + let! project = Project.create path name machine let site = let def = ClusterConfig.Default @@ -104,7 +104,7 @@ let buildProject (machine: DiscoMachine) let updated = project |> Project.updateDataDir raftDir - |> fun p -> Project.updateConfig (Config.addSiteAndSetActive site p.Config) p + |> fun p -> Project.setConfig (Config.addSiteAndSetActive site p.Config) p let! _ = DiscoData.saveWithCommit path User.Admin.Signature updated diff --git a/src/Disco/Disco/Service/DiscoService.fs b/src/Disco/Disco/Service/DiscoService.fs index 43ec23ea..9f3c3f78 100644 --- a/src/Disco/Disco/Service/DiscoService.fs +++ b/src/Disco/Disco/Service/DiscoService.fs @@ -376,7 +376,6 @@ module DiscoService = store.State.AssetService.State |> Option.map (fun tree -> [ AddFsTree tree ]) |> Option.defaultValue List.empty - let batch = List.concat [ mem @@ -384,13 +383,11 @@ module DiscoService = clients tree ] - /// send a batched state machine command to leader if non-empty if not (List.isEmpty batch) then (clients.Length,sessions.Length) |> String.format "sending batch command with {0} (clients,session) " |> Logger.debug (tag "sendLocalData") - batch |> CommandBatch.ofList |> RaftRequest.AppendEntry @@ -465,7 +462,7 @@ module DiscoService = |> Map.filter (fun id _ -> Array.contains id ids) |> flip ClusterConfig.setMembers activeSite |> flip Config.updateSite config - |> flip Project.updateConfig project + |> flip Project.setConfig project |> UpdateProject |> DiscoEvent.appendService |> Pipeline.push pipeline diff --git a/src/Disco/Disco/Service/Persistence.fs b/src/Disco/Disco/Service/Persistence.fs index 38a0c815..67a39014 100644 --- a/src/Disco/Disco/Service/Persistence.fs +++ b/src/Disco/Disco/Service/Persistence.fs @@ -300,7 +300,7 @@ module Persistence = let persistSnapshot (state: State) (log: RaftLogEntry) = either { - let path = Project.toFilePath state.Project.Path + let path = state.Project.Path do! state.Save(path) use! repo = Project.repository state.Project do! Git.Repo.stageAll repo diff --git a/src/Disco/Disco/Tests/Core/ApiTests.fs b/src/Disco/Disco/Tests/Core/ApiTests.fs index 374057d1..a4aac73b 100644 --- a/src/Disco/Disco/Tests/Core/ApiTests.fs +++ b/src/Disco/Disco/Tests/Core/ApiTests.fs @@ -26,7 +26,7 @@ module ApiTests = let project = { Id = DiscoId.Create() Name = name "Hello" - Path = Path.getTempPath() |> Project.ofFilePath + Path = Path.getTempPath() CreatedOn = Time.createTimestamp() LastSaved = Some (Time.createTimestamp ()) Copyright = None diff --git a/src/Disco/Disco/Tests/Core/Disco/Common.fs b/src/Disco/Disco/Tests/Core/Disco/Common.fs index fc1227c9..a4c7881e 100644 --- a/src/Disco/Disco/Tests/Core/Disco/Common.fs +++ b/src/Disco/Disco/Tests/Core/Disco/Common.fs @@ -46,11 +46,11 @@ module Common = |> Config.addSiteAndSetActive site |> Config.setLogLevel (LogLevel.Debug) - let! project = Project.create (Project.ofFilePath path) name machine + let! project = Project.create path name machine let updated = { project with - Path = Project.ofFilePath path + Path = path Author = Some(author1) Config = cfg } @@ -62,6 +62,14 @@ module Common = let mkMember (machine: DiscoMachine) = Machine.toClusterMember machine + let mkSite (members: ClusterMember list) = + { ClusterConfig.Default with + Name = name "Cool Cluster Yo" + Members = + members + |> List.map (fun mem -> mem.Id, mem) + |> Map.ofList } + let mkCluster (num: int) = either { let baseport = 4000us @@ -73,13 +81,7 @@ module Common = let members = List.map mkMember machines - let site = - { ClusterConfig.Default with - Name = name "Cool Cluster Yo" - Members = - members - |> List.map (fun mem -> mem.Id, mem) - |> Map.ofList } + let site = mkSite members let project = List.fold @@ -89,7 +91,7 @@ module Common = | Right project -> (i + 1, project) | Left error -> failwithf "unable to create project: %O" error else - let path = Project.toFilePath project'.Path + let path = project'.Path match copyDir path (machine.WorkSpace (project'.Name |> unwrap |> filepath)) with | Right () -> (i + 1, project') | Left error -> failwithf "error copying project: %O" error) diff --git a/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs b/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs index 3ec7fa81..25906995 100644 --- a/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs +++ b/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs @@ -41,4 +41,5 @@ module DiscoServiceTests = PinBecomesDirty.test StateShouldBeCleanedOnClientRemove.test RemoveMemberShouldSplitCluster.test + AddPreviousMemberShouldPull.test ] |> testSequenced diff --git a/src/Disco/Disco/Tests/Core/GitTests.fs b/src/Disco/Disco/Tests/Core/GitTests.fs index fb1ef5eb..1d35af34 100644 --- a/src/Disco/Disco/Tests/Core/GitTests.fs +++ b/src/Disco/Disco/Tests/Core/GitTests.fs @@ -35,7 +35,7 @@ module GitTests = let project = let p = - Project.create (Project.ofFilePath tmpdir) "Test Project" machine + Project.create tmpdir "Test Project" machine |> Either.get in { p with Config = config } diff --git a/src/Disco/Disco/Tests/Core/PersistenceTests.fs b/src/Disco/Disco/Tests/Core/PersistenceTests.fs index 2baf17f2..c268522c 100644 --- a/src/Disco/Disco/Tests/Core/PersistenceTests.fs +++ b/src/Disco/Disco/Tests/Core/PersistenceTests.fs @@ -25,7 +25,7 @@ module PersistenceTests = let name = rndstr() do! MachineConfig.init (konst "127.0.0.1") None (Some root) let machine = MachineConfig.get () - let path = Project.ofFilePath (root filepath name) + let path = root filepath name let! project = Project.create path name machine return machine, project } @@ -55,7 +55,7 @@ module PersistenceTests = let widget = mkPinWidget() let! (machine, state) = mkState () |> Either.map (State.addPinWidget widget |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinWidget widget) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinWidget" true (Map.containsKey widget.Id) state.PinWidgets expect "PinWidgets should be the same" state.PinWidgets id loaded.PinWidgets } @@ -69,7 +69,7 @@ module PersistenceTests = mkState () |> Either.map (State.addPinMapping mapping |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinMapping mapping) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinMapping" true (Map.containsKey mapping.Id) state.PinMappings expect "PinMappings should be the same" state.PinMappings id loaded.PinMappings } @@ -81,7 +81,7 @@ module PersistenceTests = let group = mkPinGroup() let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinGroup" true @@ -98,14 +98,14 @@ module PersistenceTests = let widget = mkPinWidget() let! (machine, state) = mkState () |> Either.map (State.addPinWidget widget |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinWidget widget) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinWidget" true (Map.containsKey widget.Id) state.PinWidgets expect "PinWidgets should be the same" state.PinWidgets id loaded.PinWidgets let updated = State.removePinWidget widget loaded let! _ = Persistence.persistEntry state (RemovePinWidget widget) - let! loaded = Asset.loadWithMachine (Project.toFilePath updated.Project.Path) machine + let! loaded = Asset.loadWithMachine updated.Project.Path machine expect "state should contain PinWidget" true (Map.containsKey widget.Id >> not) updated.PinWidgets expect "PinWidgets should be the same" updated.PinWidgets id loaded.PinWidgets @@ -120,14 +120,14 @@ module PersistenceTests = mkState () |> Either.map (State.addPinMapping mapping |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinMapping mapping) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinMapping" true (Map.containsKey mapping.Id) state.PinMappings expect "PinMappings should be the same" state.PinMappings id loaded.PinMappings let updated = State.removePinMapping mapping loaded let! _ = Persistence.persistEntry state (RemovePinMapping mapping) - let! loaded = Asset.loadWithMachine (Project.toFilePath updated.Project.Path) machine + let! loaded = Asset.loadWithMachine updated.Project.Path machine expect "state should contain PinMapping" true @@ -144,7 +144,7 @@ module PersistenceTests = let group = mkPinGroup() let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinGroup" true @@ -155,7 +155,7 @@ module PersistenceTests = let updated = State.removePinGroup group loaded let! _ = Persistence.persistEntry state (RemovePinGroup group) - let! loaded = Asset.loadWithMachine (Project.toFilePath updated.Project.Path) machine + let! loaded = Asset.loadWithMachine updated.Project.Path machine expect "state should contain PinGroup" true @@ -218,7 +218,7 @@ module PersistenceTests = let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinGroup" true @@ -229,7 +229,7 @@ module PersistenceTests = let updated = State.addPin pin state let! _ = Persistence.persistEntry updated (AddPin pin) - let! loaded = Asset.loadWithMachine (Project.toFilePath updated.Project.Path) machine + let! loaded = Asset.loadWithMachine updated.Project.Path machine expect "state should contain Pin" true @@ -256,7 +256,7 @@ module PersistenceTests = let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) - let! loaded = Asset.loadWithMachine (Project.toFilePath state.Project.Path) machine + let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinGroup" true @@ -267,7 +267,7 @@ module PersistenceTests = let updated = State.addPin pin state let! _ = Persistence.persistEntry updated (AddPin pin) - let! loaded = Asset.loadWithMachine (Project.toFilePath updated.Project.Path) machine + let! loaded = Asset.loadWithMachine updated.Project.Path machine expect "state should contain Pin" true @@ -278,7 +278,7 @@ module PersistenceTests = let updated = State.removePin pin updated let! _ = Persistence.persistEntry updated (RemovePin pin) - let! reloaded = Asset.loadWithMachine (Project.toFilePath updated.Project.Path) machine + let! reloaded = Asset.loadWithMachine updated.Project.Path machine expect "state should not contain Pin" true diff --git a/src/Disco/Disco/Tests/Core/ProjectTests.fs b/src/Disco/Disco/Tests/Core/ProjectTests.fs index 5fdcc897..7ab46f29 100644 --- a/src/Disco/Disco/Tests/Core/ProjectTests.fs +++ b/src/Disco/Disco/Tests/Core/ProjectTests.fs @@ -32,9 +32,9 @@ module ProjectTests = let path = tmpPath() let name = Path.getFileName path |> unwrap - let! project = Project.create (Project.ofFilePath path) name machine + let! project = Project.create path name machine - let result = Asset.loadWithMachine (Project.toFilePath project.Path) machine + let result = Asset.loadWithMachine project.Path machine do! expectE "Projects should be equal" true ((=) project) result } @@ -55,7 +55,7 @@ module ProjectTests = let path = tmpPath() let name = Path.getFileName path |> unwrap - let! project = Project.create (Project.ofFilePath path) name machine + let! project = Project.create path name machine let! repo = Project.repository project let! status = Git.Repo.status repo let untracked = status.Untracked.Count() @@ -78,7 +78,7 @@ module ProjectTests = let path = Path.getRandomFileName() - let result = Project.create (Project.ofFilePath path) (unwrap path) machine + let result = Project.create path (unwrap path) machine expect "Create should have failed" false Either.isSuccess result @@ -155,10 +155,10 @@ module ProjectTests = |] Groups = [| groupA; groupB |] } - let! project = Project.create (Project.ofFilePath path) (unwrap fn) machine + let! project = Project.create path (unwrap fn) machine let updated = - Project.updateConfig + Project.setConfig { project.Config with Raft = engineCfg Clients = clientCfg @@ -218,7 +218,7 @@ module ProjectTests = let path = tmpPath() let name = Path.getFileName path |> unwrap - let! _ = Project.create (Project.ofFilePath path) name machine + let! _ = Project.create path name machine let loaded = Asset.loadWithMachine path machine @@ -269,7 +269,7 @@ module ProjectTests = let author1 = "karsten" - let! project = Project.create (Project.ofFilePath path) name machine + let! project = Project.create path name machine let updated = { project with Author = Some author1 } let! commit = DiscoData.saveWithCommit path User.Admin.Signature updated @@ -312,10 +312,10 @@ module ProjectTests = let path = tmpPath() let name = Path.getFileName path |> unwrap - let! project = Project.create (Project.ofFilePath path) name machine + let! project = Project.create path name machine let! (loaded: DiscoProject) = Asset.loadWithMachine path machine - expect "Project should have correct path" path Project.toFilePath loaded.Path + expect "Project should have correct path" path id loaded.Path let newpath = tmpPath() @@ -323,7 +323,7 @@ module ProjectTests = let! (loaded: DiscoProject) = Asset.loadWithMachine newpath machine - expect "Project should have correct path" newpath Project.toFilePath loaded.Path + expect "Project should have correct path" newpath id loaded.Path } |> noError @@ -335,7 +335,7 @@ module ProjectTests = let path = tmpPath() let fn = Path.getFileName path |> unwrap - let! project = Project.create (Project.ofFilePath path) fn machine + let! project = Project.create path fn machine let user = { Id = DiscoId.Create() @@ -351,7 +351,7 @@ module ProjectTests = let! (commit, project) = Project.saveAsset user User.Admin project let! (loaded: User) = - let userpath = Project.toFilePath project.Path Asset.path user + let userpath = project.Path Asset.path user File.readText(userpath) |> Yaml.decode @@ -366,10 +366,10 @@ module ProjectTests = let path = tmpPath() let name = Path.getFileName path |> unwrap - let! project = Project.create (Project.ofFilePath path) name machine + let! project = Project.create path name machine let! (admin: User) = - Project.toFilePath project.Path Asset.path User.Admin + project.Path Asset.path User.Admin |> File.readText |> Yaml.decode diff --git a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs index 88df605c..9acef57f 100644 --- a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs +++ b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs @@ -365,18 +365,6 @@ module RaftIntegrationTests = do! waitFor "configured" configured } |> noError - // _ _ - // _ __ ___ _ __ __| (_)_ __ __ _ - // | '_ \ / _ \ '_ \ / _` | | '_ \ / _` | - // | |_) | __/ | | | (_| | | | | | (_| | - // | .__/ \___|_| |_|\__,_|_|_| |_|\__, | - // |_| |___/ - - let test_follower_join_should_fail_on_duplicate_raftid = - pending "follower join should fail on duplicate raftid" - - let test_all_rafts_should_share_a_common_distributed_event_log = - pending "all rafts should share a common distributed event log" // _ _ _ _____ _ // / \ | | | |_ _|__ ___| |_ ___ @@ -386,17 +374,9 @@ module RaftIntegrationTests = let raftIntegrationTests = testList "Raft Integration Tests" [ - // raft test_validate_correct_req_socket_tracking test_validate_raft_service_bind_correct_port test_validate_follower_joins_leader_after_startup - - // db test_log_snapshotting_should_clean_all_logs - - // cluster changes test_validate_add_member_works - - // test_follower_join_should_fail_on_duplicate_raftid - // test_all_rafts_should_share_a_common_distributed_event_log ] |> testSequenced diff --git a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs index 76cb50c9..de56a6d3 100644 --- a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs +++ b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs @@ -174,7 +174,6 @@ module RaftTestUtils = let defSM = mkTmpDir() - |> Project.ofFilePath |> mkState |> Either.get |> StateMachine.DataSnapshot diff --git a/src/Disco/Disco/Tests/TestUtilities.fs b/src/Disco/Disco/Tests/TestUtilities.fs index aa2e672b..3856aa5b 100644 --- a/src/Disco/Disco/Tests/TestUtilities.fs +++ b/src/Disco/Disco/Tests/TestUtilities.fs @@ -401,7 +401,7 @@ module TestData = let mkLog _ : Either = either { - let! state = mkTmpDir() |> Project.ofFilePath |> mkState + let! state = mkTmpDir() |> mkState return LogEntry(DiscoId.Create(), index 7, term 1, DataSnapshot(state), Some <| LogEntry(DiscoId.Create(), index 6, term 1, DataSnapshot(state), From f7de09783e0eeb13cb9be364ceec148ff7ac85bf Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Tue, 6 Feb 2018 15:20:52 +0100 Subject: [PATCH 06/27] refactoring Raft modules --- src/Disco/Disco/Raft/Raft.fs | 257 ++++++------ src/Disco/Disco/Raft/Types.fs | 387 ++++++++++++------ src/Disco/Disco/Service/DiscoService.fs | 75 ++-- .../Core/Disco/AddPreviousMemberShouldPull.fs | 124 ++++++ src/Disco/Disco/Tests/Raft/ServerTests.fs | 34 +- src/Disco/Projects/Tests/Tests.fsproj | 3 + src/Frontend/src/Frontend/Elmish/Types.fs | 1 + 7 files changed, 577 insertions(+), 304 deletions(-) create mode 100644 src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index 5fd5e05c..82e18b3f 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -344,10 +344,9 @@ module rec Raft = if inJointConsensus state then // take the old peers as seed and apply the new peers on top match state.OldPeers with - | Some peers -> Map.fold (fun m k n -> Map.add k n m) peers state.Peers - | _ -> state.Peers - else - state.Peers + | Some peers -> Map.fold (fun m k n -> Map.add k n m) peers state.Peers + | _ -> state.Peers + else state.Peers // ** logicalPeersM @@ -1158,14 +1157,16 @@ module rec Raft = |> applyChanges changes |> setOldPeers (Some old) - // ** appendEntry + // ** updateLog - // _ _____ _ - // __ _ _ __ _ __ ___ _ __ __| | ____|_ __ | |_ _ __ _ _ - // / _` | '_ \| '_ \ / _ \ '_ \ / _` | _| | '_ \| __| '__| | | | - // | (_| | |_) | |_) | __/ | | | (_| | |___| | | | |_| | | |_| | - // \__,_| .__/| .__/ \___|_| |_|\__,_|_____|_| |_|\__|_| \__, | - // |_| |_| |___/ + let updateLog log state = { state with Log = log } + + // ** updateLogM + + let updateLogM log = + get >>= (updateLog log >> put) + + // ** appendEntry let private appendEntry (log: RaftLogEntry) = raft { @@ -1173,7 +1174,7 @@ module rec Raft = // create the new log by appending let newlog = Log.append log state.Log - do! put { state with Log = newlog } + do! updateLogM newlog // get back the entries just added // (with correct monotonic idx's) @@ -1207,11 +1208,6 @@ module rec Raft = return! appendEntryM log } - // ** updateLog - - let updateLog (log: RaftLog) (state: RaftState) = - { state with Log = log } - // ** updateLogEntries let updateLogEntries (entries: RaftLogEntry) (state: RaftState) = @@ -1511,6 +1507,8 @@ module rec Raft = do! msg.PrevLogIdx |> String.format "Failed. No log at (prev-log-idx: {0})" |> error "receiveAppendEntries" + let! state = get + do printfn "state: %A" state return resp else return! processEntry nid msg resp @@ -1754,12 +1752,12 @@ module rec Raft = do! sendInstallSnapshot mem do! updateCommitIdx |> modify - - return! currentTermM () >>= fun term -> - returnM { resp with - Id = LogEntry.getId appended - Term = term - Index = LogEntry.getIndex appended } + let! term = currentTermM () + return + { resp with + Id = LogEntry.getId appended + Term = term + Index = LogEntry.getIndex appended } | _ -> return! "Append Entry failed" @@ -1769,17 +1767,10 @@ module rec Raft = // ** receiveEntry - /// _ _____ _ - /// _ __ ___ ___ ___(_)_ _____| ____|_ __ | |_ _ __ _ _ - /// | '__/ _ \/ __/ _ \ \ \ / / _ \ _| | '_ \| __| '__| | | | - /// | | | __/ (_| __/ |\ V / __/ |___| | | | |_| | | |_| | - /// |_| \___|\___\___|_| \_/ \___|_____|_| |_|\__|_| \__, | - /// |___/ - let receiveEntry (entry : RaftLogEntry) = raft { let! state = get - let resp = { Id = DiscoId.Create(); Term = term 0; Index = index 0 } + let response = EntryResponse.create 0 0 if LogEntry.isConfigChange entry && Option.isSome state.ConfigChangeEntry then do! debug "receiveEntry" "Error: UnexpectedVotingChange" @@ -1799,15 +1790,15 @@ module rec Raft = match entry with | LogEntry(id,_,_,data,_) -> let log = LogEntry(id, index 0, term, data, None) - return! handleLog log resp + return! handleLog log response | Configuration(id,_,_,mems,_) -> let log = Configuration(id, index 0, term, mems, None) - return! handleLog log resp + return! handleLog log response | JointConsensus(id,_,_,changes,_) -> let log = JointConsensus(id, index 0, term, changes, None) - return! handleLog log resp + return! handleLog log response | _ -> return! @@ -2243,105 +2234,105 @@ module rec Raft = let receiveVoteResponse (nid : MemberId) (vote : VoteResponse) = raft { - let! state = get + let! state = get - do! (if vote.Granted then "granted" else "not granted") - |> sprintf "%O responded to vote request with: %s" nid + do! (if vote.Granted then "granted" else "not granted") + |> sprintf "%O responded to vote request with: %s" nid + |> debug "receiveVoteResponse" + + /// The term must not be bigger than current raft term, + /// otherwise set term to vote term become follower. + if vote.Term > state.CurrentTerm then + do! sprintf "(vote term: %d) > (current term: %d). Setting to %d." + vote.Term + state.CurrentTerm + state.CurrentTerm |> debug "receiveVoteResponse" + do! setTermM vote.Term + do! setLeaderM (Some nid) + do! becomeFollower () + + /// If the vote term is smaller than current term it is considered an + /// error and the client will be notified. + elif vote.Term < state.CurrentTerm then + do! sprintf "Failed: (vote term: %d) < (current term: %d). VoteTermMismatch." + vote.Term + state.CurrentTerm + |> debug "receiveVoteResponse" + return! + "Vote Term Mismatch" + |> Error.asRaftError (tag "receiveVoteResponse") + |> failM - /// The term must not be bigger than current raft term, - /// otherwise set term to vote term become follower. - if vote.Term > state.CurrentTerm then - do! sprintf "(vote term: %d) > (current term: %d). Setting to %d." - vote.Term - state.CurrentTerm - state.CurrentTerm - |> debug "receiveVoteResponse" - do! setTermM vote.Term - do! setLeaderM (Some nid) - do! becomeFollower () - - /// If the vote term is smaller than current term it is considered an - /// error and the client will be notified. - elif vote.Term < state.CurrentTerm then - do! sprintf "Failed: (vote term: %d) < (current term: %d). VoteTermMismatch." - vote.Term - state.CurrentTerm - |> debug "receiveVoteResponse" + /// Process the vote if current state of our Raft must be candidate.. + else + match state.State with + | Leader -> return () + | Follower -> + /// ...otherwise we respond with the respective RaftError. + do! debug "receiveVoteResponse" "Failed: NotCandidate" return! - "Vote Term Mismatch" + "Not Candidate" |> Error.asRaftError (tag "receiveVoteResponse") |> failM - - /// Process the vote if current state of our Raft must be candidate.. - else - match state.State with - | Leader -> return () - | Follower -> - /// ...otherwise we respond with the respective RaftError. - do! debug "receiveVoteResponse" "Failed: NotCandidate" - return! - "Not Candidate" - |> Error.asRaftError (tag "receiveVoteResponse") - |> failM - | Candidate -> - if vote.Granted then - let! mem = getMemberM nid - match mem with - // Could not find the mem in current configuration(s) - | None -> - do! debug "receiveVoteResponse" "Failed: vote granted but NoMember" - return! - "No Node" - |> Error.asRaftError (tag "receiveVoteResponse") - |> failM - // found the mem - | Some mem -> - do! setVotingM mem true - - let! transitioning = inJointConsensusM () - - // in joint consensus - if transitioning then - // _ _ _ - // | | ___ (_)_ __ | |_ - // _ | |/ _ \| | '_ \| __| - // | |_| | (_) | | | | | |_ - // \___/ \___/|_|_| |_|\__| consensus. - // - // we probe for a majority in both configurations - let! newConfig = - numVotesForMeM () >>= regularMajorityM - - let! oldConfig = - numVotesForMeOldConfigM () >>= oldConfigMajorityM - - do! sprintf "In JointConsensus (majority new config: %b) (majority old config: %b)" - newConfig - oldConfig - |> debug "receiveVoteResponse" - - // and finally, become leader if we have a majority in either - // configuration - if newConfig || oldConfig then - do! becomeLeader () - else - // ____ _ - // | _ \ ___ __ _ _ _| | __ _ _ __ - // | |_) / _ \/ _` | | | | |/ _` | '__| - // | _ < __/ (_| | |_| | | (_| | | - // |_| \_\___|\__, |\__,_|_|\__,_|_| configuration. - // |___/ - // the base case: we are not in joint consensus so we just use - // regular configuration functions - let! majority = - numVotesForMeM () >>= regularMajorityM - - do! sprintf "(majority for config: %b)" majority - |> debug "receiveVoteResponse" - - if majority then - do! becomeLeader () + | Candidate -> + if vote.Granted then + let! mem = getMemberM nid + match mem with + // Could not find the mem in current configuration(s) + | None -> + do! debug "receiveVoteResponse" "Failed: vote granted but NoMember" + return! + "No Node" + |> Error.asRaftError (tag "receiveVoteResponse") + |> failM + // found the mem + | Some mem -> + do! setVotingM mem true + + let! transitioning = inJointConsensusM () + + // in joint consensus + if transitioning then + // _ _ _ + // | | ___ (_)_ __ | |_ + // _ | |/ _ \| | '_ \| __| + // | |_| | (_) | | | | | |_ + // \___/ \___/|_|_| |_|\__| consensus. + // + // we probe for a majority in both configurations + let! newConfig = + numVotesForMeM () >>= regularMajorityM + + let! oldConfig = + numVotesForMeOldConfigM () >>= oldConfigMajorityM + + do! sprintf "In JointConsensus (majority new config: %b) (majority old config: %b)" + newConfig + oldConfig + |> debug "receiveVoteResponse" + + // and finally, become leader if we have a majority in either + // configuration + if newConfig || oldConfig then + do! becomeLeader () + else + // ____ _ + // | _ \ ___ __ _ _ _| | __ _ _ __ + // | |_) / _ \/ _` | | | | |/ _` | '__| + // | _ < __/ (_| | |_| | | (_| | | + // |_| \_\___|\__, |\__,_|_|\__,_|_| configuration. + // |___/ + // the base case: we are not in joint consensus so we just use + // regular configuration functions + let! majority = + numVotesForMeM () >>= regularMajorityM + + do! sprintf "(majority for config: %b)" majority + |> debug "receiveVoteResponse" + + if majority then + do! becomeLeader () } // ** sendVoteRequest @@ -2573,13 +2564,15 @@ module rec Raft = let! timedout = requestTimedOutM () if consensus then - let! waiting = hasNonVotingMembersM () // check if any mems are still marked non-voting/Joining - if not waiting then // are mems are voting and have caught up + // check if any mems are still marked non-voting/Joining + // are mems are voting and have caught up + let! waiting = hasNonVotingMembersM () + if not waiting then let! term = currentTermM () - let resp = { Id = DiscoId.Create(); Term = term; Index = index 0 } + let response = EntryResponse.create term 0 let! mems = getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) - let log = Configuration(resp.Id, index 0, term, mems, None) - do! handleLog log resp >>= ignoreM + let log = Configuration(response.Id, index 0, term, mems, None) + do! handleLog log response >>= ignoreM else do! sendAllAppendEntriesM () // the regular case is we need to ping our followers so as to not provoke an election diff --git a/src/Disco/Disco/Raft/Types.fs b/src/Disco/Disco/Raft/Types.fs index 04cee80e..29b4de2e 100644 --- a/src/Disco/Disco/Raft/Types.fs +++ b/src/Disco/Disco/Raft/Types.fs @@ -23,23 +23,22 @@ open SharpYaml.Serialization // * EntryResponse /// Response to an AppendEntry request -/// -/// ## Constructor: -/// - `Id` - the generated unique identified for the entry -/// - `Term` - the entry's term -/// - `Index` - the entry's index in the log + type EntryResponse = - { Id : LogId - Term : Term - Index : Index } + { Id: LogId + Term: Term + Index: Index } // ** ToString + override self.ToString() = sprintf "Entry added with Id: %A in term: %d at log index: %d" (string self.Id) self.Term self.Index + // ** ToOffset + member self.ToOffset(builder: FlatBufferBuilder) = let id = EntryResponseFB.CreateIdVector(builder,self.Id.ToByteArray()) EntryResponseFB.StartEntryResponseFB(builder) @@ -48,6 +47,8 @@ type EntryResponse = EntryResponseFB.AddIndex(builder, int self.Index) EntryResponseFB.EndEntryResponseFB(builder) + // ** FromFB + static member FromFB(fb: EntryResponseFB) = either { let! id = Id.decodeId fb @@ -58,27 +59,46 @@ type EntryResponse = } } -// * Entry + // ** optics + + static member Id_ = + (fun (er: EntryResponse) -> er.Id), + (fun id (er: EntryResponse) -> { er with Id = id }) + + static member Term_ = + (fun (er: EntryResponse) -> er.Term), + (fun term (er: EntryResponse) -> { er with Term = term }) + + static member Index_ = + (fun (er: EntryResponse) -> er.Index), + (fun index (er: EntryResponse) -> { er with Index = index }) + +// * EntryResponse module [] -module Entry = - // ** id - let inline id (er : EntryResponse) = er.Id +module EntryResponse = + open Aether - // ** term - let inline term (er : EntryResponse) = er.Term + // ** getting - // ** index - let inline index (er : EntryResponse) = er.Index + let id = Optic.get EntryResponse.Id_ + let term = Optic.get EntryResponse.Term_ + let index = Optic.get EntryResponse.Index_ -// * VoteRequest + // ** setting + + let setId = Optic.set EntryResponse.Id_ + let setTerm = Optic.set EntryResponse.Term_ + let setIndex = Optic.set EntryResponse.Index_ + + // ** create -// __ __ _ ____ _ -// \ \ / /__ | |_ ___| _ \ ___ __ _ _ _ ___ ___| |_ -// \ \ / / _ \| __/ _ \ |_) / _ \/ _` | | | |/ _ \/ __| __| -// \ V / (_) | || __/ _ < __/ (_| | |_| | __/\__ \ |_ -// \_/ \___/ \__\___|_| \_\___|\__, |\__,_|\___||___/\__| -// |_| + let create term index : EntryResponse = + { Id = DiscoId.Create() + Term = term + Index = index } + +// * VoteRequest /// Request to Vote for a new Leader /// @@ -87,6 +107,7 @@ module Entry = /// - `Candidate` - the unique mem id of candidate for leadership /// - `LastLogIndex` - the index of the candidates last log entry /// - `LastLogTerm` - the index of the candidates last log entry + type VoteRequest = { Term : Term Candidate : RaftMember @@ -94,6 +115,7 @@ type VoteRequest = LastLogTerm : Term } // ** ToOffset + member self.ToOffset(builder: FlatBufferBuilder) = let mem = self.Candidate.ToOffset(builder) VoteRequestFB.StartVoteRequestFB(builder) @@ -104,6 +126,7 @@ type VoteRequest = VoteRequestFB.EndVoteRequestFB(builder) // ** FromFB + static member FromFB (fb: VoteRequestFB) : Either = either { let candidate = fb.Candidate @@ -120,26 +143,58 @@ type VoteRequest = |> Either.fail } -// * VoteResponse + // ** optics + + static member Term_ = + (fun (vr:VoteRequest) -> vr.Term), + (fun term (vr:VoteRequest) -> { vr with Term = term }) + + static member Candidate_ = + (fun (vr:VoteRequest) -> vr.Candidate), + (fun candidate (vr:VoteRequest) -> { vr with Candidate = candidate }) + + static member LastLogIndex_ = + (fun (vr:VoteRequest) -> vr.LastLogIndex), + (fun lastLogIndex (vr:VoteRequest) -> { vr with LastLogIndex = lastLogIndex }) + + static member LastLogTerm_ = + (fun (vr:VoteRequest) -> vr.LastLogTerm), + (fun lastLogTerm (vr:VoteRequest) -> { vr with LastLogTerm = lastLogTerm }) -// __ __ _ ____ -// \ \ / /__ | |_ ___| _ \ ___ ___ _ __ ___ _ __ ___ ___ -// \ \ / / _ \| __/ _ \ |_) / _ \/ __| '_ \ / _ \| '_ \/ __|/ _ \ -// \ V / (_) | || __/ _ < __/\__ \ |_) | (_) | | | \__ \ __/ -// \_/ \___/ \__\___|_| \_\___||___/ .__/ \___/|_| |_|___/\___| -// |_| +// * VoteRequest module + +module VoteRequest = + open Aether + + // ** getters + + let term = Optic.get VoteRequest.Term_ + let candidate = Optic.get VoteRequest.Candidate_ + let lastLogIndex = Optic.get VoteRequest.LastLogIndex_ + let lastLogTerm = Optic.get VoteRequest.LastLogTerm_ + + // ** setters + + let setTerm = Optic.set VoteRequest.Term_ + let setCandidate = Optic.set VoteRequest.Candidate_ + let setLastLogIndex = Optic.set VoteRequest.LastLogIndex_ + let setLastLogTerm = Optic.set VoteRequest.LastLogIndex_ + +// * VoteResponse /// Result of a vote /// /// ## Result: /// - `Term` - current term for candidate to apply /// - `Granted` - result of vote + type VoteResponse = { Term : Term Granted : bool Reason : DiscoError option } // ** FromFB + static member FromFB (fb: VoteResponseFB) : Either = either { let! reason = @@ -149,13 +204,15 @@ type VoteResponse = |> Either.map Some else Right None - - return { Term = term fb.Term - Granted = fb.Granted - Reason = reason } + return { + Term = term fb.Term + Granted = fb.Granted + Reason = reason + } } // ** ToOffset + member self.ToOffset(builder: FlatBufferBuilder) = let err = Option.map (fun (r: DiscoError) -> r.ToOffset(builder)) self.Reason VoteResponseFB.StartVoteResponseFB(builder) @@ -166,39 +223,45 @@ type VoteResponse = VoteResponseFB.AddGranted(builder, self.Granted) VoteResponseFB.EndVoteResponseFB(builder) + // ** optics + + static member Term_ = + (fun (vr:VoteResponse) -> vr.Term), + (fun term (vr:VoteResponse) -> { vr with Term = term }) + + static member Granted_ = + (fun (vr:VoteResponse) -> vr.Granted), + (fun granted (vr:VoteResponse) -> { vr with Granted = granted }) + + static member Reason_ = + (fun (vr:VoteResponse) -> vr.Reason), + (fun reason (vr:VoteResponse) -> { vr with Reason = reason }) + +// * VoteResponse module -// * module Vote [] -module Vote = +module VoteResponse = - // ** term - let inline term (vote : VoteRequest) = vote.Term + open Aether - // ** candiate - let inline candidate (vote : VoteRequest) = vote.Candidate + // ** getters - // ** lastLogIndex - let inline lastLogIndex (vote : VoteRequest) = vote.LastLogIndex + let term = Optic.get VoteResponse.Term_ + let granted = Optic.get VoteResponse.Granted_ + let reason = Optic.get VoteResponse.Reason_ - // ** lastLogTerm - let inline lastLogTerm (vote : VoteRequest) = vote.LastLogTerm + // ** setters - // ** granted - let inline granted (vote : VoteResponse) = vote.Granted + let setTerm = Optic.set VoteResponse.Term_ + let setGranted = Optic.set VoteResponse.Granted_ + let setReason = Optic.set VoteResponse.Reason_ // ** declined - let inline declined (vote : VoteResponse) = not vote.Granted + let declined = granted >> not // * AppendEntries -// _ _ _____ _ _ -// / \ _ __ _ __ ___ _ __ __| | ____|_ __ | |_ _ __(_) ___ ___ -// / _ \ | '_ \| '_ \ / _ \ '_ \ / _` | _| | '_ \| __| '__| |/ _ \/ __| -// / ___ \| |_) | |_) | __/ | | | (_| | |___| | | | |_| | | | __/\__ \ -// /_/ \_\ .__/| .__/ \___|_| |_|\__,_|_____|_| |_|\__|_| |_|\___||___/ -// |_| |_| - /// AppendEntries message. /// /// This message is used to tell mems if it's safe to apply entries to the @@ -210,6 +273,7 @@ module Vote = /// - `PrevLogIdx` - the index of the log just before the newest entry for the mem who receive this message /// - `PrevLogTerm` - the term of the log just before the newest entry for the mem who receives this message /// - `LeaderCommit`- the index of the entry that has been appended to the majority of the cluster. Entries up to this index will be applied to the FSM + type AppendEntries = { Term : Term PrevLogIdx : Index @@ -240,6 +304,7 @@ type AppendEntries = (fun entries (ae:AppendEntries) -> { ae with Entries = entries }) // ** FromFB + static member FromFB (fb: AppendEntriesFB) : Either = either { let! entries = @@ -261,6 +326,7 @@ type AppendEntries = } // ** ToOffset + member self.ToOffset(builder: FlatBufferBuilder) = let entries = Option.map @@ -280,14 +346,34 @@ type AppendEntries = AppendEntriesFB.EndAppendEntriesFB(builder) -// * AppendResponse +// * AppendRequest module + +module AppendEntries = + open Aether + + // ** getters + + let term = Optic.get AppendEntries.Term_ + let prevLogIdx = Optic.get AppendEntries.PrevLogIdx_ + let prevLogTerm = Optic.get AppendEntries.PrevLogTerm_ + let leaderCommit = Optic.get AppendEntries.LeaderCommit_ + let entries = Optic.get AppendEntries.Entries_ -// _ _ ____ -// / \ _ __ _ __ ___ _ __ __| | _ \ ___ ___ _ __ ___ _ __ ___ ___ -// / _ \ | '_ \| '_ \ / _ \ '_ \ / _` | |_) / _ \/ __| '_ \ / _ \| '_ \/ __|/ _ \ -// / ___ \| |_) | |_) | __/ | | | (_| | _ < __/\__ \ |_) | (_) | | | \__ \ __/ -// /_/ \_\ .__/| .__/ \___|_| |_|\__,_|_| \_\___||___/ .__/ \___/|_| |_|___/\___| -// |_| |_| |_| + // ** setters + + let setTerm = Optic.set AppendEntries.Term_ + let setPrevLogIdx = Optic.set AppendEntries.PrevLogIdx_ + let setPrevLogTerm = Optic.set AppendEntries.PrevLogTerm_ + let setLeaderCommit = Optic.set AppendEntries.LeaderCommit_ + let setEntries = Optic.set AppendEntries.Entries_ + + // ** numEntries + + let numEntries = entries >> function + | Some entries -> LogEntry.depth entries + | _ -> 0 + +// * AppendResponse /// Appendentries response message. /// @@ -299,6 +385,7 @@ type AppendEntries = /// - `Success` - true if follower contained entry matching prevLogidx and prevLogTerm /// - `CurrentIdx` - This is the highest log IDX we've received and appended to our log /// - `FirstIdx` - The first idx that we received within the appendentries message + type AppendResponse = { Term : Term Success : bool @@ -324,13 +411,17 @@ type AppendResponse = (fun firstIndex (ar:AppendResponse) -> { ar with FirstIndex = firstIndex }) // ** FromFB - static member FromFB (fb: AppendResponseFB) : Either = - Right { Term = term fb.Term - Success = fb.Success - CurrentIndex = index fb.CurrentIndex - FirstIndex = index fb.FirstIndex } + + static member FromFB (fb: AppendResponseFB) = + Either.succeed { + Term = term fb.Term + Success = fb.Success + CurrentIndex = index fb.CurrentIndex + FirstIndex = index fb.FirstIndex + } // ** ToOffset + member self.ToOffset(builder: FlatBufferBuilder) = AppendResponseFB.StartAppendResponseFB(builder) AppendResponseFB.AddTerm(builder, int self.Term) @@ -339,37 +430,7 @@ type AppendResponse = AppendResponseFB.AddCurrentIndex(builder, int self.CurrentIndex) AppendResponseFB.EndAppendResponseFB(builder) -// * module AppendRequest - -[] -module AppendRequest = - - open Aether - - // ** getters - - let term = Optic.get AppendEntries.Term_ - let prevLogIdx = Optic.get AppendEntries.PrevLogIdx_ - let prevLogTerm = Optic.get AppendEntries.PrevLogTerm_ - let leaderCommit = Optic.get AppendEntries.LeaderCommit_ - let entries = Optic.get AppendEntries.Entries_ - - // ** setters - - let setTerm = Optic.set AppendEntries.Term_ - let setPrevLogIdx = Optic.set AppendEntries.PrevLogIdx_ - let setPrevLogTerm = Optic.set AppendEntries.PrevLogTerm_ - let setLeaderCommit = Optic.set AppendEntries.LeaderCommit_ - let setEntries = Optic.set AppendEntries.Entries_ - - // ** numEntries - - let inline numEntries ar = - match ar.Entries with - | Some entries -> LogEntry.depth entries - | _ -> 0 - -// * AppendResponse +// * AppendResponse module module AppendResponse = @@ -413,6 +474,28 @@ type InstallSnapshot = LastTerm: Term Data: RaftLogEntry } + // ** optics + + static member Term_ = + (fun (is:InstallSnapshot) -> is.Term), + (fun term (is:InstallSnapshot) -> { is with Term = term }) + + static member LeaderId_ = + (fun (is:InstallSnapshot) -> is.LeaderId), + (fun leaderId (is:InstallSnapshot) -> { is with LeaderId = leaderId }) + + static member LastIndex_ = + (fun (is:InstallSnapshot) -> is.LastIndex), + (fun lastIndex (is:InstallSnapshot) -> { is with LastIndex = lastIndex }) + + static member LastTerm_ = + (fun (is:InstallSnapshot) -> is.LastTerm), + (fun lastTerm (is:InstallSnapshot) -> { is with LastTerm = lastTerm }) + + static member Data_ = + (fun (is:InstallSnapshot) -> is.Data), + (fun data (is:InstallSnapshot) -> { is with Data = data }) + // ** ToOffset member self.ToOffset (builder: FlatBufferBuilder) = @@ -460,21 +543,28 @@ type InstallSnapshot = |> Either.fail } -// * Callback Interface +// * InstallSnapshot module + +module InstallSnapshot = + open Aether + + // ** getters + + let term = Optic.get InstallSnapshot.Term_ + let leaderId = Optic.get InstallSnapshot.LeaderId_ + let lastIndex = Optic.get InstallSnapshot.LastIndex_ + let lastTerm = Optic.get InstallSnapshot.LastTerm_ + let data = Optic.get InstallSnapshot.Data_ + + // ** setters -///////////////////////////////////////////////// -// ____ _ _ _ _ // -// / ___|__ _| | | |__ __ _ ___| | __ // -// | | / _` | | | '_ \ / _` |/ __| |/ / // -// | |__| (_| | | | |_) | (_| | (__| < // -// \____\__,_|_|_|_.__/ \__,_|\___|_|\_\ // -// // -// ___ _ __ // -// |_ _|_ __ | |_ ___ _ __ / _| __ _ ___ ___ // -// | || '_ \| __/ _ \ '__| |_ / _` |/ __/ _ \ // -// | || | | | || __/ | | _| (_| | (_| __/ // -// |___|_| |_|\__\___|_| |_| \__,_|\___\___| // -///////////////////////////////////////////////// + let setTerm = Optic.set InstallSnapshot.Term_ + let setLeaderId = Optic.set InstallSnapshot.LeaderId_ + let setLastIndex = Optic.set InstallSnapshot.LastIndex_ + let setLastTerm = Optic.set InstallSnapshot.LastTerm_ + let setData = Optic.set InstallSnapshot.Data_ + +// * Callback Interface type IRaftCallbacks = @@ -586,6 +676,72 @@ type RaftState = /// the log entry which has a voting configuration change, otherwise None ConfigChangeEntry : RaftLogEntry option } + // ** optics + + static member Member_ = + (fun (rs:RaftState) -> rs.Member), + (fun mem (rs:RaftState) -> { rs with Member = mem }) + + static member State_ = + (fun (rs:RaftState) -> rs.State), + (fun state (rs:RaftState) -> { rs with State = state }) + + static member CurrentTerm_ = + (fun (rs:RaftState) -> rs.CurrentTerm), + (fun currentTerm (rs:RaftState) -> { rs with CurrentTerm = currentTerm }) + + static member CurrentLeader_ = + (fun (rs:RaftState) -> rs.CurrentLeader), + (fun currentLeader (rs:RaftState) -> { rs with CurrentLeader = currentLeader }) + + static member Peers_ = + (fun (rs:RaftState) -> rs.Peers), + (fun peers (rs:RaftState) -> { rs with Peers = peers }) + + static member OldPeers_ = + (fun (rs:RaftState) -> rs.OldPeers), + (fun oldPeers (rs:RaftState) -> { rs with OldPeers = oldPeers }) + + static member NumMembers_ = + (fun (rs:RaftState) -> rs.NumMembers), + (fun numMembers (rs:RaftState) -> { rs with NumMembers = numMembers }) + + static member VotedFor_ = + (fun (rs:RaftState) -> rs.VotedFor), + (fun votedFor (rs:RaftState) -> { rs with VotedFor = votedFor }) + + static member Log_ = + (fun (rs:RaftState) -> rs.Log), + (fun log (rs:RaftState) -> { rs with Log = log }) + + static member CommitIndex_ = + (fun (rs:RaftState) -> rs.CommitIndex), + (fun commitIndex (rs:RaftState) -> { rs with CommitIndex = commitIndex }) + + static member LastAppliedIdx_ = + (fun (rs:RaftState) -> rs.LastAppliedIdx), + (fun lastAppliedIdx (rs:RaftState) -> { rs with LastAppliedIdx = lastAppliedIdx }) + + static member TimeoutElapsed_ = + (fun (rs:RaftState) -> rs.TimeoutElapsed), + (fun timeoutElapsed (rs:RaftState) -> { rs with TimeoutElapsed = timeoutElapsed }) + + static member ElectionTimeout_ = + (fun (rs:RaftState) -> rs.ElectionTimeout), + (fun electionTimeout (rs:RaftState) -> { rs with ElectionTimeout = electionTimeout }) + + static member RequestTimeout_ = + (fun (rs:RaftState) -> rs.RequestTimeout), + (fun requestTimeout (rs:RaftState) -> { rs with RequestTimeout = requestTimeout }) + + static member MaxLogDepth_ = + (fun (rs:RaftState) -> rs.MaxLogDepth), + (fun maxLogDepth (rs:RaftState) -> { rs with MaxLogDepth = maxLogDepth }) + + static member ConfigChangeEntry_ = + (fun (rs:RaftState) -> rs.ConfigChangeEntry), + (fun configChangeEntry (rs:RaftState) -> { rs with ConfigChangeEntry = configChangeEntry }) + // ** ToString override self.ToString() = @@ -621,11 +777,10 @@ ConfigChangeEntry = %s // ** IsLeader - member self.IsLeader - with get () = - match self.CurrentLeader with - | Some lid -> self.Member.Id = lid - | _ -> false + member self.IsLeader = + match self.CurrentLeader with + | Some lid -> self.Member.Id = lid + | _ -> false // ** ToYaml diff --git a/src/Disco/Disco/Service/DiscoService.fs b/src/Disco/Disco/Service/DiscoService.fs index 9f3c3f78..93004363 100644 --- a/src/Disco/Disco/Service/DiscoService.fs +++ b/src/Disco/Disco/Service/DiscoService.fs @@ -359,45 +359,40 @@ module DiscoService = /// replicated to the leader once connected. IF those clients/sessions already exist, they /// will simply be ignored. let private sendLocalData (socket: ITcpClient) (store: IAgentStore) = - if (store.State.SocketServer.Sessions.Count + store.State.ApiServer.Clients.Count) > 0 then - let mem = - match Config.getActiveMember store.State.Store.State.Project.Config with - | Some clusterMem -> [ AddMember clusterMem ] - | None -> List.empty - let sessions = - store.State.SocketServer.Sessions - |> Map.toList - |> List.map (snd >> AddSession) - let clients = - store.State.ApiServer.Clients - |> Map.toList - |> List.map (snd >> AddClient) - let tree = - store.State.AssetService.State - |> Option.map (fun tree -> [ AddFsTree tree ]) - |> Option.defaultValue List.empty - let batch = - List.concat [ - mem - sessions - clients - tree - ] - /// send a batched state machine command to leader if non-empty - if not (List.isEmpty batch) then - (clients.Length,sessions.Length) - |> String.format "sending batch command with {0} (clients,session) " - |> Logger.debug (tag "sendLocalData") - batch - |> CommandBatch.ofList - |> RaftRequest.AppendEntry - |> Binary.encode - |> Request.create (Guid.ofId socket.ClientId) - |> socket.Request - else - store.State.RaftServer.RaftState - |> String.format "Nothing to send ({0})" + let mem = + match Config.getActiveMember store.State.Store.State.Project.Config with + | Some clusterMem -> [ AddMember clusterMem ] + | None -> List.empty + let sessions = + store.State.SocketServer.Sessions + |> Map.toList + |> List.map (snd >> AddSession) + let clients = + store.State.ApiServer.Clients + |> Map.toList + |> List.map (snd >> AddClient) + let tree = + store.State.AssetService.State + |> Option.map (fun tree -> [ AddFsTree tree ]) + |> Option.defaultValue List.empty + let batch = + List.concat [ + mem + sessions + clients + tree + ] + /// send a batched state machine command to leader if non-empty + if not (List.isEmpty batch) then + (clients.Length,sessions.Length) + |> String.format "sending batch command with {0} (clients,session) " |> Logger.debug (tag "sendLocalData") + batch + |> CommandBatch.ofList + |> RaftRequest.AppendEntry + |> Binary.encode + |> Request.create (Guid.ofId socket.ClientId) + |> socket.Request // ** handleLeaderEvents @@ -405,7 +400,7 @@ module DiscoService = /// command to append the locally connected clients and browser sessions to the leader. let private handleLeaderEvents socket store = function | TcpClientEvent.Connected _ -> sendLocalData socket store - | _ -> () + | e -> () // ** makeLeader @@ -477,10 +472,12 @@ module DiscoService = |> Logger.debug (tag "processEvent") | DiscoEvent.LeaderChanged leader -> + printfn "[DISCO]: leader changed! %A" leader leader |> String.format "Leader changed to {0}" |> Logger.debug (tag "leaderChanged") + printfn "disposing old leader socket" Option.iter dispose store.State.Leader let newLeader = diff --git a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs new file mode 100644 index 00000000..1cbf5669 --- /dev/null +++ b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs @@ -0,0 +1,124 @@ +(* + * This file is part of Distributed Show Control + * + * Copyright 2015, 2018 by it's authors. + * Some rights reserved. See COPYING, AUTHORS. + *) + +namespace Disco.Tests + +open System.IO +open System.Threading +open Expecto + +open Disco.Core +open Disco.Service +open Disco.Client +open Disco.Client.Interfaces +open Disco.Service.Interfaces +open Disco.Raft +open Disco.Net + +open Common + +module AddPreviousMemberShouldPull = + + let test = + testCase "ensure previous member pulls from leader" <| fun _ -> + either { + use configurationDone = new WaitEvent() + use updateDone = new WaitEvent() + + let machine1 = mkMachine 4000us + let machine2 = mkMachine 5000us + + let mem1 = Machine.toClusterMember machine1 + let mem2 = Machine.toClusterMember machine2 + + let site1 = mkSite [ mem1 ] + let site2 = mkSite [ mem2 ] + + let! project1 = mkProject machine1 site1 + + let path2 = machine2.WorkSpace (project1.Name |> unwrap |> filepath) + + let project2 = + project1.Config + |> Config.addSiteAndSetActive site2 + |> flip Project.setConfig project1 + |> Project.setPath path2 + + do! FileSystem.copyDir project1.Path path2 + do! project2.Save path2 + + use lobs = Logger.subscribe Logger.stdout + + let handler = function + | DiscoEvent.LeaderChanged leader -> printfn "leader: changed! %A" leader + | DiscoEvent.ConfigurationDone members -> configurationDone.Set() + | DiscoEvent.Append(_, CommandBatch batch) -> updateDone.Set() + | DiscoEvent.Append(_, LogMsg p) -> () + | ev -> () // printfn "ev: %A" ev + + let! repo1 = Project.repository project1 + + // _ + // / | + // | | + // | | + // |_| start + + let! service1 = DiscoService.create { + Machine = machine1 + ProjectName = project1.Name + UserName = User.Admin.UserName + Password = password Constants.ADMIN_DEFAULT_PASSWORD + SiteId = None + } + + use oobs1 = service1.Subscribe handler + do! service1.Start() + + // ____ + // |___ \ + // __) | + // / __/ + // |_____| start + + let! repo2 = Project.repository project2 + + let! service2 = DiscoService.create { + Machine = machine2 + ProjectName = project2.Name + UserName = User.Admin.UserName + Password = password Constants.ADMIN_DEFAULT_PASSWORD + SiteId = None + } + + use oobs2 = service2.Subscribe handler + do! service2.Start() + + /// _____ + /// |___ / + /// |_ \ + /// ___) | + /// |____/ add member + + do service1.AddMachine (Machine.toRaftMember machine2) + + do! waitFor "configurationDone" configurationDone + + printfn "leader1: %A" service1.RaftServer.Raft.CurrentLeader + printfn "leader2: %A" service2.RaftServer.Raft.CurrentLeader + + do! waitFor "updateDone" updateDone + + Expect.equal + service1.State.Project.Config.Sites + service2.State.Project.Config.Sites + "Cluster Sites should be equal" + + dispose service1 + dispose service2 + } + |> noError diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index e5ebac4a..ecd852d8 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -682,7 +682,7 @@ module ServerTests = ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request - expect "Should be granted" true Vote.granted resp + expect "Should be granted" true VoteResponse.granted resp } |> runWithDefaults |> noError @@ -703,7 +703,7 @@ module ServerTests = ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request - expect "Vote should be granted" true Vote.granted resp + expect "Vote should be granted" true VoteResponse.granted resp do! expectM "Timeout Elapsed should be reset" 0 Raft.timeoutElapsed } |> runWithDefaults @@ -751,7 +751,7 @@ module ServerTests = } let! resp = Raft.receiveVoteRequest other.Id request do! expectM "Should have added mem" None (Raft.getMember other.Id) - expect "Should not have granted vote" false Vote.granted resp + expect "Should not have granted vote" false VoteResponse.granted resp } |> runWithDefaults |> noError @@ -779,7 +779,7 @@ module ServerTests = let req1 = { request with Candidate = raft'.Member } let! result = Raft.receiveVoteRequest peer2.Id req1 - expect "Should not have granted vote" false Vote.granted result + expect "Should not have granted vote" false VoteResponse.granted result } |> runWithDefaults |> noError @@ -874,7 +874,7 @@ module ServerTests = do! Raft.setTermM (term 2) let! resp = Raft.receiveVoteRequest peer.Id { vote with Term = term 2; LastLogTerm = term 3; } - expect "Should be granted" true Vote.granted resp + expect "Should be granted" true VoteResponse.granted resp } |> runWithDefaults |> noError @@ -976,7 +976,7 @@ module ServerTests = do! Raft.addPeerM peer do! Raft.voteFor (Some raft'.Member) let! resp = Raft.receiveVoteRequest peer.Id vote - expect "Should have failed" true Vote.declined resp + expect "Should have failed" true VoteResponse.declined resp } |> runWithDefaults |> noError @@ -1017,10 +1017,10 @@ module ServerTests = let vote = List.head (!sender.Outbox) |> getVote - expect "should have last log index be 3" (index 3) Vote.lastLogIndex vote - expect "should have last term be 5" (term 5) Vote.term vote - expect "should have last log term be 3" (term 3) Vote.lastLogTerm vote - expect "should have candidate id be me" self Vote.candidate vote + expect "should have last log index be 3" (index 3) VoteRequest.lastLogIndex vote + expect "should have last term be 5" (term 5) VoteRequest.term vote + expect "should have last log term be 3" (term 3) VoteRequest.lastLogTerm vote + expect "should have candidate id be me" self VoteRequest.candidate vote } |> runWithRaft raft' cbs |> noError @@ -1614,8 +1614,8 @@ module ServerTests = do! Raft.sendAllAppendEntriesM () - expect "Should have prevLogIdx 4" (index 4) AppendRequest.prevLogIdx (!appendReq |> Option.get) - expect "Should have prevLogTerm 4" (term 4) AppendRequest.prevLogTerm (!appendReq |> Option.get) + expect "Should have prevLogIdx 4" (index 4) AppendEntries.prevLogIdx (!appendReq |> Option.get) + expect "Should have prevLogTerm 4" (term 4) AppendEntries.prevLogTerm (!appendReq |> Option.get) let! trm = Raft.currentTermM () do! Raft.receiveAppendEntriesResponse peer.Id { response with Term = trm; Success = false; CurrentIndex = index 1 } @@ -1626,8 +1626,8 @@ module ServerTests = do! Raft.sendAllAppendEntriesM () - expect "Should have prevLogIdx 1" (index 1) AppendRequest.prevLogIdx (!appendReq |> Option.get) - expect "Should have prevLogTerm 1" (term 1) AppendRequest.prevLogTerm (!appendReq |> Option.get) + expect "Should have prevLogIdx 1" (index 1) AppendEntries.prevLogIdx (!appendReq |> Option.get) + expect "Should have prevLogTerm 1" (term 1) AppendEntries.prevLogTerm (!appendReq |> Option.get) } |> runWithCBS cbs |> noError @@ -1809,8 +1809,8 @@ module ServerTests = let! committed = Raft.responseCommitted response expect "Should not have committed entry" false id committed - expect "Should have term 1" (term 1) Entry.term response - expect "Should have index 1" (index 1) Entry.index response + expect "Should have term 1" (term 1) EntryResponse.term response + expect "Should have index 1" (index 1) EntryResponse.index response do! expectM "(1) Should have current idx 1" (index 1) Raft.currentIndex do! expectM "Should have commit idx 0" (index 0) Raft.commitIndex @@ -2073,7 +2073,7 @@ module ServerTests = do! Raft.receiveVoteResponse peer1.Id resp do! expectM "Should be leader" Leader Raft.getState let! resp = Raft.receiveVoteRequest peer2.Id vote - expect "Should have declined vote" true Vote.declined resp + expect "Should have declined vote" true VoteResponse.declined resp } |> runWithDefaults |> noError diff --git a/src/Disco/Projects/Tests/Tests.fsproj b/src/Disco/Projects/Tests/Tests.fsproj index 1b66c150..00029bbf 100644 --- a/src/Disco/Projects/Tests/Tests.fsproj +++ b/src/Disco/Projects/Tests/Tests.fsproj @@ -112,6 +112,9 @@ ClonesFromLeader.fs + + AddPreviousMemberShouldPull.fs + RemoveMemberShouldSplitCluster.fs diff --git a/src/Frontend/src/Frontend/Elmish/Types.fs b/src/Frontend/src/Frontend/Elmish/Types.fs index 20a7da9f..f8c1d1fd 100644 --- a/src/Frontend/src/Frontend/Elmish/Types.fs +++ b/src/Frontend/src/Frontend/Elmish/Types.fs @@ -154,6 +154,7 @@ and UserConfig = logColumns: Map useRightClick: bool } + static member Create() = { logTextFilter = None logLevelFilter = None From 441cd049880ad8c299c4a74ee6417b9d74b5b132 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Wed, 7 Feb 2018 18:22:33 +0100 Subject: [PATCH 07/27] refactor Raft.fs into better separated modules --- .paket/Paket.Restore.targets | 6 +- src/Disco/Disco/Core/Interfaces.fs | 2 +- src/Disco/Disco/Raft/Log.fs | 158 +- src/Disco/Disco/Raft/LogEntry.fs | 399 ++--- src/Disco/Disco/Raft/Raft.fs | 1542 +++-------------- src/Disco/Disco/Raft/RaftMonad.fs | 634 +++++++ src/Disco/Disco/Raft/RaftState.fs | 700 ++++++++ src/Disco/Disco/Raft/Types.fs | 317 +--- src/Disco/Disco/Service/DiscoService.fs | 2 +- src/Disco/Disco/Service/Interfaces.fs | 2 +- src/Disco/Disco/Service/Persistence.fs | 12 +- src/Disco/Disco/Service/RaftServer.fs | 2 +- src/Disco/Disco/Tests/Core/Generators.fs | 20 +- .../Disco/Tests/Raft/AppendEntriesTests.fs | 2 +- .../Disco/Tests/Raft/JointConsensusTests.fs | 14 +- src/Disco/Disco/Tests/Raft/LogTests.fs | 32 +- src/Disco/Disco/Tests/Raft/RaftTestUtils.fs | 12 +- src/Disco/Disco/Tests/Raft/ServerTests.fs | 10 +- src/Disco/Disco/Tests/TestUtilities.fs | 2 +- src/Disco/Projects/Core/Core.fsproj | 6 + 20 files changed, 1905 insertions(+), 1969 deletions(-) create mode 100644 src/Disco/Disco/Raft/RaftMonad.fs create mode 100644 src/Disco/Disco/Raft/RaftState.fs diff --git a/.paket/Paket.Restore.targets b/.paket/Paket.Restore.targets index a86be3a1..830e5699 100644 --- a/.paket/Paket.Restore.targets +++ b/.paket/Paket.Restore.targets @@ -23,6 +23,9 @@ <_PaketExeExtension>$([System.IO.Path]::GetExtension("$(PaketExePath)")) dotnet "$(PaketExePath)" + + "$(PaketExePath)" + $(PaketRootPath)paket.bootstrapper.exe $(PaketToolsPath)paket.bootstrapper.exe "$(PaketBootStrapperExePath)" @@ -145,9 +148,10 @@ + diff --git a/src/Disco/Disco/Core/Interfaces.fs b/src/Disco/Disco/Core/Interfaces.fs index de42134f..a36c31d2 100644 --- a/src/Disco/Disco/Core/Interfaces.fs +++ b/src/Disco/Disco/Core/Interfaces.fs @@ -103,7 +103,7 @@ type DiscoEvent = | EnterJointConsensus of changes:ConfigChange array | LeaderChanged of leader:MemberId option | StateChanged of oldstate:MemberState * newstate:MemberState - | PersistSnapshot of log:RaftLogEntry + | PersistSnapshot of log:LogEntry | RaftError of error:DiscoError | Status of ServiceStatus | GitPull of remote:IpAddress diff --git a/src/Disco/Disco/Raft/Log.fs b/src/Disco/Disco/Raft/Log.fs index c7fc633c..fb16817f 100644 --- a/src/Disco/Disco/Raft/Log.fs +++ b/src/Disco/Disco/Raft/Log.fs @@ -15,20 +15,33 @@ open FlatBuffers open Disco.Core open Disco.Serialization -// * RaftLog +// * Log -// ____ __ _ _ -// | _ \ __ _ / _| |_| | ___ __ _ -// | |_) / _` | |_| __| | / _ \ / _` | -// | _ < (_| | _| |_| |__| (_) | (_| | -// |_| \_\__,_|_| \__|_____\___/ \__, | -// |___/ +// _ +// | | ___ __ _ +// | | / _ \ / _` | +// | |__| (_) | (_| | +// |_____\___/ \__, | +// |___/ + +type Log = + { Data: LogEntry option + Depth: int + Index: Index } + + // ** optics + + static member Data_ = + (fun (log:Log) -> log.Data), + (fun data (log:Log) -> { log with Data = data }) + + static member Depth_ = + (fun (log:Log) -> log.Depth), + (fun depth (log:Log) -> { log with Depth = depth }) -type RaftLog = - { Data : RaftLogEntry option - ; Depth : int - ; Index : Index - } + static member Index_ = + (fun (log:Log) -> log.Index), + (fun index (log:Log) -> { log with Index = index }) // ** ToString @@ -82,14 +95,14 @@ type RaftLog = /// - logs: LogFB array /// /// Returns: Either - static member FromFB (logs: LogFB array) : Either = + static member FromFB (logs: LogFB array) : Either = either { - let! entries = RaftLogEntry.FromFB logs + let! entries = LogEntry.FromFB logs match entries with | Some entries as value -> return { Data = value Depth = LogEntry.depth entries - Index = LogEntry.getIndex entries } + Index = LogEntry.index entries } | _ -> return { Data = None Depth = 0 @@ -108,18 +121,33 @@ type RaftLog = [] module Log = - // ** Log.empty + open Aether + + // ** getters + + let depth = Optic.get Log.Depth_ + let data = Optic.get Log.Data_ + let index = Optic.get Log.Index_ + + // ** setters + + let setDepth = Optic.set Log.Depth_ + let setData = Optic.set Log.Data_ + let setIndex = Optic.set Log.Index_ + + // ** empty /// ## Construct an empty log. /// /// Build a new, empty log data structure. /// /// Returns: RaftLog - let empty = { Depth = 0 - ; Index = index 0 - ; Data = None } + let empty = + { Depth = 0 + Index = 0 + Data = None } - // ** Log.fromEntries + // ** fromEntries /// ## Construct a new log value from entries /// @@ -129,12 +157,12 @@ module Log = /// - entries: LogEntry's to construct RaftLog from /// /// Returns: RaftLog - let fromEntries (entries: RaftLogEntry) = + let fromEntries (entries: LogEntry) = { Depth = LogEntry.depth entries - ; Index = LogEntry.getIndex entries - ; Data = Some entries } + Index = LogEntry.index entries + Data = Some entries } - // ** Log.length + // ** length /// ## Length of logg /// @@ -146,19 +174,7 @@ module Log = /// Returns: Long let length log = log.Depth - // ** Log.index - - /// ## Return the current Index in the log - /// - /// Return the current index in the RaftLog value - /// - /// ### Signature: - /// - log: RaftLog to get index for - /// - /// Returns: Long - let getIndex log = log.Index - - // ** Log.prevIndex + // ** prevIndex /// ## Return the index of the previous element /// @@ -171,7 +187,7 @@ module Log = let prevIndex log = Option.bind LogEntry.prevIndex log.Data - // ** Log.term + // ** term /// ## Return the Term of the latest log entry /// @@ -181,12 +197,12 @@ module Log = /// - log: RaftLog to return term for /// /// Returns: Long - let getTerm log = + let term log = match log.Data with - | Some entries -> LogEntry.getTerm entries + | Some entries -> LogEntry.term entries | _ -> term 0 - // ** Log.prevTerm + // ** prevTerm /// ## Return the Term of the previous entry /// @@ -199,7 +215,7 @@ module Log = let prevTerm log = Option.bind LogEntry.prevTerm log.Data - // ** Log.previous + // ** previous /// Return the last Entry, if it exists /// @@ -210,75 +226,75 @@ module Log = match LogEntry.prevEntry entries with | Some entry -> { Depth = LogEntry.depth entry - ; Index = LogEntry.getIndex entry + ; Index = LogEntry.index entry ; Data = Some entry } |> Some | _ -> None | _ -> None - // ** Log.prevEntry + // ** prevEntry let prevEntry log = Option.bind (LogEntry.prevEntry) log.Data - // ** Log.foldLogL + // ** foldLogL let foldLogL f m log = match log.Data with | Some entries -> LogEntry.foldl f m entries | _ -> m - // ** Log.foldLogR + // ** foldLogR let foldLogR f m log = match log.Data with | Some entries -> LogEntry.foldr f m entries | _ -> m - // ** Log.at + // ** at let at idx log = Option.bind (LogEntry.at idx) log.Data - // ** Log.until + // ** until let until idx log = Option.bind (LogEntry.until idx) log.Data - // ** Log.untilExcluding + // ** untilExcluding let untilExcluding idx log = Option.bind (LogEntry.untilExcluding idx) log.Data - // ** Log.append + // ** append - let append newentries log : RaftLog = + let append newentries log: Log = match log.Data with | Some entries -> let newlog = LogEntry.append newentries entries - { Index = LogEntry.getIndex newlog + { Index = LogEntry.index newlog Depth = LogEntry.depth newlog Data = Some newlog } | _ -> let entries = LogEntry.rewrite newentries - { Index = LogEntry.getIndex entries + { Index = LogEntry.index entries Depth = LogEntry.depth entries Data = Some entries } - // ** Log.find + // ** find let find id log = Option.bind (LogEntry.find id) log.Data - // ** Log.make + // ** make let make term data = LogEntry.make term data - // ** Log.mkConfig + // ** mkConfig let mkConfig term nodes = LogEntry.mkConfig term nodes - // ** Log.mkConfigChange + // ** mkConfigChange let mkConfigChange term changes = LogEntry.mkConfigChange term changes @@ -286,74 +302,74 @@ module Log = let calculateChanges oldnodes newnodes = LogEntry.calculateChanges oldnodes newnodes - // ** Log.entries + // ** entries let entries log = log.Data - // ** Log.aggregate + // ** aggregate let aggregate f m log = Option.map (LogEntry.aggregate f m) log.Data - // ** Log.snapshot + // ** snapshot let snapshot nodes data log = match log.Data with | Some entries -> let snapshot = LogEntry.snapshot nodes data entries - { Index = LogEntry.getIndex snapshot + { Index = LogEntry.index snapshot Depth = 1 Data = Some snapshot } | _ -> log - // ** Log.head + // ** head let head log = Option.map LogEntry.head log.Data - // ** Log.lastTerm + // ** lastTerm let lastTerm log = Option.bind LogEntry.lastTerm log.Data - // ** Log.lastTerm + // ** lastTerm let lastIndex log = Option.bind LogEntry.lastIndex log.Data - // ** Log.last + // ** last /// Return the last entry in the chain of logs. let last log = Option.map LogEntry.last log.Data - // ** Log.iter + // ** iter /// Iterate over log entries, in order of newsest to oldest. let iter f log = Option.map (LogEntry.iter f) log.Data |> ignore - // ** Log.firstIndex + // ** firstIndex /// Retrieve the index of the first log entry for the given term. Return None /// if no result was found; let firstIndex term log = Option.bind (LogEntry.firstIndex term) log.Data - // ** Log.getn + // ** getn let getn count log = Option.bind (LogEntry.getn count) log.Data - // ** Log.contains + // ** contains - let contains (f: RaftLogEntry -> bool) log : bool = + let contains (f: LogEntry -> bool) log : bool = match Option.map (LogEntry.contains f) log.Data with | Some result -> result | _ -> false - // ** Log.map + // ** map let map f log = Option.map (LogEntry.map f) log.Data diff --git a/src/Disco/Disco/Raft/LogEntry.fs b/src/Disco/Disco/Raft/LogEntry.fs index 0fa987ad..6f26ae21 100644 --- a/src/Disco/Disco/Raft/LogEntry.fs +++ b/src/Disco/Disco/Raft/LogEntry.fs @@ -40,7 +40,7 @@ type SnapshotYaml() = #endif -// * RaftLogEntry +// * LogEntry /// _ _____ _ /// | | ___ __ _| ____|_ __ | |_ _ __ _ _ @@ -87,7 +87,7 @@ type SnapshotYaml() = /// Data : StateMachine // state machine data /// -type RaftLogEntry = +type LogEntry = // Member Configuration Entry | Configuration of @@ -95,7 +95,7 @@ type RaftLogEntry = Index : Index * Term : Term * Members : RaftMember array * - Previous : RaftLogEntry option + Previous : LogEntry option // Entry type for configuration changes | JointConsensus of @@ -103,7 +103,7 @@ type RaftLogEntry = Index : Index * Term : Term * Changes : ConfigChange array * - Previous : RaftLogEntry option + Previous : LogEntry option // Regular Log Entries | LogEntry of @@ -111,7 +111,7 @@ type RaftLogEntry = Index : Index * Term : Term * Data : StateMachine * - Previous : RaftLogEntry option + Previous : LogEntry option | Snapshot of Id : LogId * @@ -122,6 +122,43 @@ type RaftLogEntry = Members : RaftMember array * Data : StateMachine + // ** optics + + static member Id_ = + (function + | Configuration(id,_,_,_,_) -> id + | JointConsensus(id,_,_,_,_) -> id + | LogEntry(id,_,_,_,_) -> id + | Snapshot(id,_,_,_,_,_,_) -> id), + (fun id -> function + | Configuration(_,idx,term,mems,prev) -> Configuration(id,idx,term,mems,prev) + | JointConsensus(_,idx,term,changes,prev) -> JointConsensus(id,idx,term,changes,prev) + | LogEntry(_,idx,term,data,prev) -> LogEntry(id,idx,term,data,prev) + | Snapshot(_,idx,term,lidx,lterm,mems,data) -> Snapshot(id,idx,term,lidx,lterm,mems,data)) + + static member Index_ = + (function + | Configuration(_,idx,_,_,_) -> idx + | JointConsensus(_,idx,_,_,_) -> idx + | LogEntry(_,idx,_,_,_) -> idx + | Snapshot(_,idx,_,_,_,_,_) -> idx), + (fun idx -> function + | Configuration(id,_,term,mems,prev) -> Configuration(id,idx,term,mems,prev) + | JointConsensus(id,_,term,changes,prev) -> JointConsensus(id,idx,term,changes,prev) + | LogEntry(id,_,term,data,prev) -> LogEntry(id,idx,term,data,prev) + | Snapshot(id,_,term,lidx,lterm,mems,data) -> Snapshot(id,idx,term,lidx,lterm,mems,data)) + + static member Term_ = + (function + | Configuration(_,_,term,_,_) -> term + | JointConsensus(_,_,term,_,_) -> term + | LogEntry(_,_,term,_,_) -> term + | Snapshot(_,_,term,_,_,_,_) -> term), + (fun term -> function + | Configuration(id,idx,_,mems,prev) -> Configuration(id,idx,term,mems,prev) + | JointConsensus(id,idx,_,changes,prev) -> JointConsensus(id,idx,term,changes,prev) + | LogEntry(id,idx,_,data,prev) -> LogEntry(id,idx,term,data,prev) + | Snapshot(id,idx,_,lidx,lterm,mems,data) -> Snapshot(id,idx,term,lidx,lterm,mems,data)) // ** ToString @@ -191,13 +228,12 @@ type RaftLogEntry = /// Get the current log's Id. /// /// Returns: Id - member self.Id - with get () = - match self with - | Configuration(id,_,_,_,_) -> id - | JointConsensus(id,_,_,_,_) -> id - | LogEntry(id,_,_,_,_) -> id - | Snapshot(id,_,_,_,_,_,_) -> id + member self.Id = + match self with + | Configuration(id,_,_,_,_) -> id + | JointConsensus(id,_,_,_,_) -> id + | LogEntry(id,_,_,_,_) -> id + | Snapshot(id,_,_,_,_,_,_) -> id // ** Depth @@ -206,20 +242,19 @@ type RaftLogEntry = /// Compute the depth of the current log. /// /// Returns: int - member self.Depth - with get () = - let rec _depth i thing = - let inline count i prev = - let cnt = i + 1 - match prev with - | Some other -> _depth cnt other - | _ -> cnt - match thing with - | Configuration(_,_,_,_,prev) -> count i prev - | JointConsensus(_,_,_,_,prev) -> count i prev - | LogEntry(_,_,_,_,prev) -> count i prev - | Snapshot _ -> i + 1 - _depth 0 self + member self.Depth = + let rec _depth i thing = + let inline count i prev = + let cnt = i + 1 + match prev with + | Some other -> _depth cnt other + | _ -> cnt + match thing with + | Configuration(_,_,_,_,prev) -> count i prev + | JointConsensus(_,_,_,_,prev) -> count i prev + | LogEntry(_,_,_,_,prev) -> count i prev + | Snapshot _ -> i + 1 + _depth 0 self // ** Iter @@ -231,28 +266,15 @@ type RaftLogEntry = /// - f: int -> RaftLogEntry -> unit /// /// Returns: unit - member self.Iter (f : int -> RaftLogEntry -> unit) = + member self.Iter (f : int -> LogEntry -> unit) = let rec impl start = function - | Configuration(_,_,_,_,Some prev) as curr -> - f start curr; impl (start + 1) prev - - | Configuration(_,_,_,_,None) as curr -> - f start curr - - | JointConsensus(_,_,_,_,Some prev) as curr -> - f start curr; impl (start + 1) prev - - | JointConsensus(_,_,_,_,None) as curr -> - f start curr - - | LogEntry(_,_,_,_,Some prev) as curr -> - f start curr; impl (start + 1) prev - - | LogEntry(_,_,_,_,None) as curr -> - f start curr - - | Snapshot _ as curr -> - f start curr + | Configuration(_,_,_,_,Some prev) as curr -> f start curr; impl (start + 1) prev + | Configuration(_,_,_,_,None) as curr -> f start curr + | JointConsensus(_,_,_,_,Some prev) as curr -> f start curr; impl (start + 1) prev + | JointConsensus(_,_,_,_,None) as curr -> f start curr + | LogEntry(_,_,_,_,Some prev) as curr -> f start curr; impl (start + 1) prev + | LogEntry(_,_,_,_,None) as curr -> f start curr + | Snapshot _ as curr -> f start curr impl 0 self @@ -271,7 +293,7 @@ type RaftLogEntry = LogFB.AddEntry(builder, value) LogFB.EndLogFB(builder) - let toOffset (log: RaftLogEntry) = + let toOffset (log: LogEntry) = match log with // ____ __ _ _ _ // / ___|___ _ __ / _(_) __ _ _ _ _ __ __ _| |_(_) ___ _ __ @@ -348,7 +370,7 @@ type RaftLogEntry = buildLogFB LogTypeFB.SnapshotFB entry.Value let arr = Array.zeroCreate (self.Depth |> int) - self.Iter (fun i (log: RaftLogEntry) -> arr.[int i] <- toOffset log) + self.Iter (fun i (log: LogEntry) -> arr.[int i] <- toOffset log) arr // ** ParseLogFB @@ -364,8 +386,8 @@ type RaftLogEntry = /// /// Returns: Either static member ParseLogFB (fb: LogFB) - (sibling: Either) - : Either = + (sibling: Either) + : Either = match fb.EntryType with | LogTypeFB.ConfigurationFB -> either { // the previous log entry. An error, if occurred previously @@ -550,8 +572,10 @@ type RaftLogEntry = /// - log: previous RaftLogEntry value to reconstruct the chain of events /// /// Returns: RaftLogEntry option - static member FromFB (logs: LogFB array) : Either = - Array.foldBack RaftLogEntry.ParseLogFB logs (Right None) + static member FromFB (logs: LogFB array) : Either = + Array.foldBack LogEntry.ParseLogFB logs (Right None) + + // ** AssetPath // _ _ // / \ ___ ___ ___| |_ @@ -565,6 +589,8 @@ type RaftLogEntry = with get () = Constants.RAFT_DIRECTORY <.> Constants.SNAPSHOT_FILENAME + Constants.ASSET_EXTENSION + // ** Save + member log.Save (basePath: FilePath) = match log with | Snapshot(id, idx, term, lastidx, lastterm, mems, _) -> @@ -597,26 +623,25 @@ type RaftLogEntry = [] module LogEntry = - // ** LogEntry.getId + open Aether - // _ _ - // (_) __| | - // | |/ _` | - // | | (_| | - // |_|\__,_| - // + // ** ($) - /// ## Get the Id of a log entry - /// - /// Get the unique identifier of the top-most log entry - /// - /// ### Signature: - /// - log: RaftLogEntry to get Id ofg - /// - /// Returns: Id - let getId (log: RaftLogEntry) = log.Id + let private ($) = (<|) + + // ** getters + + let id = Optic.get LogEntry.Id_ + let index = Optic.get LogEntry.Index_ + let term = Optic.get LogEntry.Term_ - // ** LogEntry.isConfigChange + // ** setters + + let setId = Optic.set LogEntry.Id_ + let setIndex = Optic.set LogEntry.Index_ + let setTerm = Optic.set LogEntry.Term_ + + // ** isConfigChange // _ ____ __ _ ____ _ // (_)___ / ___|___ _ __ / _(_) __ _ / ___| |__ __ _ _ __ __ _ ___ @@ -629,7 +654,7 @@ module LogEntry = | JointConsensus _ -> true | _ -> false - // ** LogEntry.isConfiguration + // ** isConfiguration // _ ____ __ _ _ _ // (_)___ / ___|___ _ __ / _(_) __ _ _ _ _ __ __ _| |_(_) ___ _ __ @@ -642,7 +667,7 @@ module LogEntry = | Configuration _ -> true | _ -> false - // ** LogEntry.depth + // ** depth // _ _ _ // __| | ___ _ __ | |_| |__ @@ -653,26 +678,10 @@ module LogEntry = // /// compute the actual depth of the log (e.g. for compacting) - let depth (log: RaftLogEntry) = + let depth (log: LogEntry) = log.Depth - // ** LogEntry.index - - // _ _ - // (_)_ __ __| | _____ __ - // | | '_ \ / _` |/ _ \ \/ / - // | | | | | (_| | __/> < - // |_|_| |_|\__,_|\___/_/\_\ - // - /// Return the index of the current log entry. - - let getIndex = function - | Configuration(_,idx,_,_,_) -> idx - | JointConsensus(_,idx,_,_,_) -> idx - | LogEntry(_,idx,_,_,_) -> idx - | Snapshot(_,idx,_,_,_,_,_) -> idx - - // ** LogEntry.prevIndex + // ** prevIndex // ___ _ // _ __ _ __ _____ _|_ _|_ __ __| | _____ __ @@ -684,29 +693,13 @@ module LogEntry = /// Return the index of the previous element if present. let prevIndex = function - | Configuration(_,_,_,_,Some prev) -> Some (getIndex prev) - | JointConsensus(_,_,_,_,Some prev) -> Some (getIndex prev) - | LogEntry(_,_,_,_,Some prev) -> Some (getIndex prev) + | Configuration(_,_,_,_,Some prev) -> Some (index prev) + | JointConsensus(_,_,_,_,Some prev) -> Some (index prev) + | LogEntry(_,_,_,_,Some prev) -> Some (index prev) | Snapshot(_,_,_,idx,_,_,_) -> Some idx | _ -> None - // ** LogEntry.term - - // _ - // | |_ ___ _ __ _ __ ___ - // | __/ _ \ '__| '_ ` _ \ - // | || __/ | | | | | | | - // \__\___|_| |_| |_| |_| - // - /// Extract the `Term` field from a RaftLogEntry - - let getTerm = function - | Configuration(_,_,term,_,_) -> term - | JointConsensus(_,_,term,_,_) -> term - | LogEntry(_,_,term,_,_) -> term - | Snapshot(_,_,term,_,_,_,_) -> term - - // ** LogEntry.prevTerm + // ** prevTerm // _____ // _ __ _ __ _____ _|_ _|__ _ __ _ __ ___ @@ -718,13 +711,13 @@ module LogEntry = /// Return the previous elements' term, if present. let prevTerm = function - | Configuration(_,_,_,_,Some prev) -> Some (getTerm prev) - | JointConsensus(_,_,_,_,Some prev) -> Some (getTerm prev) - | LogEntry(_,_,_,_,Some prev) -> Some (getTerm prev) + | Configuration(_,_,_,_,Some prev) -> Some (term prev) + | JointConsensus(_,_,_,_,Some prev) -> Some (term prev) + | LogEntry(_,_,_,_,Some prev) -> Some (term prev) | Snapshot(_,_,_,_,term,_,_) -> Some term | _ -> None - // ** LogEntry.prevEntry + // ** prevEntry // _____ _ // _ __ _ __ _____ _| ____|_ __ | |_ _ __ _ _ @@ -741,7 +734,7 @@ module LogEntry = | LogEntry(_,_,_,_,prev) -> prev | Snapshot _ -> None - // ** LogEntry.data + // ** data // _ _ // __| | __ _| |_ __ _ @@ -756,7 +749,7 @@ module LogEntry = | Snapshot(_,_,_,_,_,_,d) -> Some d | _ -> None - // ** LogEntry.mems + // ** members // _ // _ __ ___ __| | ___ ___ @@ -766,12 +759,12 @@ module LogEntry = // /// Return the current log entry's mems property, should it have one - let mems = function + let members = function | Configuration(_,_,_,d,_) -> Some d | Snapshot(_,_,_,_,_,d,_) -> Some d | _ -> None - // ** LogEntry.changes + // ** changes // _ // ___| |__ __ _ _ __ __ _ ___ ___ @@ -788,7 +781,7 @@ module LogEntry = | _ -> None - // ** LogEntry.at + // ** at // _ // __ _| |_ @@ -818,7 +811,7 @@ module LogEntry = | _ when idx <= lidx' -> Some curr | _ -> None - // ** LogEntry.until + // ** until // _ _ _ // _ _ _ __ | |_(_) | @@ -838,14 +831,8 @@ module LogEntry = | Configuration(id,index,term,mems,Some prev) -> match idx with - | _ when idx = index -> - Configuration(id,index,term,mems,None) - |> Some - - | _ when idx < index -> - Configuration(id,index,term,mems,until idx prev) - |> Some - + | _ when idx = index -> Some $ Configuration(id,index,term,mems,None) + | _ when idx < index -> Some $ Configuration(id,index,term,mems,until idx prev) | _ -> None | JointConsensus(_,index,_,_,None) as curr -> @@ -855,14 +842,8 @@ module LogEntry = | JointConsensus(id,index,term,changes,Some prev) -> match idx with - | _ when idx = index -> - JointConsensus(id,index,term,changes,None) - |> Some - - | _ when idx < index -> - JointConsensus(id,index,term,changes,until idx prev) - |> Some - + | _ when idx = index -> Some $ JointConsensus(id,index,term,changes,None) + | _ when idx < index -> Some $ JointConsensus(id,index,term,changes,until idx prev) | _ -> None | LogEntry(_,index,_,_,None) as curr -> @@ -872,17 +853,11 @@ module LogEntry = | LogEntry(id,index,term,data,Some prev) -> match idx with - | _ when idx = index -> - LogEntry(id,index,term,data,None) - |> Some - - | _ when idx < index -> - LogEntry(id,index,term,data,until idx prev) - |> Some - + | _ when idx = index -> Some $ LogEntry(id,index,term,data,None) + | _ when idx < index -> Some $ LogEntry(id,index,term,data,until idx prev) | _ -> None - // ** LogEntry.untilExcluding + // ** untilExcluding /// _ _ _ _____ _ _ _ /// _ _ _ __ | |_(_) | ____|_ _____| |_ _ __| (_)_ __ __ _ @@ -895,30 +870,21 @@ module LogEntry = let rec untilExcluding idx = function | Snapshot _ as curr -> Some curr + | Configuration(id,index,term,mems,Some prev) when idx >= index -> None | Configuration(id,index,term,mems,Some prev) -> - if idx >= index then - None - else - Configuration(id,index,term,mems,untilExcluding idx prev) - |> Some + Some $ Configuration(id,index,term,mems,untilExcluding idx prev) + | JointConsensus(id,index,term,changes,Some prev) when idx >= index -> None | JointConsensus(id,index,term,changes,Some prev) -> - if idx >= index then - None - else - JointConsensus(id,index,term,changes,untilExcluding idx prev) - |> Some + Some $ JointConsensus(id,index,term,changes,untilExcluding idx prev) + | LogEntry(id,index,term,data,Some prev) when idx >= index -> None | LogEntry(id,index,term,data,Some prev) -> - if idx >= index then - None - else - LogEntry(id,index,term,data,untilExcluding idx prev) - |> Some + Some $ LogEntry(id,index,term,data,untilExcluding idx prev) | _ -> None - // ** LogEntry.find + // ** find /// _____ _ _ /// | ___(_)_ __ __| | @@ -943,7 +909,7 @@ module LogEntry = | Snapshot(id',_,_,_,_,_,_) as curr -> if id' <> id then None else Some curr - // ** LogEntry.make + // ** make /// __ __ _ /// | \/ | __ _| | _____ @@ -952,18 +918,18 @@ module LogEntry = /// |_| |_|\__,_|_|\_\___| let make term data = - LogEntry(DiscoId.Create(), index 0, term, data, None) + LogEntry(DiscoId.Create(), 0, term, data, None) - // ** LogEntry.mkConfig + // ** mkConfig /// Add an Configuration log entry onto the queue /// /// ### Complexity: 0(1) let mkConfig term mems = - Configuration(DiscoId.Create(), index 0, term, mems, None) + Configuration(DiscoId.Create(), 0, term, mems, None) - // ** LogEntry.mkConfigChange + // ** mkConfigChange /// Add an intermediate configuration entry for 2-phase commit onto /// the log queue @@ -971,7 +937,9 @@ module LogEntry = /// ### Complexity: 0(1) let mkConfigChange term changes = - JointConsensus(DiscoId.Create(), index 0, term, changes, None) + JointConsensus(DiscoId.Create(), 0, term, changes, None) + + // ** calculateChanges let calculateChanges oldmems newmems = let changes = @@ -980,18 +948,22 @@ module LogEntry = (fun lst (newmem: RaftMember) -> match Array.tryFind (Member.id >> (=) newmem.Id) oldmems with | Some _ -> lst - | _ -> MemberAdded(newmem) :: lst) [] newmems + | _ -> MemberAdded(newmem) :: lst) + List.empty + newmems Array.fold (fun lst (oldmem: RaftMember) -> match Array.tryFind (Member.id >> (=) oldmem.Id) newmems with | Some _ -> lst - | _ -> MemberRemoved(oldmem) :: lst) additions oldmems + | _ -> MemberRemoved(oldmem) :: lst) + additions + oldmems |> List.toArray changes - // ** LogEntry.pop + // ** pop /// _ __ ___ _ __ /// | '_ \ / _ \| '_ \ @@ -1010,7 +982,7 @@ module LogEntry = | LogEntry(_,_,_,_,prev) -> prev | Snapshot _ -> None - // ** LogEntry.snapshot + // ** snapshot /// _ _ /// ___ _ __ __ _ _ __ ___| |__ ___ | |_ @@ -1028,10 +1000,9 @@ module LogEntry = | Configuration(_,idx,term,_,_) -> idx,term | JointConsensus(_,idx,term,_,_) -> idx,term | Snapshot(_,idx,term,_,_,_,_) -> idx,term - in - Snapshot(DiscoId.Create(),idx + 1,term,idx,term,mems,data) + in Snapshot(DiscoId.Create(),idx + 1,term,idx,term,mems,data) - // ** LogEntry.map + // ** map /// _ __ ___ __ _ _ __ /// | '_ ` _ \ / _` | '_ \ @@ -1041,7 +1012,7 @@ module LogEntry = /// /// Map over a Logs<'a,'n> and return a list of results - let rec map (f : RaftLogEntry -> 'b) entry = + let rec map (f : LogEntry -> 'b) entry = let _map curr prev = match prev with | Some previous -> f curr :: map f previous @@ -1053,7 +1024,7 @@ module LogEntry = | LogEntry(_,_,_,_,prev) as curr -> _map curr prev | Snapshot _ as curr -> _map curr None - // ** LogEntry.foldl + // ** foldl /// __ _ _ _ /// / _| ___ | | __| | | @@ -1063,7 +1034,7 @@ module LogEntry = /// /// Fold over a Log and return an aggregate value - let rec foldl (f : 'm -> RaftLogEntry -> 'm) (m : 'm) log = + let rec foldl (f : 'm -> LogEntry -> 'm) (m : 'm) log = let _fold m curr prev = let _m = f m curr match prev with @@ -1076,7 +1047,7 @@ module LogEntry = | LogEntry(_,_,_,_,prev) as curr -> _fold m curr prev | Snapshot _ as curr -> f m curr - // ** LogEntry.foldr + // ** foldr /// __ _ _ /// / _| ___ | | __| |_ __ @@ -1086,7 +1057,7 @@ module LogEntry = /// /// Fold over a Log and return an aggregate value - let rec foldr (f : 'm -> RaftLogEntry -> 'm) (m : 'm) = function + let rec foldr (f : 'm -> LogEntry -> 'm) (m : 'm) = function | Configuration(_,_,_,_,Some prev) as curr -> f (foldr f m prev) curr | Configuration(_,_,_,_,None) as curr -> f m curr | JointConsensus(_,_,_,_,Some prev) as curr -> f (foldr f m prev) curr @@ -1095,7 +1066,7 @@ module LogEntry = | LogEntry(_,_,_,_,None) as curr -> f m curr | Snapshot _ as curr -> f m curr - // ** LogEntry.iter + // ** iter /// _ _ /// (_) |_ ___ _ __ @@ -1104,10 +1075,10 @@ module LogEntry = /// |_|\__\___|_| /// /// Iterate over a log from the newest entry to the oldest. - let iter (f : int -> RaftLogEntry -> unit) (log : RaftLogEntry) = + let iter (f : int -> LogEntry -> unit) (log: LogEntry) = log.Iter f - // ** LogEntry.aggregate + // ** aggregate /// _ _ /// / \ __ _ __ _ _ __ ___ __ _ __ _| |_ ___ @@ -1119,7 +1090,7 @@ module LogEntry = /// Version of left-fold that implements short-circuiting by requiring the /// return value to be wrapped in `Continue<'a>`. - let inline aggregate< ^m > (f : ^m -> RaftLogEntry -> Continue< ^m >) (m : ^m) log = + let inline aggregate< ^m > (f : ^m -> LogEntry -> Continue< ^m >) (m : ^m) log = // wrap the supplied function such that it takes a value lifted to // Continue to proactively stop calculating (what about passing a // closure instead?) @@ -1129,7 +1100,7 @@ module LogEntry = | v -> v // short-circuiting inner function - let rec _resFold (m : Continue< ^m >) (_log : RaftLogEntry) : Continue< ^m > = + let rec _resFold (m : Continue< ^m >) (_log: LogEntry) : Continue< ^m > = let _do curr prev = match m with | Cont _ -> @@ -1151,17 +1122,17 @@ module LogEntry = | Cont v -> v | Ret v -> v - // ** LogEntry.next + // ** next let inline next< ^m > (m: ^m) : Continue< ^m > = Continue.next m - // ** LogEntry.finish + // ** finish let inline finish< ^m > (m: ^m) : Continue< ^m > = Continue.finish m - // ** LogEntry.last + // ** last /// _ _ /// | | __ _ ___| |_ @@ -1180,7 +1151,7 @@ module LogEntry = | JointConsensus(_,_,_,_,Some prev) -> last prev | Snapshot _ as curr -> curr - // ** LogEntry.head + // ** head // _ _ // | |__ ___ __ _ __| | @@ -1200,7 +1171,7 @@ module LogEntry = | curr -> curr - // ** LogEntry.rewrite + // ** rewrite // _ _ // _ __ _____ ___ __(_) |_ ___ @@ -1211,30 +1182,30 @@ module LogEntry = let rec rewrite entry = match entry with | Configuration(id, _, _, mems, None) -> - Configuration(id, index 1, term 1, mems, None) + Configuration(id, 1, 1, mems, None) | Configuration(id, _, term, mems, Some prev) -> let previous = rewrite prev - Configuration(id, getIndex previous + index 1, term, mems, Some previous) + Configuration(id, index previous + 1, term, mems, Some previous) | JointConsensus(id, _, term, changes, None) -> - JointConsensus(id, index 1, term, changes, None) + JointConsensus(id, 1, term, changes, None) | JointConsensus(id, _, term, changes, Some prev) -> let previous = rewrite prev - JointConsensus(id, getIndex previous + index 1, term, changes, Some previous) + JointConsensus(id, index previous + 1, term, changes, Some previous) | LogEntry(id, _, term, data, None) -> - LogEntry(id, index 1, term, data, None) + LogEntry(id, 1, term, data, None) | LogEntry(id, _, term, data, Some prev) -> let previous = rewrite prev - LogEntry(id, getIndex previous + index 1, term, data, Some previous) + LogEntry(id, index previous + 1, term, data, Some previous) | Snapshot(id, _, term, _, pterm, mems, data) -> - Snapshot(id, index 2, term, index 1, pterm, mems, data) + Snapshot(id, 2, term, 1, pterm, mems, data) - // ** LogEntry.append + // ** append /// _ /// __ _ _ __ _ __ ___ _ __ __| | @@ -1245,12 +1216,12 @@ module LogEntry = /// /// Append newer entries to older entries - let append (newer : RaftLogEntry) (older : RaftLogEntry) = - let _aggregator (_log : RaftLogEntry) (_entry : RaftLogEntry) = - if getId _log = getId _entry then - _log + let append (newer: LogEntry) (older: LogEntry) = + let _aggregator (_log: LogEntry) (_entry: LogEntry) = + if id _log = id _entry + then _log else - let nextIdx = getIndex _log + index 1 + let nextIdx = index _log + 1 match _entry with | Configuration(id, _, term, mems, _) -> Configuration(id, nextIdx, term, mems, Some _log) @@ -1266,7 +1237,7 @@ module LogEntry = // find the last shared ancestor let last = last newer - let lcd = find (getId last) older + let lcd = find (id last) older match lcd with | Some ancestor -> @@ -1279,7 +1250,7 @@ module LogEntry = // no overlap found foldr _aggregator older newer - // ** LogEntry.lastIndex + // ** lastIndex // _ _ ___ _ // | | __ _ ___| |_|_ _|_ __ __| | _____ __ @@ -1291,7 +1262,7 @@ module LogEntry = | Snapshot(_,_,_,idx,_,_,_) -> Some idx | _ -> None - // ** LogEntry.lastTerm + // ** lastTerm // _ _ _____ // | | __ _ ___| ||_ _|__ _ __ _ __ ___ @@ -1303,7 +1274,7 @@ module LogEntry = | Snapshot(_,_,_,_,term,_,_) -> Some term | _ -> None - // ** LogEntry.firstIndex + // ** firstIndex // __ _ _ ___ _ // / _(_)_ __ ___| |_|_ _|_ __ __| | _____ __ @@ -1311,7 +1282,7 @@ module LogEntry = // | _| | | \__ \ |_ | || | | | (_| | __/> < // |_| |_|_| |___/\__|___|_| |_|\__,_|\___/_/\_\ - let rec firstIndex (t: Term) (entry: RaftLogEntry) = + let rec firstIndex (t: Term) (entry: LogEntry) = let getIdx idx term prev = match prev with | Some log -> @@ -1342,7 +1313,7 @@ module LogEntry = else None - // ** LogEntry.getn + // ** getn // _ // __ _ ___| |_ _ __ @@ -1373,7 +1344,7 @@ module LogEntry = LogEntry(id,idx,term,data, getn newcnt prev) |> Some - // ** LogEntry.contains + // ** contains // _ _ // ___ ___ _ __ | |_ __ _(_)_ __ ___ @@ -1381,7 +1352,7 @@ module LogEntry = // | (_| (_) | | | | || (_| | | | | \__ \ // \___\___/|_| |_|\__\__,_|_|_| |_|___/ - let rec contains (f: RaftLogEntry -> bool) = function + let rec contains (f: LogEntry -> bool) = function | LogEntry(_,_,_,_,Some prev) as this -> if f this then true else contains f prev @@ -1399,7 +1370,7 @@ module LogEntry = | Snapshot _ as this -> f this - // ** LogEntry.sanitize + // ** sanitize // ____ _ _ _ // / ___| __ _ _ __ (_) |_(_)_______ @@ -1409,7 +1380,7 @@ module LogEntry = /// Make sure the current log entry is a singleton (followed by no entries). let sanitize term = function - | Configuration(id,_,term,mems,_) -> Configuration(id, index 0,term,mems,None) - | JointConsensus(id,_,term,changes,_) -> JointConsensus(id, index 0,term,changes,None) - | LogEntry(id,_,_,data,_) -> LogEntry(id, index 0,term,data,None) + | Configuration(id,_,term,mems,_) -> Configuration(id, 0,term,mems,None) + | JointConsensus(id,_,term,changes,_) -> JointConsensus(id, 0,term,changes,None) + | LogEntry(id,_,_,data,_) -> LogEntry(id, 0,term,data,None) | Snapshot _ as snapshot -> snapshot diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index 82e18b3f..c3a1c557 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -12,159 +12,6 @@ namespace Disco.Raft open System open Disco.Core -// * RaftMonad - -[] -module RaftMonad = - - // ** warn - - let warn str = printfn "[RAFT WARNING] %s" str - - // ** get - - /// get current Raft state - let get = MkRM (fun _ s -> Right (s, s)) - - // ** put - - /// update Raft/State to supplied value - let put s = MkRM (fun _ _ -> Right ((), s)) - - // ** read - - /// get the read-only environment value - let read : RaftM<_,_> = MkRM (fun l s -> Right (l, s)) - - // ** apply - - /// unwrap the closure and apply it to the supplied state/env - let apply (env: 'e) (state: 's) (m: RaftMonad<'e,'s,_,_>) = - match m with | MkRM func -> func env state - - // ** runRaft - - /// run the monadic action against state and environment values - let runRaft (s: 's) (l: 'e) (m: RaftMonad<'e,'s,'a,'err>) = - apply l s m - - // ** evalRaft - - /// run monadic action against supplied state and evironment and return new state - let evalRaft (s: 's) (l: 'e) (m: RaftMonad<'e,'s,'a,'err>) = - match runRaft s l m with - | Right (_,state) | Left (_,state) -> state - - // ** returnM - - /// Lift a regular value into a RaftMonad by wrapping it in a closure. - /// This variant wraps it in a `Right` value. This means the computation will, - /// if possible, continue to the next step. - let returnM value : RaftMonad<'e,'s,'t,'err> = - MkRM (fun _ state -> Right(value, state)) - - // ** ignoreM - - let ignoreM _ : RaftMonad<'e,'s,unit,'err> = - MkRM (fun _ state -> Right((), state)) - - // ** failM - - /// Lift a regular value into a RaftMonad by wrapping it in a closure. - /// This variant wraps it in a `Left` value. This means the computation will - /// not continue past this step and no regular value will be returned. - let failM l = - MkRM (fun _ s -> Left (l, s)) - - // ** returnFromM - - /// pass through the given action - let returnFromM func : RaftMonad<'e,'s,'t,'err> = - func - - // ** zeroM - - let zeroM () = - MkRM (fun _ state -> Right((), state)) - - // ** delayM - - let delayM (f: unit -> RaftMonad<'e,'s,'t,'err>) = - MkRM (fun env state -> f () |> apply env state) - - // ** bindM - - /// Chain up effectful actions. - let bindM (m: RaftMonad<'env,'state,'a,'err>) - (f: 'a -> RaftMonad<'env,'state,'b,'err>) : - RaftMonad<'env,'state,'b,'err> = - MkRM (fun env state -> - match apply env state m with - | Right (value,state') -> f value |> apply env state' - | Left err -> Left err) - - // ** (>>=) - - let (>>=) = bindM - - // ** combineM - - let combineM (m1: RaftMonad<_,_,_,_>) (m2: RaftMonad<_,_,_,_>) = - bindM m1 (fun _ -> m2) - - // ** tryWithM - - let tryWithM (body: RaftMonad<_,_,_,_>) (handler: exn -> RaftMonad<_,_,_,_>) = - MkRM (fun env state -> - try apply env state body - with ex -> apply env state (handler ex)) - - // ** tryFinallyM - - let tryFinallyM (body: RaftMonad<_,_,_,_>) handler : RaftMonad<_,_,_,_> = - MkRM (fun env state -> - try apply env state body - finally handler ()) - - // ** usingM - - let usingM (resource: ('a :> System.IDisposable)) (body: 'a -> RaftMonad<_,_,_,_>) = - tryFinallyM (body resource) - (fun _ -> if not <| isNull (box resource) - then resource.Dispose()) - - // ** whileM - - let rec whileM (guard: unit -> bool) (body: RaftMonad<_,_,_,_>) = - match guard () with - | true -> bindM body (fun _ -> whileM guard body) - | _ -> zeroM () - - // ** forM - - let rec forM (sequence: seq<_>) (body: 'a -> RaftMonad<_,_,_,_>) : RaftMonad<_,_,_,_> = - usingM (sequence.GetEnumerator()) - (fun enum -> whileM enum.MoveNext (delayM (fun _ -> body enum.Current))) - - // ** RaftBuilder - - type RaftBuilder() = - member __.Return(v) = returnM v - member __.ReturnFrom(v) = returnFromM v - member __.Bind(m, f) = bindM m f - member __.Zero() = zeroM () - member __.Delay(f) = delayM f - member __.Combine(a,b) = combineM a b - member __.TryWith(body, handler) = tryWithM body handler - member __.TryFinally(body, handler) = tryFinallyM body handler - member __.Using(res, body) = usingM res body - member __.While(guard, body) = whileM guard body - member __.For(seq, body) = forM seq body - - // ** raft - - let raft = new RaftBuilder() - // * Raft [] @@ -174,960 +21,10 @@ module rec Raft = let private tag (str: string) = String.Format("Raft.{0}",str) - // ** log - - let log site level message = - message - |> Logger.log level (tag site) - |> returnM - - // ** debug - - let debug site str = log site Debug str - - // ** info - - let info site str = log site Info str - - // ** warn - - let warn site str = log site Warn str - - // ** error - - let error site str = log site Err str - - // ** sendAppendEntriesM - - let sendAppendEntriesM (mem: RaftMember) (request: AppendEntries) = - raft { - let! state = get - let! cbs = read - - let msg = - sprintf "to: %s ci: %d term: %d leader-commit: %d prv-log-idx: %d prev-log-term: %d" - (string mem.Id) - (currentIndex state) - request.Term - request.LeaderCommit - request.PrevLogIdx - request.PrevLogTerm - - do! debug "sendAppendEntriesM" msg - - cbs.SendAppendEntries mem request - } - - // ** persistVote - - let persistVote mem = - read >>= fun cbs -> - cbs.PersistVote mem - |> returnM - - // ** persistTerm - - let persistTerm term = - read >>= fun cbs -> - cbs.PersistTerm term - |> returnM - - // ** persistLog - - let persistLog log = - read >>= fun cbs -> - cbs.PersistLog log - |> returnM - - // ** modify - - let modify (f: RaftState -> RaftState) = - get >>= (f >> put) - - // ** zoomM - - let zoomM (f: RaftState -> 'a) = - get >>= (f >> returnM) - // ** rand let private rand = new System.Random() - // ** create - - let create (self : RaftMember) : RaftState = - { Member = self - State = Follower - CurrentTerm = term 0 - CurrentLeader = None - Peers = Map.ofList [(self.Id, self)] - OldPeers = None - NumMembers = 1 - VotedFor = None - Log = Log.empty - CommitIndex = 0 - LastAppliedIdx = 0 - TimeoutElapsed = 0 - ElectionTimeout = Constants.RAFT_ELECTION_TIMEOUT * 1 - RequestTimeout = Constants.RAFT_REQUEST_TIMEOUT * 1 - MaxLogDepth = Constants.RAFT_MAX_LOGDEPTH - ConfigChangeEntry = None } - - // ** isFollower - - /// Is the Raft value in Follower state. - let isFollower (state: RaftState) = - state.State = Follower - - // ** isFollowerM - - let isFollowerM = fun _ -> zoomM isFollower - - // ** isCandidate - - /// Is the Raft value in Candate state. - let isCandidate (state: RaftState) = - state.State = Candidate - - // ** isCandidateM - - let isCandidateM _ = zoomM isCandidate - - // ** isLeader - - /// Is the Raft value in Leader state - let isLeader (state: RaftState) = - state.State = Leader - - // ** isLeaderM - - let isLeaderM _ = zoomM isLeader - - // ** inJointConsensus - - let inJointConsensus (state: RaftState) = - match state.ConfigChangeEntry with - | Some (JointConsensus _) -> true - | _ -> false - - // ** inJointConsensusM - - let inJointConsensusM _ = zoomM inJointConsensus - - // ** hasNonVotingMembers - - let hasNonVotingMembers (state: RaftState) = - Map.fold - (fun b _ n -> - if b then - b - else - not (Member.hasSufficientLogs n && Member.isVoting n)) - false - state.Peers - - // ** hasNonVotingMembersM - - let hasNonVotingMembersM _ = zoomM hasNonVotingMembers - - // ** getChanges - - let getChanges (state: RaftState) = - match state.ConfigChangeEntry with - | Some (JointConsensus(_,_,_,changes,_)) -> Some changes - | _ -> None - - // ** logicalPeers - - let logicalPeers (state: RaftState) = - // when setting the NumMembers counter we have to include the old config - if inJointConsensus state then - // take the old peers as seed and apply the new peers on top - match state.OldPeers with - | Some peers -> Map.fold (fun m k n -> Map.add k n m) peers state.Peers - | _ -> state.Peers - else state.Peers - - // ** logicalPeersM - - let logicalPeersM _ = zoomM logicalPeers - - // ** countMembers - - let countMembers peers = Map.fold (fun m _ _ -> m + 1) 0 peers - - // ** numLogicalPeers - - let numLogicalPeers (state: RaftState) = - logicalPeers state |> countMembers - - // ** setNumPeers - - let setNumPeers (state: RaftState) = - { state with NumMembers = countMembers state.Peers } - - // ** recountPeers - - let recountPeers () = - get >>= (setNumPeers >> put) - - // ** setPeers - - /// Set States Members to supplied Map of Mems. Also cache count of mems. - let setPeers (peers : Map) (state: RaftState) = - { state with Peers = Map.add state.Member.Id state.Member peers } - |> setNumPeers - - // ** addMember - - /// Adds a mem to the list of known Members and increments NumMembers counter - let addMember (mem : RaftMember) (state: RaftState) : RaftState = - let exists = Map.containsKey mem.Id state.Peers - { state with - Peers = Map.add mem.Id mem state.Peers - NumMembers = - if exists - then state.NumMembers - else state.NumMembers + 1 } - - // ** addMemberM - - let addMemberM (mem: RaftMember) = - get >>= (addMember mem >> put) - - // ** addPeer - - /// Alias for `addMember` - let addPeer = addMember - - // ** addPeerM - - let addPeerM = addMemberM - - // ** addNonVotingMember - - /// Add a Non-voting Peer to the list of known Members - let addNonVotingMember (mem : RaftMember) (state: RaftState) = - addMember { mem with Voting = false; Status = Joining } state - - // ** removeMember - - /// Remove a Peer from the list of known Members and decrement NumMembers counter - let removeMember (mem : RaftMember) (state: RaftState) = - let numMembers = - if Map.containsKey mem.Id state.Peers - then state.NumMembers - 1 - else state.NumMembers - - { state with - Peers = Map.remove mem.Id state.Peers - NumMembers = numMembers } - - // ** applyChanges - - let applyChanges changes state = - let folder _state = function - | MemberAdded mem -> addNonVotingMember mem _state - | MemberRemoved mem -> removeMember mem _state - Array.fold folder state changes - - // ** updateMember - - let private updateMember (mem : RaftMember) (cbs: IRaftCallbacks) (state: RaftState) = - // if we are in joint consensus, we must update the mem value in either the - // new or the old configuration, or both. - let old = Map.tryFind mem.Id state.Peers - if inJointConsensus state then - // if the mems has structurally changed fire the callback - match old with - | Some oldMember -> if oldMember <> mem then cbs.MemberUpdated mem - | _ -> () - // update the state - { state with - Peers = - if Option.isSome old then - Map.add mem.Id mem state.Peers - else state.Peers - OldPeers = - match state.OldPeers with - | Some peers -> - if Map.containsKey mem.Id peers then - if Option.isNone old then cbs.MemberUpdated mem - Map.add mem.Id mem peers |> Some - else Some peers - | None -> // apply all required changes again - let folder m = function // but this is an edge case - | MemberAdded peer -> Map.add peer.Id peer m - | MemberRemoved peer -> Map.filter (fun k _ -> k <> peer.Id) m - let changes = getChanges state |> Option.get - let peers = Array.fold folder state.Peers changes - if Map.containsKey mem.Id peers then - Map.add mem.Id mem peers |> Some - else Some peers } - |> setNumPeers - else // base case - // if the mems has structurally changed fire the callback - match old with - | Some oldMember -> if oldMember <> mem then cbs.MemberUpdated mem - | _ -> () - { state with - Peers = - if Map.containsKey mem.Id state.Peers - then Map.add mem.Id mem state.Peers - else state.Peers } - - // ** updateMemberM - - let updateMemberM (mem: RaftMember) = - read >>= fun env -> - get >>= (updateMember mem env >> put) - - // ** addMembers - - let addMembers (mems : Map) (state: RaftState) = - Map.fold (fun m _ n -> addMember n m) state mems - - // ** addMembersM - - let addMembersM (mems: Map) = - get >>= (addMembers mems >> put) - - // ** addPeers - - let addPeers = addMembers - - // ** addPeersM - - let addPeersM = addMembersM - - // ** addNonVotingMemberM - - let addNonVotingMemberM (mem: RaftMember) = - get >>= (addNonVotingMember mem >> put) - - // ** removeMemberM - - let removeMemberM (mem: RaftMember) = - get >>= (removeMember mem >> put) - - // ** hasMember - - let hasMember (nid : MemberId) (state: RaftState) = - Map.containsKey nid state.Peers - - // ** hasMemberM - - let hasMemberM _ = hasMember >> zoomM - - // ** getMember - - let getMember (nid : MemberId) (state: RaftState) = - if inJointConsensus state then - logicalPeers state |> Map.tryFind nid - else - Map.tryFind nid state.Peers - - // ** getMemberM - - /// Find a peer by its Id. Return None if not found. - let getMemberM nid = getMember nid |> zoomM - - // ** setMemberStateM - - let setMemberStateM (nid: MemberId) state = - getMemberM nid >>= function - | Some mem -> updateMemberM { mem with Status = state } - | None -> returnM () - - // ** getMembers - - let getMembers (state: RaftState) = state.Peers - - // ** getMembersM - - let getMembersM _ = zoomM getMembers - - // ** getSelf - - let getSelf (state: RaftState) = state.Member - - // ** getSelfM - - let getSelfM _ = zoomM getSelf - - // ** setSelf - - let setSelf (mem: RaftMember) (state: RaftState) = - { state with Member = mem } - - // ** setSelfM - - let setSelfM mem = - setSelf mem |> modify - - // ** lastConfigChange - - let lastConfigChange (state: RaftState) = - state.ConfigChangeEntry - - // ** lastConfigChangeM - - let lastConfigChangeM _ = - lastConfigChange |> zoomM - - // ** setTerm - - /// Set CurrentTerm on Raft to supplied term. - let setTerm (term : Term) (state: RaftState) = - { state with CurrentTerm = term } - - // ** setTermM - - /// Set CurrentTerm to supplied value. Monadic action. - let setTermM (term : Term) = - raft { - do! setTerm term |> modify - do! persistTerm term - } - - // ** setState - - /// Set current RaftState to supplied state. - let setState (newstate: MemberState) (env: IRaftCallbacks) (state: RaftState) = - if newstate <> state.State then - env.StateChanged state.State newstate - { state with State = newstate } - else state - - // ** setStateM - - /// Set current RaftState to supplied state. Monadic action. - let setStateM (state : MemberState) = - read >>= (setState state >> modify) - - // ** getState - - /// Get current RaftState: Leader, Candidate or Follower - let getState (state: RaftState) = - state.State - - // ** getStateM - - /// Get current RaftState. Monadic action. - let getStateM _ = zoomM getState - - // ** getMaxLogDepth - - let getMaxLogDepth (state: RaftState) = - state.MaxLogDepth - - // ** getMaxLogDepthM - - let getMaxLogDepthM _ = zoomM getMaxLogDepth - - // ** setMaxLogDepth - - let setMaxLogDepth (depth: int) (state: RaftState) = - { state with MaxLogDepth = depth } - - // ** setMaxLogDepthM - - let setMaxLogDepthM (depth: int) = - setMaxLogDepth depth |> modify - - // ** self - - /// Get Member associated with supplied raft value. - let self (state: RaftState) = - state.Member - - // ** selfM - - /// Get Member associated with supplied raft value. Monadic action. - let selfM _ = zoomM self - - // ** setOldPeers - - let setOldPeers (peers : Map option) (state: RaftState) = - { state with OldPeers = peers } |> setNumPeers - - // ** setPeersM - - /// Set States Members to supplied Map of Members. Monadic action. - let setPeersM (peers: Map<_,_>) = - setPeers peers |> modify - - // ** setOldPeersM - - /// Set States Members to supplied Map of Members. Monadic action. - let setOldPeersM (peers: Map<_,_> option) = - setOldPeers peers |> modify - - // ** updatePeers - - /// Map over States Members with supplied mapping function - let updatePeers (f: RaftMember -> RaftMember) (state: RaftState) = - { state with Peers = Map.map (fun _ v -> f v) state.Peers } - - // ** updatePeersM - - /// Map over States Members with supplied mapping function. Monadic action - let updatePeersM (f: RaftMember -> RaftMember) = - updatePeers f |> modify - - // ** setLeader - - /// Set States CurrentLeader field to supplied MemberId. - let setLeader (leader : MemberId option) (cbs: IRaftCallbacks) (state: RaftState) = - if leader <> state.CurrentLeader then - let peers = - Map.map - (fun id peer -> - if Some id = leader then - let peer = Member.setState Leader peer - cbs.MemberUpdated peer - peer - else - let peer = Member.setState Follower peer - cbs.MemberUpdated peer - peer) - state.Peers - cbs.LeaderChanged leader - { state with - CurrentLeader = leader - Peers = peers } - else state - - // ** setLeaderM - - /// Set States CurrentLeader field to supplied MemberId. Monadic action. - let setLeaderM (leader : MemberId option) = - read >>= fun cbs -> setLeader leader cbs |> modify - - // ** setNextIndex - - /// Set the nextIndex field on Member corresponding to supplied Id (should it - /// exist, that is). - let setNextIndex (nid : MemberId) idx cbs (state: RaftState) = - let mem = getMember nid state - let nextidx = if idx < index 1 then index 1 else idx - match mem with - | Some mem -> updateMember { mem with NextIndex = nextidx } cbs state - | _ -> state - - // ** setNextIndexM - - /// Set the nextIndex field on Member corresponding to supplied Id (should it - /// exist, that is) and supplied index. Monadic action. - let setNextIndexM (nid : MemberId) idx = - read >>= (setNextIndex nid idx >> modify) - - // ** setAllNextIndex - - /// Set the nextIndex field on all Members to supplied index. - let setAllNextIndex idx (state: RaftState) = - let updater _ p = { p with NextIndex = idx } - if inJointConsensus state then - { state with - Peers = Map.map updater state.Peers - OldPeers = - match state.OldPeers with - | Some peers -> Map.map updater peers |> Some - | _ -> None } - else - { state with Peers = Map.map updater state.Peers } - - // ** setAllNextIndexM - - let setAllNextIndexM idx = - setAllNextIndex idx |> modify - - // ** setMatchIndex - - /// Set the matchIndex field on Member to supplied index. - let setMatchIndex nid idx env (state: RaftState) = - let mem = getMember nid state - match mem with - | Some peer -> updateMember { peer with MatchIndex = idx } env state - | _ -> state - - // ** setMatchIndexM - - let setMatchIndexM nid idx = - read >>= (setMatchIndex nid idx >> modify) - - // ** setAllMatchIndex - - /// Set the matchIndex field on all Members to supplied index. - let setAllMatchIndex idx (state: RaftState) = - let updater _ p = { p with MatchIndex = idx } - if inJointConsensus state then - { state with - Peers = Map.map updater state.Peers - OldPeers = - match state.OldPeers with - | Some peers -> Map.map updater peers |> Some - | _ -> None } - else - { state with Peers = Map.map updater state.Peers } - - // ** setAllMatchIndexM - - let setAllMatchIndexM idx = - setAllMatchIndex idx |> modify - - // ** voteFor - - /// Remeber who we have voted for in current election. - let voteFor (mem : RaftMember option) = - let doVoteFor state = - { state with VotedFor = Option.map (fun (n : RaftMember) -> n.Id) mem } - - raft { - let! state = get - do! persistVote mem - do! doVoteFor state |> put - } - - // ** voteForId - - /// Remeber who we have voted for in current election - let voteForId (nid : MemberId) = - raft { - let! mem = getMemberM nid - do! voteFor mem - } - - // ** resetVotes - - let resetVotes (state: RaftState) = - let resetter _ peer = Member.setVotedForMe false peer - { state with - Peers = Map.map resetter state.Peers - OldPeers = - match state.OldPeers with - | Some peers -> Map.map resetter peers |> Some - | _ -> None } - - // ** resetVotesM - - let resetVotesM _ = - resetVotes |> modify - - // ** voteForMyself - - let voteForMyself _ = - get >>= fun state -> voteFor (Some state.Member) - - // ** votedForMyself - - let votedForMyself (state: RaftState) = - match state.VotedFor with - | Some(nid) -> nid = state.Member.Id - | _ -> false - - // ** votedFor - - let votedFor (state: RaftState) = - state.VotedFor - - // ** votedForM - - let votedForM _ = zoomM votedFor - - // ** setVoting - - let setVoting (mem : RaftMember) (vote : bool) (state: RaftState) = - let updated = Member.setVotedForMe vote mem - if inJointConsensus state then - { state with - Peers = - if Map.containsKey updated.Id state.Peers then - Map.add updated.Id updated state.Peers - else state.Peers - OldPeers = - match state.OldPeers with - | Some peers -> - if Map.containsKey updated.Id peers then - Map.add updated.Id updated peers |> Some - else Some peers - | _ -> None } - else - { state with Peers = Map.add updated.Id updated state.Peers } - - // ** setVotingM - - let setVotingM (mem: RaftMember) (vote: bool) = - raft { - let msg = sprintf "setting mem %s voting to %b" (string mem.Id) vote - do! debug "setVotingM" msg - do! setVoting mem vote |> modify - } - - // ** currentIndex - - let currentIndex (state: RaftState) = - Log.getIndex state.Log - - // ** currentIndexM - - let currentIndexM _ = zoomM currentIndex - - // ** numMembers - - let numMembers (state: RaftState) = - state.NumMembers - - // ** numMembersM - - let numMembersM _ = zoomM numMembers - - // ** numPeers - - let numPeers = numMembers - - // ** numPeersM - - let numPeersM = numMembersM - - // ** numOldPeers - - let numOldPeers (state: RaftState) = - match state.OldPeers with - | Some peers -> Map.fold (fun m _ _ -> m + 1) 0 peers - | _ -> 0 - - // ** numOldPeersM - - let numOldPeersM _ = zoomM numOldPeers - - // ** votingMembers - - let votingMembers (state: RaftState) = - votingMembersForConfig state.Peers - - // ** votingMembersM - - let votingMembersM _ = zoomM votingMembers - - // ** votingMembersForConfig - - let votingMembersForConfig peers = - let counter r _ n = - if Member.isVoting n then r + 1 else r - Map.fold counter 0 peers - - // ** votingMembersForOldConfig - - let votingMembersForOldConfig (state: RaftState) = - match state.OldPeers with - | Some peers -> votingMembersForConfig peers - | _ -> 0 - - // ** votingMembersForOldConfigM - - let votingMembersForOldConfigM _ = zoomM votingMembersForOldConfig - - // ** numLogs - - let numLogs (state: RaftState) = - Log.length state.Log - - // ** numLogsM - - let numLogsM _ = zoomM numLogs - - // ** currentTerm - - let currentTerm (state: RaftState) = - state.CurrentTerm - - // ** currentTermM - - let currentTermM _ = zoomM currentTerm - - // ** firstIndex - - let firstIndex (term: Term) (state: RaftState) = - Log.firstIndex term state.Log - - // ** firstIndexM - - let firstIndexM (term: Term) = - firstIndex term |> zoomM - - // ** currentLeader - - let currentLeader (state: RaftState) = - state.CurrentLeader - - // ** currentLeaderM - - let currentLeaderM _ = zoomM currentLeader - - // ** getLeader - - let getLeader (state: RaftState) = - currentLeader state |> Option.bind (flip getMember state) - - // ** commitIndex - - let commitIndex (state: RaftState) = - state.CommitIndex - - // ** commitIndexM - - let commitIndexM () = zoomM commitIndex - - // ** setCommitIndex - - let setCommitIndex (idx : Index) (state: RaftState) = - { state with CommitIndex = idx } - - // ** setCommitIndexM - - let setCommitIndexM (idx : Index) = - setCommitIndex idx |> modify - - // ** requestTimedout - - let requestTimedOut (state: RaftState) : bool = - state.RequestTimeout <= state.TimeoutElapsed - - // ** requestTimedoutM - - let requestTimedOutM _ = zoomM requestTimedOut - - // ** electionTimedout - - let electionTimedOut (state: RaftState) : bool = - state.ElectionTimeout <= state.TimeoutElapsed - - // ** electionTimedoutM - - let electionTimedOutM _ = zoomM electionTimedOut - - // ** electionTimeout - - let electionTimeout (state: RaftState) = - state.ElectionTimeout - - // ** electionTimeoutM - - let electionTimeoutM _ = zoomM electionTimeout - - // ** timeoutElapsed - - let timeoutElapsed (state: RaftState) = - state.TimeoutElapsed - - // ** timeoutElapsedM - - let timeoutElapsedM _ = zoomM timeoutElapsed - - // ** setTimeoutElapsed - - let private setTimeoutElapsed (elapsed: Timeout) (state: RaftState) = - { state with TimeoutElapsed = elapsed } - - // ** setTimeoutElapsedM - - let setTimeoutElapsedM (elapsed: Timeout) = - setTimeoutElapsed elapsed |> modify - - // ** requestTimeout - - let requestTimeout (state: RaftState) = - state.RequestTimeout - - // ** requestTimeoutM - - let requestTimeoutM _ = zoomM requestTimeout - - // ** setRequestTimeout - - let setRequestTimeout (timeout : Timeout) (state: RaftState) = - { state with RequestTimeout = timeout } - - // ** setRequestTimeoutM - - let setRequestTimeoutM (timeout: Timeout) = - setRequestTimeout timeout |> modify - - // ** setElectionTimeout - - let setElectionTimeout (timeout : Timeout) (state: RaftState) = - { state with ElectionTimeout = timeout } - - // ** setElectionTimeoutM - - let setElectionTimeoutM (timeout: Timeout) = - setElectionTimeout timeout |> modify - - // ** _lastAppliedIdx - - let private _lastAppliedIdx (state: RaftState) = - state.LastAppliedIdx - - // ** lastAppliedIdx - - let lastAppliedIdx () = zoomM _lastAppliedIdx - - // ** setLastAppliedIdx - - let private setLastAppliedIdx (idx : Index) (state: RaftState) = - { state with LastAppliedIdx = idx } - - // ** setLastAppliedIdxM - - let setLastAppliedIdxM (idx: Index) = - setLastAppliedIdx idx |> modify - - // ** maxLogDepth - - let private maxLogDepth (state: RaftState) = state.MaxLogDepth - - // ** maxLogDepthM - - let maxLogDepthM _ = zoomM maxLogDepth - - // ** lastLogTerm - - let private lastLogTerm (state: RaftState) = - Log.getTerm state.Log - - // ** lastLogTermM - - let lastLogTermM _ = zoomM lastLogTerm - - // ** getEntryAt - - let getEntryAt (idx : Index) (state: RaftState) : RaftLogEntry option = - Log.at idx state.Log - - // ** getEntryAtM - - let getEntryAtM (idx: Index) = zoomM (getEntryAt idx) - - // ** getEntriesUntil - - let private getEntriesUntil (idx : Index) (state: RaftState) : RaftLogEntry option = - Log.until idx state.Log - - // ** getEntriesUntilM - - let getEntriesUntilM (idx: Index) = zoomM (getEntriesUntil idx) - - // ** entriesUntilExcluding - - let private entriesUntilExcluding (idx: Index) (state: RaftState) = - Log.untilExcluding idx state.Log - - // ** entriesUntilExcludingM - - let entriesUntilExcludingM (idx: Index) = - entriesUntilExcluding idx |> zoomM - // ** handleConfiguration let private handleConfiguration mems (state: RaftState) = @@ -1146,35 +43,26 @@ module rec Raft = |> Map.ofArray state - |> setPeers peers - |> setOldPeers None + |> RaftState.setPeers peers + |> RaftState.setOldPeers None // ** handleJointConsensus let private handleJointConsensus (changes) (state:RaftState) = let old = state.Peers state - |> applyChanges changes - |> setOldPeers (Some old) - - // ** updateLog - - let updateLog log state = { state with Log = log } - - // ** updateLogM - - let updateLogM log = - get >>= (updateLog log >> put) + |> RaftState.applyChanges changes + |> RaftState.setOldPeers (Some old) // ** appendEntry - let private appendEntry (log: RaftLogEntry) = + let private appendEntry (log: LogEntry) = raft { let! state = get // create the new log by appending let newlog = Log.append log state.Log - do! updateLogM newlog + do! setLog newlog // get back the entries just added // (with correct monotonic idx's) @@ -1183,7 +71,7 @@ module rec Raft = // ** appendEntryM - let appendEntryM (log: RaftLogEntry) = + let appendEntryM (log: LogEntry) = raft { let! result = appendEntry log match result with @@ -1210,9 +98,9 @@ module rec Raft = // ** updateLogEntries - let updateLogEntries (entries: RaftLogEntry) (state: RaftState) = + let updateLogEntries (entries: LogEntry) (state: RaftState) = { state with - Log = { Index = LogEntry.getIndex entries + Log = { Index = LogEntry.index entries Depth = LogEntry.depth entries Data = Some entries } } @@ -1231,7 +119,7 @@ module rec Raft = updateLogEntries newlog state | _ -> cbs.DeleteLog log - updateLog Log.empty state + RaftState.setLog Log.empty state | _ -> state // ** removeEntryM @@ -1258,14 +146,11 @@ module rec Raft = raft { let! state = get - let term = currentTerm state - let current = currentIndex state - let first = - match firstIndex term state with - | Some idx -> idx - | _ -> index 0 + let! term = currentTerm () + let! current = currentIndex () + let! first = firstIndex term >>= (Option.defaultValue 0 >> returnM) - let resp = + let resp: AppendResponse = { Term = term Success = false CurrentIndex = current @@ -1273,26 +158,35 @@ module rec Raft = // 1) If this mem is currently candidate and both its and the requests // term are equal, we become follower and reset VotedFor. - let candidate = isCandidate state - let newLeader = isLeader state && numMembers state = 1 - if (candidate || newLeader) && currentTerm state = msg.Term then + let! candidate = isCandidate () + let! currentlyLeader = isLeader () + let! num = numMembers () + let newLeader = currentlyLeader && num = 1 + if (candidate || newLeader) && term = msg.Term then do! voteFor None - do! setLeaderM nid + do! setLeader nid do! becomeFollower () return Right resp // 2) Else, if the current mem's term value is lower than the requests // term, we take become follower and set our own term to higher value. - elif currentTerm state < msg.Term then - do! setTermM msg.Term - do! setLeaderM nid + elif term < msg.Term then + do! setCurrentTerm msg.Term + do! setLeader nid do! becomeFollower () - return Right { resp with Term = msg.Term } + return + resp + |> AppendResponse.setTerm msg.Term + |> Either.succeed // 3) Else, finally, if the msg's Term is lower than our own we reject the // the request entirely. - elif msg.Term < currentTerm state then - return Left { resp with CurrentIndex = currentIndex state } + elif msg.Term < term then + let! idx = currentIndex() + return + resp + |> AppendResponse.setCurrentIndex idx + |> Either.fail else - return Right resp + return Either.succeed resp } // ** handleConflicts @@ -1303,7 +197,7 @@ module rec Raft = let private handleConflicts (request: AppendEntries) = raft { let idx = request.PrevLogIdx + index 1 - let! local = getEntryAtM idx + let! local = entryAt idx match request.Entries with | Some entries -> @@ -1312,7 +206,7 @@ module rec Raft = // then log in the request and compare their terms match local with | Some entry -> - if LogEntry.getTerm entry <> LogEntry.getTerm remote then + if LogEntry.term entry <> LogEntry.term remote then // removes entry at idx (and all following entries) do! removeEntryM idx | _ -> () @@ -1330,14 +224,15 @@ module rec Raft = let! result = appendEntryM entries match result with | Some log -> - let! fst = currentTermM () >>= firstIndexM + let! fst = currentTerm () >>= firstIndex let fidx = match fst with | Some fidx -> fidx | _ -> msg.PrevLogIdx + (log |> LogEntry.depth |> int |> index) - return { resp with - CurrentIndex = LogEntry.getIndex log - FirstIndex = fidx } + return + resp + |> AppendResponse.setCurrentIndex (LogEntry.index log) + |> AppendResponse.setFirstIndex fidx | _ -> return resp | _ -> return resp } @@ -1349,12 +244,13 @@ module rec Raft = let private maybeSetCommitIdx (msg : AppendEntries) = raft { let! state = get - let cmmtidx = commitIndex state + let! cmmtidx = commitIndex () let ldridx = msg.LeaderCommit if cmmtidx < ldridx then - let lastLogIdx = max (currentIndex state) (index 1) + let! current = currentIndex () + let lastLogIdx = max current (index 1) let newIndex = min lastLogIdx msg.LeaderCommit - do! setCommitIndexM newIndex + do! setCommitIndex newIndex } // ** processEntry @@ -1364,8 +260,8 @@ module rec Raft = do! handleConflicts msg let! response = applyRemainder msg resp do! maybeSetCommitIdx msg - do! setLeaderM nid - return { response with Success = true } + do! setLeader nid + return AppendResponse.setSuccess true resp } // ** checkAndProcess @@ -1374,7 +270,7 @@ module rec Raft = /// term matches prevLogTerm (§5.3) let private checkAndProcess entry nid msg resp = raft { - let! current = currentIndexM () + let! current = currentIndex () if current < msg.PrevLogIdx then do! msg.PrevLogIdx @@ -1382,7 +278,7 @@ module rec Raft = |> error "receiveAppendEntries" return resp else - let term = LogEntry.getTerm entry + let term = LogEntry.term entry if term <> msg.PrevLogTerm then do! sprintf "Failed (term %d) != (prev log term %d) (ci: %d) (prev log idx: %d)" term @@ -1415,7 +311,7 @@ module rec Raft = NextIndex = resp.CurrentIndex + index 1 MatchIndex = resp.CurrentIndex } - let! current = currentIndexM () + let! current = currentIndex () let notVoting = not (Member.isVoting peer) let notLogs = not (Member.hasSufficientLogs peer) @@ -1423,9 +319,9 @@ module rec Raft = if notVoting && idxOk && notLogs then let updated = Member.setHasSufficientLogs peer - do! updateMemberM updated + do! updateMember updated else - do! updateMemberM peer + do! updateMember peer } // ** shouldCommit @@ -1435,16 +331,16 @@ module rec Raft = if nid = state.Member.Id || not (Member.isVoting mem) then votes elif mem.MatchIndex > 0 then - match getEntryAt mem.MatchIndex state with + match RaftState.entryAt mem.MatchIndex state with | Some entry -> - if LogEntry.getTerm entry = state.CurrentTerm && resp.CurrentIndex <= mem.MatchIndex + if LogEntry.term entry = state.CurrentTerm && resp.CurrentIndex <= mem.MatchIndex then votes + 1 else votes | _ -> votes else votes - let commit = commitIndex state - let num = countMembers peers + let commit = RaftState.commitIndex state + let num = RaftState.countMembers peers let votes = Map.fold folder 1 peers (num / 2) < votes && commit < resp.CurrentIndex @@ -1455,33 +351,33 @@ module rec Raft = raft { let! state = get + let! inConsensus = inJointConsensus () let commitOk = - if inJointConsensus state then + if inConsensus then // handle the joint consensus case match state.OldPeers with - | Some peers -> - let older = shouldCommit peers state resp - let newer = shouldCommit state.Peers state resp - older || newer - | _ -> - shouldCommit state.Peers state resp + | Some peers -> + let older = shouldCommit peers state resp + let newer = shouldCommit state.Peers state resp + older || newer + | _ -> shouldCommit state.Peers state resp else // the base case, not in joint consensus shouldCommit state.Peers state resp if commitOk then - do! setCommitIndexM resp.CurrentIndex + do! setCommitIndex resp.CurrentIndex } // ** receiveAppendEntries let receiveAppendEntries (nid: MemberId option) (msg: AppendEntries) = raft { - do! setTimeoutElapsedM 0 // reset timer, so we don't start an election + do! setTimeoutElapsed 0 // reset timer, so we don't start an election // log this if any entries are to be processed if Option.isSome msg.Entries then - let! current = currentIndexM () + let! current = currentIndex () let str = sprintf "from: %A term: %d (ci: %d) (lc-idx: %d) (pli: %d) (plt: %d) (entries: %d)" nid @@ -1499,7 +395,7 @@ module rec Raft = | Right resp -> // this is not the first AppendEntry we're receiving if msg.PrevLogIdx > index 0 then - let! entry = getEntryAtM msg.PrevLogIdx + let! entry = entryAt msg.PrevLogIdx match entry with | Some log -> return! checkAndProcess log nid msg resp @@ -1519,7 +415,7 @@ module rec Raft = let rec receiveAppendEntriesResponse (nid : MemberId) resp = raft { - let! mem = getMemberM nid + let! mem = getMember nid match mem with | None -> do! string nid @@ -1538,23 +434,23 @@ module rec Raft = peer.MatchIndex do! error "receiveAppendEntriesResponse" str // set to current index at follower and try again - do! updateMemberM { peer with - NextIndex = resp.CurrentIndex + 1 - MatchIndex = resp.CurrentIndex } + do! updateMember { peer with + NextIndex = resp.CurrentIndex + 1 + MatchIndex = resp.CurrentIndex } return () else let! state = get // we only process this if we are indeed the leader of the pack - if isLeader state then - let term = currentTerm state + if RaftState.isLeader state then + let term = RaftState.currentTerm state // If response contains term T > currentTerm: set currentTerm = T // and convert to follower (§5.3) if term < resp.Term then let str = sprintf "Failed: (term: %d) < (resp.Term: %d)" term resp.Term do! error "receiveAppendEntriesResponse" str - do! setTermM resp.Term - do! setLeaderM (Some nid) + do! setCurrentTerm resp.Term + do! setLeader (Some nid) do! becomeFollower () elif term <> resp.Term then let str = sprintf "Failed: (term: %d) != (resp.Term: %d)" term resp.Term @@ -1563,15 +459,15 @@ module rec Raft = // If AppendEntries fails because of log inconsistency: // decrement nextIndex and retry (§5.3) if resp.CurrentIndex < peer.NextIndex - 1 then - let! idx = currentIndexM () + let! idx = currentIndex () let nextIndex = min (resp.CurrentIndex + 1) idx do! nextIndex |> sprintf "Failed: cidx < nxtidx. setting nextIndex for %O to %d" peer.Id |> error "receiveAppendEntriesResponse" - do! setNextIndexM peer.Id nextIndex - do! setMatchIndexM peer.Id (nextIndex - 1) + do! setNextIndex peer.Id nextIndex + do! setMatchIndex peer.Id (nextIndex - 1) else let nextIndex = peer.NextIndex - index 1 @@ -1579,8 +475,8 @@ module rec Raft = |> sprintf "Failed: cidx >= nxtidx. setting nextIndex for %O to %d" peer.Id |> error "receiveAppendEntriesResponse" - do! setNextIndexM peer.Id nextIndex - do! setMatchIndexM peer.Id (nextIndex - index 1) + do! setNextIndex peer.Id nextIndex + do! setMatchIndex peer.Id (nextIndex - index 1) else do! updateMemberIndices resp peer do! updateCommitIndex resp @@ -1596,34 +492,37 @@ module rec Raft = let sendAppendEntry (peer: RaftMember) = raft { let! state = get - let entries = getEntriesUntil peer.NextIndex state - let request = { Term = state.CurrentTerm - ; PrevLogIdx = index 0 - ; PrevLogTerm = term 0 - ; LeaderCommit = state.CommitIndex - ; Entries = entries } + let! entries = entriesUntil peer.NextIndex + + let request: AppendEntries = + { Term = state.CurrentTerm + PrevLogIdx = index 0 + PrevLogTerm = term 0 + LeaderCommit = state.CommitIndex + Entries = entries } if peer.NextIndex > index 1 then - let! result = getEntryAtM (peer.NextIndex - 1) - let request = { request with - PrevLogIdx = peer.NextIndex - 1 - PrevLogTerm = - match result with - | Some(entry) -> LogEntry.getTerm entry - | _ -> request.Term } - do! sendAppendEntriesM peer request + let! result = entryAt (peer.NextIndex - 1) + let request = + { request with + PrevLogIdx = peer.NextIndex - 1 + PrevLogTerm = + match result with + | Some(entry) -> LogEntry.term entry + | _ -> request.Term } + do! sendAppendEntries peer request else - do! sendAppendEntriesM peer request + do! sendAppendEntries peer request } // ** sendRemainingEntries let private sendRemainingEntries peerid = raft { - let! peer = getMemberM peerid + let! peer = getMember peerid match peer with | Some mem -> - let! entry = getEntryAtM (Member.nextIndex mem) + let! entry = entryAt (Member.nextIndex mem) if Option.isSome entry then do! sendAppendEntry mem | _ -> return () @@ -1633,14 +532,14 @@ module rec Raft = let sendAllAppendEntriesM () = raft { - let! self = getSelfM () - let! peers = logicalPeersM () + let! self = ``member``() + let! peers = logicalPeers () for KeyValue(id,peer) in peers do if id <> self.Id then do! sendAppendEntry peer - do! setTimeoutElapsedM 0 + do! setTimeoutElapsed 0 } // ** createSnapshot @@ -1694,17 +593,17 @@ module rec Raft = /// committed to the state machine. let responseCommitted (resp : EntryResponse) = raft { - let! entry = getEntryAtM resp.Index + let! entry = entryAt resp.Index match entry with | None -> return false | Some entry -> - if resp.Term <> LogEntry.getTerm entry then + if resp.Term <> LogEntry.term entry then return! "Entry Invalidated" |> Error.asRaftError (tag "responseCommitted") |> failM else - let! cidx = commitIndexM () + let! cidx = commitIndex () return resp.Index <= cidx } @@ -1713,7 +612,7 @@ module rec Raft = let private updateCommitIdx (state: RaftState) = let idx = if state.NumMembers = 1 then - currentIndex state + RaftState.currentIndex state else state.CommitIndex { state with CommitIndex = idx } @@ -1727,14 +626,14 @@ module rec Raft = match result with | Some appended -> let! state = get - let! peers = logicalPeersM () + let! peers = logicalPeers () // iterate through all peers and call sendAppendEntries to each for peer in peers do let mem = peer.Value if mem.Id <> state.Member.Id then let nxtidx = Member.nextIndex mem - let! cidx = currentIndexM () + let! cidx = currentIndex () // calculate whether we need to send a snapshot or not // uint's wrap around, so normalize to int first (might cause trouble with big numbers) @@ -1752,12 +651,12 @@ module rec Raft = do! sendInstallSnapshot mem do! updateCommitIdx |> modify - let! term = currentTermM () + let! term = currentTerm () return { resp with - Id = LogEntry.getId appended + Id = LogEntry.id appended Term = term - Index = LogEntry.getIndex appended } + Index = LogEntry.index appended } | _ -> return! "Append Entry failed" @@ -1767,7 +666,7 @@ module rec Raft = // ** receiveEntry - let receiveEntry (entry : RaftLogEntry) = + let receiveEntry (entry: LogEntry) = raft { let! state = get let response = EntryResponse.create 0 0 @@ -1778,14 +677,14 @@ module rec Raft = "Unexpected Voting Change" |> Error.asRaftError (tag "receiveEntry") |> failM - elif isLeader state then + elif RaftState.isLeader state then do! state.CurrentTerm |> sprintf "(id: %A) (idx: %d) (term: %d)" - (LogEntry.getId entry) - (Log.getIndex state.Log + 1) + (LogEntry.id entry) + (Log.index state.Log + 1) |> debug "receiveEntry" - let! term = currentTermM () + let! term = currentTerm () match entry with | LogEntry(id,_,_,data,_) -> @@ -1868,7 +767,7 @@ module rec Raft = let coi = state.CommitIndex if lai <> coi then let logIdx = lai + 1 - let! result = getEntriesUntilM logIdx + let! result = entriesUntil logIdx match result with | Some entries -> let! cbs = read @@ -1877,7 +776,7 @@ module rec Raft = LogEntry.depth entries |> sprintf "applying %d entries to state machine" - do! info "applyEntries" str + do! RaftMonad.info "applyEntries" str // Apply log chain in the order it arrived let state, change = @@ -1914,13 +813,13 @@ module rec Raft = if LogEntry.contains LogEntry.isConfiguration entries then let selfIncluded (state: RaftState) = Map.containsKey state.Member.Id state.Peers - let! included = selfIncluded |> zoomM + let! included = selfIncluded |> zoom if not included then let str = string state.Member.Id |> sprintf "self (%s) not included in new configuration" do! debug "applyEntries" str - do! setLeaderM None + do! setLeader None do! becomeFollower () /// snapshot now: /// @@ -1931,15 +830,15 @@ module rec Raft = do! doSnapshot() let! state = get - if not (isLeader state) && LogEntry.contains LogEntry.isConfiguration entries then + if not (RaftState.isLeader state) && LogEntry.contains LogEntry.isConfiguration entries then do! debug "applyEntries" "not leader and new configuration is applied. Updating mems." for kv in state.Peers do if kv.Value.Status <> Running then - do! updateMemberM { kv.Value with Status = Running; Voting = true } + do! updateMember { kv.Value with Status = Running; Voting = true } - let idx = LogEntry.getIndex entries + let idx = LogEntry.index entries do! debug "applyEntries" <| sprintf "setting LastAppliedIndex to %d" idx - do! setLastAppliedIdxM idx + do! setLastAppliedIndex idx | _ -> do! debug "applyEntries" (sprintf "no log entries found for index %d" logIdx) } @@ -1973,15 +872,15 @@ module rec Raft = let receiveInstallSnapshot (is: InstallSnapshot) = raft { let! cbs = read - let! currentTerm = currentTermM () + let! term = currentTerm () - if is.Term < currentTerm then + if is.Term < term then return! "Invalid Term" |> Error.asRaftError (tag "receiveInstallSnapshot") |> failM - do! setTimeoutElapsedM 0 + do! setTimeoutElapsed 0 match is.Data with | Snapshot(_,idx,_,_,_,mems, _) as snapshot -> @@ -1991,7 +890,7 @@ module rec Raft = let! state = get - let! remaining = entriesUntilExcludingM idx + let! remaining = entriesUntilExcluding idx // update the cluster configuration let peers = @@ -1999,20 +898,20 @@ module rec Raft = |> Map.ofArray |> Map.add state.Member.Id state.Member - do! setPeersM peers + do! setPeers peers // update log with snapshot and possibly merge existing entries match remaining with | Some entries -> - do! updateLog (Log.empty - |> Log.append is.Data - |> Log.append entries) - |> modify + do! Log.empty + |> Log.append is.Data + |> Log.append entries + |> setLog | _ -> do! updateLogEntries is.Data |> modify // set the current leader to mem which sent snapshot - do! setLeaderM (Some is.LeaderId) + do! setLeader (Some is.LeaderId) // apply all entries in the new log let! state = get @@ -2022,19 +921,19 @@ module rec Raft = | _ -> failwith "Fatal. Snapshot applied, but log is empty. Aborting." // reset the counters,to apply all entries in the log - do! setLastAppliedIdxM (Log.getIndex state.Log) - do! setCommitIndexM (Log.getIndex state.Log) + do! setLastAppliedIndex (Log.index state.Log) + do! setCommitIndex (Log.index state.Log) - // cosntruct reply - let! term = currentTermM () - let! ci = currentIndexM () - let! fi = firstIndexM term + // construct reply + let! term = currentTerm () + let! ci = currentIndex () + let! fi = firstIndex term let ar : AppendResponse = { Term = term - ; Success = true - ; CurrentIndex = ci - ; FirstIndex = match fi with + Success = true + CurrentIndex = ci + FirstIndex = match fi with | Some i -> i | _ -> index 0 } @@ -2054,7 +953,7 @@ module rec Raft = let! state = get match cbs.PrepareSnapshot state with | Some snapshot -> - do! updateLog snapshot |> modify + do! setLog snapshot match snapshot.Data with | Some snapshot -> cbs.PersistSnapshot snapshot | _ -> () @@ -2106,13 +1005,13 @@ module rec Raft = /// Determine whether a vote count constitutes a majority in the *regular* /// configuration (does not cover the joint consensus state). let regularMajorityM votes = - votingMembersM () >>= fun num -> + votingMembers () >>= fun num -> majority num votes |> returnM // ** oldConfigMajorityM let oldConfigMajorityM votes = - votingMembersForOldConfigM () >>= fun num -> + votingMembersForOldConfig () >>= fun num -> majority num votes |> returnM // ** numVotesForConfig @@ -2137,7 +1036,7 @@ module rec Raft = // ** numVotesForMeM - let numVotesForMeM _ = zoomM numVotesForMe + let numVotesForMeM _ = zoom numVotesForMe // ** numVotesForMeOldConfig @@ -2148,7 +1047,7 @@ module rec Raft = // ** numVotesForMeOldConfigM - let numVotesForMeOldConfigM _ = zoomM numVotesForMeOldConfig + let numVotesForMeOldConfigM _ = zoom numVotesForMeOldConfig // ** maybeSetIndex @@ -2165,7 +1064,7 @@ module rec Raft = if Member.isVoting peer && peer.Id <> nid then { peer with NextIndex = nextIdx; MatchIndex = matchIdx } else peer - updatePeersM mapper + updateMembers mapper // ** becomeLeader @@ -2173,11 +1072,11 @@ module rec Raft = let becomeLeader _ = raft { let! state = get - do! info "becomeLeader" "becoming leader" - let nextidx = currentIndex state + 1 - do! setStateM Leader - do! setLeaderM (Some state.Member.Id) - do! maybeSetIndex state.Member.Id nextidx (index 0) + do! RaftMonad.info "becomeLeader" "becoming leader" + let! current = currentIndex () + do! setState Leader + do! setLeader (Some state.Member.Id) + do! maybeSetIndex state.Member.Id (current + 1) (index 0) do! sendAllAppendEntriesM () } @@ -2185,8 +1084,8 @@ module rec Raft = let becomeFollower _ = raft { - do! info "becomeFollower" "becoming follower" - do! setStateM Follower + do! RaftMonad.info "becomeFollower" "becoming follower" + do! setState Follower } // ** becomeCandidate @@ -2205,19 +1104,19 @@ module rec Raft = /// After timeout a Member must become Candidate let becomeCandidate () = raft { - do! info "becomeCandidate" "becoming candidate" + do! RaftMonad.info "becomeCandidate" "becoming candidate" let! state = get let term = state.CurrentTerm + 1 do! debug "becomeCandidate" <| sprintf "setting term to %d" term - do! setTermM term - do! resetVotesM () + do! setCurrentTerm term + do! resetVotes () do! voteForMyself () - do! setLeaderM None - do! setStateM Candidate + do! setLeader None + do! setState Candidate // 150–300ms see page 6 in https://raft.github.io/raft.pdf let elapsed = 1 * rand.Next(10, int state.ElectionTimeout) do! debug "becomeCandidate" <| sprintf "setting timeoutElapsed to %d" elapsed - do! setTimeoutElapsedM elapsed + do! setTimeoutElapsed elapsed do! requestAllVotes () } @@ -2248,8 +1147,8 @@ module rec Raft = state.CurrentTerm state.CurrentTerm |> debug "receiveVoteResponse" - do! setTermM vote.Term - do! setLeaderM (Some nid) + do! setCurrentTerm vote.Term + do! setLeader (Some nid) do! becomeFollower () /// If the vote term is smaller than current term it is considered an @@ -2277,7 +1176,7 @@ module rec Raft = |> failM | Candidate -> if vote.Granted then - let! mem = getMemberM nid + let! mem = getMember nid match mem with // Could not find the mem in current configuration(s) | None -> @@ -2288,9 +1187,9 @@ module rec Raft = |> failM // found the mem | Some mem -> - do! setVotingM mem true + do! setVoting mem true - let! transitioning = inJointConsensusM () + let! transitioning = inJointConsensus () // in joint consensus if transitioning then @@ -2346,8 +1245,8 @@ module rec Raft = let vote = { Term = state.CurrentTerm Candidate = state.Member - LastLogIndex = Log.getIndex state.Log - LastLogTerm = Log.getTerm state.Log } + LastLogIndex = Log.index state.Log + LastLogTerm = Log.term state.Log } do! mem.Status |> sprintf "(to: %s) (state: %A)" (string mem.Id) @@ -2360,9 +1259,9 @@ module rec Raft = let requestAllVotes () = raft { - let! self = getSelfM () - let! peers = logicalPeersM () - do! info "requestAllVotes" "requesting all votes" + let! self = ``member`` () + let! peers = logicalPeers () + do! RaftMonad.info "requestAllVotes" "requesting all votes" for peer in peers do if self.Id <> peer.Value.Id then do! sendVoteRequest peer.Value @@ -2395,27 +1294,27 @@ module rec Raft = let private validateLastLog vote state = let err = RaftError (tag "shouldGrantVote","Invalid Last Log") let result = - vote.LastLogTerm = lastLogTerm state && - currentIndex state <= vote.LastLogIndex + vote.LastLogTerm = RaftState.lastLogTerm state && + RaftState.currentIndex state <= vote.LastLogIndex (result,err) // ** validateLastLogTerm let private validateLastLogTerm vote state = let err = RaftError (tag "shouldGrantVote","Invalid LastLogTerm") - (lastLogTerm state < vote.LastLogTerm, err) + (RaftState.lastLogTerm state < vote.LastLogTerm, err) // ** validateCurrentIdx let private validateCurrentIdx state = let err = RaftError (tag "shouldGrantVote","Invalid Current Index") - (currentIndex state = index 0, err) + (RaftState.currentIndex state = index 0, err) // ** validateCandiate let private validateCandidate (vote: VoteRequest) state = let err = RaftError (tag "shouldGrantVote","Candidate Unknown") - (getMember vote.Candidate.Id state |> Option.isNone, err) + (RaftState.getMember vote.Candidate.Id state |> Option.isNone, err) // ** shouldGrantVote @@ -2459,11 +1358,11 @@ module rec Raft = let private maybeResetFollower (nid: MemberId) (vote : VoteRequest) = raft { - let! term = currentTermM () + let! term = currentTerm () if term < vote.Term then do! debug "maybeResetFollower" "current term < vote Term, resetting to follower state" - do! setTermM vote.Term - do! setLeaderM (Some nid) + do! setCurrentTerm vote.Term + do! setLeader (Some nid) do! becomeFollower () do! voteFor None } @@ -2475,15 +1374,17 @@ module rec Raft = let! result = shouldGrantVote vote match result with | (true,_) -> - let! leader = isLeaderM () - let! candidate = isCandidateM () + let! leader = isLeader () + let! candidate = isCandidate () if not leader && not candidate then do! voteForId vote.Candidate.Id - do! setTimeoutElapsedM 0 - let! term = currentTermM () - return { Term = term - Granted = true - Reason = None } + do! setTimeoutElapsed 0 + let! term = currentTerm () + return { + Term = term + Granted = true + Reason = None + } else do! debug "processVoteRequest" "vote request denied: NotVotingState" return! @@ -2491,17 +1392,19 @@ module rec Raft = |> Error.asRaftError (tag "processVoteRequest") |> failM | (false, err) -> - let! term = currentTermM () - return { Term = term - Granted = false - Reason = Some err } + let! term = currentTerm () + return { + Term = term + Granted = false + Reason = Some err + } } // ** receiveVoteRequest let receiveVoteRequest (nid : MemberId) (vote : VoteRequest) = raft { - let! mem = getMemberM nid + let! mem = getMember nid match mem with | Some _ -> do! maybeResetFollower nid vote @@ -2510,17 +1413,19 @@ module rec Raft = let str = sprintf "mem %s requested vote. granted: %b" (string nid) result.Granted - do! info "receiveVoteRequest" str + do! RaftMonad.info "receiveVoteRequest" str return result | _ -> - do! info "receiveVoteRequest" <| sprintf "requested denied. NoMember %s" (string nid) + do! RaftMonad.info "receiveVoteRequest" <| sprintf "requested denied. NoMember %s" (string nid) - let! trm = currentTermM () + let! trm = currentTerm () let err = RaftError (tag "processVoteRequest", "Not Voting State") - return { Term = trm - Granted = false - Reason = Some err } + return { + Term = trm + Granted = false + Reason = Some err + } } // ** startElection @@ -2534,12 +1439,17 @@ module rec Raft = /// start an election by becoming candidate let startElection () = raft { - let! state = get - let str = sprintf "(elapsed: %d) (elec-timeout: %d) (term: %d) (ci: %d)" - state.TimeoutElapsed - state.ElectionTimeout - state.CurrentTerm - (currentIndex state) + let! currentIndex = currentIndex () + let! elapsed = timeoutElapsed () + let! electionTimeout = electionTimeout () + let! term = currentTerm () + let str = + String.Format( + "(elapsed: {0}) (elec-timeout: {1}) (term: {2}) (ci: {3})", + elapsed, + electionTimeout, + currentTerm, + currentIndex) do! debug "startElection" str do! becomeCandidate () } @@ -2555,22 +1465,22 @@ module rec Raft = let periodic (elapsed : Timeout) = raft { let! state = get - do! setTimeoutElapsedM (state.TimeoutElapsed + elapsed) + do! setTimeoutElapsed (state.TimeoutElapsed + elapsed) match state.State with | Leader -> // if in JointConsensus - let! consensus = inJointConsensusM () - let! timedout = requestTimedOutM () + let! consensus = inJointConsensus () + let! timedout = requestTimedOut () if consensus then // check if any mems are still marked non-voting/Joining // are mems are voting and have caught up - let! waiting = hasNonVotingMembersM () + let! waiting = hasNonVotingMembers () if not waiting then - let! term = currentTermM () + let! term = currentTerm () let response = EntryResponse.create term 0 - let! mems = getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! mems = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) let log = Configuration(response.Id, index 0, term, mems, None) do! handleLog log response >>= ignoreM else @@ -2582,8 +1492,8 @@ module rec Raft = | _ -> // have to double check the code here to ensure new elections are really only called when // not enough votes could be garnered - let! num = numMembersM () - let! timedout = electionTimedOutM () + let! num = numMembers () + let! timedout = electionTimedOut () if timedout && num > 1 then do! startElection () @@ -2592,8 +1502,8 @@ module rec Raft = else do! recountPeers () - let! coi = commitIndexM () - let! lai = lastAppliedIdx () + let! coi = commitIndex () + let! lai = lastAppliedIndex () if lai < coi then do! applyEntries () diff --git a/src/Disco/Disco/Raft/RaftMonad.fs b/src/Disco/Disco/Raft/RaftMonad.fs new file mode 100644 index 00000000..6e2b5167 --- /dev/null +++ b/src/Disco/Disco/Raft/RaftMonad.fs @@ -0,0 +1,634 @@ +(* + * This file is part of Distributed Show Control + * + * Copyright 2015, 2018 by it's authors. + * Some rights reserved. See COPYING, AUTHORS. + *) + +namespace rec Disco.Raft + +// * Imports + +open System +open System.Net +open Disco.Core +open Disco.Serialization +open Aether +open Aether.Operators +open FlatBuffers + +// * RaftMonad + +/// The RaftMonad is a custom Reader/State monad with a specific constructor to provide more type +/// safety. +/// +/// State monads are functions that close over a state value. This state monad is extended by an +/// additional parameter 'Env, the reader monad part. +/// +/// This module should be used when composing Raft code, as it wraps the pure RaftState manipulation +/// code with the callbacks environment needed to provide functionality for Raft. + +[] +type RaftMonad<'Env,'State,'T,'Error> = + MkRM of ('Env -> 'State -> Either<'Error * 'State,'T * 'State>) + +// * RaftM + +type RaftM<'t,'err> = RaftMonad + +// * RaftMonad module + +[] +module RaftMonad = + + // ** get + + /// get current Raft state + let get = MkRM (fun _ s -> Right (s, s)) + + // ** put + + /// update Raft/State to supplied value + let put s = MkRM (fun _ _ -> Right ((), s)) + + // ** read + + /// get the read-only environment value + let read: RaftM<_,_> = MkRM (fun l s -> Right (l, s)) + + // ** apply + + /// unwrap the closure and apply it to the supplied state/env + let apply (env: 'e) (state: 's) (m: RaftMonad<'e,'s,_,_>) = + match m with | MkRM func -> func env state + + // ** runRaft + + /// run the monadic action against state and environment values + let runRaft (s: 's) (l: 'e) (m: RaftMonad<'e,'s,'a,'err>) = + apply l s m + + // ** evalRaft + + /// run monadic action against supplied state and evironment and return new state + let evalRaft (s: 's) (l: 'e) (m: RaftMonad<'e,'s,'a,'err>) = + match runRaft s l m with + | Right (_,state) | Left (_,state) -> state + + // ** returnM + + /// Lift a regular value into a RaftMonad by wrapping it in a closure. + /// This variant wraps it in a `Right` value. This means the computation will, + /// if possible, continue to the next step. + let returnM value : RaftMonad<'e,'s,'t,'err> = + MkRM (fun _ state -> Right(value, state)) + + // ** ignoreM + + let ignoreM _ : RaftMonad<'e,'s,unit,'err> = + MkRM (fun _ state -> Right((), state)) + + // ** failM + + /// Lift a regular value into a RaftMonad by wrapping it in a closure. + /// This variant wraps it in a `Left` value. This means the computation will + /// not continue past this step and no regular value will be returned. + let failM l = + MkRM (fun _ s -> Left (l, s)) + + // ** returnFromM + + /// pass through the given action + let returnFromM func : RaftMonad<'e,'s,'t,'err> = + func + + // ** zeroM + + let zeroM () = + MkRM (fun _ state -> Right((), state)) + + // ** delayM + + let delayM (f: unit -> RaftMonad<'e,'s,'t,'err>) = + MkRM (fun env state -> f () |> apply env state) + + // ** bindM + + /// Chain up effectful actions. + let bindM (m: RaftMonad<'env,'state,'a,'err>) + (f: 'a -> RaftMonad<'env,'state,'b,'err>) : + RaftMonad<'env,'state,'b,'err> = + MkRM (fun env state -> + match apply env state m with + | Right (value,state') -> f value |> apply env state' + | Left err -> Left err) + + // ** (>>=) + + let (>>=) = bindM + + // ** combineM + + let combineM (m1: RaftMonad<_,_,_,_>) (m2: RaftMonad<_,_,_,_>) = + bindM m1 (fun _ -> m2) + + // ** tryWithM + + let tryWithM (body: RaftMonad<_,_,_,_>) (handler: exn -> RaftMonad<_,_,_,_>) = + MkRM (fun env state -> + try apply env state body + with ex -> apply env state (handler ex)) + + // ** tryFinallyM + + let tryFinallyM (body: RaftMonad<_,_,_,_>) handler : RaftMonad<_,_,_,_> = + MkRM (fun env state -> + try apply env state body + finally handler ()) + + // ** usingM + + let usingM (resource: ('a :> System.IDisposable)) (body: 'a -> RaftMonad<_,_,_,_>) = + tryFinallyM (body resource) + (fun _ -> if not <| isNull (box resource) + then resource.Dispose()) + + // ** whileM + + let rec whileM (guard: unit -> bool) (body: RaftMonad<_,_,_,_>) = + match guard () with + | true -> bindM body (fun _ -> whileM guard body) + | _ -> zeroM () + + // ** forM + + let rec forM (sequence: seq<_>) (body: 'a -> RaftMonad<_,_,_,_>) : RaftMonad<_,_,_,_> = + usingM (sequence.GetEnumerator()) + (fun enum -> whileM enum.MoveNext (delayM (fun _ -> body enum.Current))) + + // ** RaftBuilder + + type RaftBuilder() = + member __.Return(v) = returnM v + member __.ReturnFrom(v) = returnFromM v + member __.Bind(m, f) = bindM m f + member __.Zero() = zeroM () + member __.Delay(f) = delayM f + member __.Combine(a,b) = combineM a b + member __.TryWith(body, handler) = tryWithM body handler + member __.TryFinally(body, handler) = tryFinallyM body handler + member __.Using(res, body) = usingM res body + member __.While(guard, body) = whileM guard body + member __.For(seq, body) = forM seq body + + // ** raft + + let raft = new RaftBuilder() + + // ** modify + + let modify (f: RaftState -> RaftState) = + get >>= (f >> put) + + // ** zoom + + let zoom (f: RaftState -> 'a) = + get >>= (f >> returnM) + + // ** tag + + let private tag (str: string) = String.Format("Raft.{0}",str) + + // ** log + + let log site level message = + message + |> Logger.log level (tag site) + |> returnM + + // ** debug + + let debug site str = log site Debug str + + // ** info + + let info site str = log site Info str + + // ** warn + + let warn site str = log site Warn str + + // ** error + + let error site str = log site Err str + + + // ** currentIndex + + let currentIndex () = zoom RaftState.currentIndex + + // ** currentTerm + + let currentTerm () = zoom RaftState.currentTerm + + // ** isFollower + + let isFollower () = zoom RaftState.isFollower + + // ** isCandidate + + let isCandidate () = zoom RaftState.isCandidate + + // ** isLeader + + let isLeader () = zoom RaftState.isLeader + + // ** inJointConsensus + + let inJointConsensus () = zoom RaftState.inJointConsensus + + // ** hasNonVotingMembers + + let hasNonVotingMembers () = zoom RaftState.hasNonVotingMembers + + // ** configurationChanges + + let configurationChanges () = zoom RaftState.configurationChanges + + // ** logicalPeers + + let logicalPeers () = zoom RaftState.logicalPeers + + // ** countMembers + + let countMembers () = zoom (RaftState.logicalPeers >> RaftState.countMembers) + + // ** numLogicalPeers + + let numLogicalPeers () = zoom RaftState.numLogicalPeers + + // ** recountPeers + + let recountPeers () = modify RaftState.recountPeers + + // ** hasMember + + let hasMember nid = zoom (RaftState.hasMember nid) + + // ** getMember + + let getMember nid = zoom (RaftState.getMember nid) + + // ** getMembers + + let getMembers () = zoom RaftState.peers + + // ** member + + let ``member`` () = zoom RaftState.``member`` + + // ** lastConfigChange + + let lastConfigChange () = zoom RaftState.configChangeEntry + + // ** persistVote + + let persistVote mem = + read >>= fun cbs -> cbs.PersistVote mem |> returnM + + // ** persistTerm + + let persistTerm term = + read >>= fun cbs -> cbs.PersistTerm term |> returnM + + // ** persistLog + + let persistLog log = + read >>= fun cbs -> cbs.PersistLog log |> returnM + + // ** setCurrentTerm + + let setCurrentTerm term = + raft { + do! modify (RaftState.setCurrentTerm term) + do! persistTerm term + } + + // ** state + + let state () = zoom RaftState.state + + // ** maxLogDepth + + let maxLogDepth () = zoom RaftState.maxLogDepth + + // ** setMaxLogDepth + + let setMaxLogDepth depth = modify (RaftState.setMaxLogDepth depth) + + // ** setPeers + + let setPeers peers = modify (RaftState.setPeers peers >> RaftState.recountPeers) + + // ** setOldPeers + + let setOldPeers peers = modify (RaftState.setOldPeers peers >> RaftState.recountPeers) + + // ** peers + + let peers () = zoom RaftState.peers + + // ** updateMember + + let updateMember (mem: RaftMember) = + raft { + let! state = get + let updated, state = RaftState.updateMember mem state + do! put state + do! recountPeers () + if updated then + let! cbs = read + // if the mems has structurally changed fire the callback + do cbs.MemberUpdated mem + } + + // ** setNextIndex + + /// Set the nextIndex field on Member corresponding to supplied Id (should it exist, that is) and + /// supplied index. Monadic action. + + let setNextIndex (nid : MemberId) idx = + raft { + let! state = get + let update, state = RaftState.setNextIndex nid idx state + do! put state + if update then + let! env = read + do! getMember nid >>= (Option.iter env.MemberUpdated >> returnM) + } + + // ** setMatchIndex + + let setMatchIndex nid idx = + raft { + let! state = get + let update, state = RaftState.setMatchIndex nid idx state + do! put state + if update then + let! env = read + do! getMember nid >>= (Option.iter env.MemberUpdated >> returnM) + } + + // ** setLeader + + /// Set States CurrentLeader field to supplied MemberId. Monadic action. + + let setLeader (leader : MemberId option) = + raft { + let! state = get + let update, state = RaftState.setLeader leader state + do! put state + if update then + let! env = read + let! peers = logicalPeers () + for KeyValue(_,peer) in peers do + do env.MemberUpdated peer + do env.LeaderChanged leader + } + + // ** voteFor + + /// Remeber who we have voted for in current election. + let voteFor (mem: RaftMember option) = + raft { + do! modify (RaftState.voteFor mem) + do! persistVote mem + } + + // ** voteForId + + /// Remeber who we have voted for in current election + let voteForId (nid : MemberId) = + raft { + let! mem = getMember nid + do! voteFor mem + } + + // ** votedFor + + let votedFor () = zoom RaftState.votedFor + + // ** setVoting + + let setVoting (mem: RaftMember) (vote: bool) = + raft { + let msg = String.Format("setting mem {0} voting to {1}", mem.Id, vote) + do! debug "setVoting" msg + let! state = get + let update, state = RaftState.setVoting mem vote state + do! put state + if update then + let! env = read + do env.MemberUpdated mem + } + + // ** numMembers + + let numMembers () = zoom RaftState.numMembers + + // ** numOldPeers + + let numOldMembers () = zoom RaftState.numOldMembers + + // ** sendAppendEntries + + let sendAppendEntries (mem: RaftMember) (request: AppendEntries) = + raft { + let! idx = currentIndex () + let! cbs = read + let msg = + sprintf "to: %s ci: %d term: %d leader-commit: %d prv-log-idx: %d prev-log-term: %d" + (string mem.Id) + idx + request.Term + request.LeaderCommit + request.PrevLogIdx + request.PrevLogTerm + do! debug "sendAppendEntries" msg + do cbs.SendAppendEntries mem request + } + + // ** addMember + + let addMember (mem: RaftMember) = + raft { + do! modify (RaftState.addMember mem) + let! env = read + do env.MemberAdded mem + } + + // ** addNonVotingMember + + let addNonVotingMember mem = modify (RaftState.addNonVotingMember mem) + + // ** removeMember + + let removeMember mem = + raft { + do! modify (RaftState.removeMember mem) + let! env = read + do env.MemberRemoved mem + } + + // ** applyChanges + + let applyChanges changes = + raft { + do! modify (RaftState.applyChanges changes) + let! env = read + for change in changes do + match change with + | MemberAdded mem -> do env.MemberAdded mem + | MemberRemoved mem -> do env.MemberRemoved mem + } + + // ** addMembers + + let addMembers mems = + raft { + do! modify (RaftState.addMembers mems) + let! env = read + for KeyValue(_,mem) in mems do + do env.MemberAdded mem + } + + // ** setMemberState + + let setMemberState mem memstate = + raft { + let! state = get + let updated, state = RaftState.setMemberState mem memstate state + do! put state + if updated then + let! env = read + let! mem = getMember mem + do Option.iter env.MemberUpdated mem + } + + // ** setState + + /// Set current RaftState to supplied state. + + let setState (newstate: MemberState) = + raft { + let! current = zoom RaftState.state + if newstate <> current then + let! env = read + do! modify (RaftState.setState newstate) + do env.StateChanged current newstate + } + + // ** resetVotes + + let resetVotes () = modify RaftState.resetVotes + + // ** voteForMyself + + let voteForMyself () = + get >>= fun state -> voteFor (Some state.Member) + + // ** votedForMyself + + let votedForMyself () = zoom RaftState.votedForMyself + + // ** votingMembers + + let votingMembers () = zoom RaftState.votingMembers + + // ** votingMembersForOldConfg + + let votingMembersForOldConfig () = zoom RaftState.votingMembersForOldConfig + + // ** numLogs + + let numLogs () = zoom RaftState.numLogs + + // ** firstIndex + + let firstIndex term = zoom (RaftState.firstIndex term) + + // ** currentLeader + + let currentLeader () = zoom RaftState.currentLeader + + // ** getLeader + + let getLeader () = zoom RaftState.getLeader + + // ** commitIndex + + let commitIndex () = zoom RaftState.commitIndex + + // ** setCommitIndex + + let setCommitIndex idx = modify (RaftState.setCommitIndex idx) + + // ** requestTimedOut + + let requestTimedOut () = zoom RaftState.requestTimedOut + + // ** electionTimedOut + + let electionTimedOut () = zoom RaftState.electionTimedOut + + // ** electionTimeout + + let electionTimeout () = zoom RaftState.electionTimeout + + // ** timeoutElapsed + + let timeoutElapsed () = zoom RaftState.timeoutElapsed + + // ** setTimeoutElapsed + + let setTimeoutElapsed elapsed = modify (RaftState.setTimeoutElapsed elapsed) + + // ** requestTimeout + + let requestTimeout () = zoom RaftState.requestTimeout + + // ** setRequestTimeout + + let setRequestTimeout timeout = modify (RaftState.setRequestTimeout timeout) + + // ** setElectionTimeout + + let setElectionTimeout timeout = modify (RaftState.setRequestTimeout timeout) + + // ** lastAppliedIndex + + let lastAppliedIndex () = zoom RaftState.lastAppliedIdx + + // ** setLastAppliedIndex + + let setLastAppliedIndex index = modify (RaftState.setLastAppliedIdx index) + + // ** lastLogTerm + + let lastLogTerm () = zoom RaftState.lastLogTerm + + // ** entryAt + + let entryAt idx = zoom (RaftState.entryAt idx) + + // ** entriesUntil + + let entriesUntil idx = zoom (RaftState.entriesUntil idx) + + // ** entriesUntilExcluding + + let entriesUntilExcluding idx = zoom (RaftState.entriesUntilExcluding idx) + + // ** setLog + + let setLog log = modify (RaftState.setLog log) diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs new file mode 100644 index 00000000..dfc82ff6 --- /dev/null +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -0,0 +1,700 @@ +(* + * This file is part of Distributed Show Control + * + * Copyright 2015, 2018 by it's authors. + * Some rights reserved. See COPYING, AUTHORS. + *) + +namespace rec Disco.Raft + +// * Imports + +open System +open System.Net +open Disco.Core +open Disco.Serialization +open Aether +open Aether.Operators +open FlatBuffers + +#if !FABLE_COMPILER && !DISCO_NODES + +open SharpYaml.Serialization + +#endif + +// * Callback Interface + +/// IRaftCallbacks are an abstraction layer to allow for separation of pure code and side effects +/// which occur in the RaftMonad, and to be able to modularize and test the monadic code without +/// actual IO. +/// +/// A free monad might have also been a good choice, providing the possibility to swap out +/// interpreters in different contexts. + +type IRaftCallbacks = + + /// Request a vote from given Raft server + abstract member SendRequestVote: peer:RaftMember -> request:VoteRequest -> unit + + /// Send AppendEntries message to given server + abstract member SendAppendEntries: peer:RaftMember -> request:AppendEntries -> unit + + /// Send InstallSnapshot command to given serve + abstract member SendInstallSnapshot: peer:RaftMember -> request:InstallSnapshot -> unit + + /// given the current state of Raft, prepare and return a snapshot value of + /// current application state + abstract member PrepareSnapshot: current:RaftState -> Log option + + /// perist the given Snapshot value to disk. For safety reasons this MUST + /// flush all changes to disk. + abstract member PersistSnapshot: snapshot:LogEntry -> unit + + /// attempt to load a snapshot from disk. return None if no snapshot was found + abstract member RetrieveSnapshot: unit -> LogEntry option + + /// apply the given command to state machine + abstract member ApplyLog: command:StateMachine -> unit + + /// a new server was added to the configuration + abstract member MemberAdded: peer:RaftMember -> unit + + /// a new server was added to the configuration + abstract member MemberUpdated: peer:RaftMember -> unit + + /// a server was removed from the configuration + abstract member MemberRemoved: peer:RaftMember -> unit + + /// a cluster configuration transition was successfully applied + abstract member Configured: members:RaftMember array -> unit + + /// a cluster configuration transition was successfully applied + abstract member JointConsensus: changes:ConfigChange array -> unit + + /// the state of Raft itself has changed from old state to new given state + abstract member StateChanged: oldstate:MemberState -> newstate:MemberState -> unit + + /// the leader node changed + abstract member LeaderChanged: leader:MemberId option -> unit + + /// persist vote data to disk. For safety reasons this callback MUST flush + /// the change to disk. + abstract member PersistVote: peer:RaftMember option -> unit + + /// persist term data to disk. For safety reasons this callback MUST flush + /// the change to disk> + abstract member PersistTerm: term:Term -> unit + + /// persist an entry added to the log to disk. For safety reasons this + /// callback MUST flush the change to disk. + abstract member PersistLog: log:LogEntry -> unit + + /// persist the removal of the passed entry from the log to disk. For safety + /// reasons this callback MUST flush the change to disk. + abstract member DeleteLog: log:LogEntry -> unit + +// * RaftStateYaml + +type RaftStateYaml() = + [] val mutable Member : string + [] val mutable Term : Term + [] val mutable Leader : string + [] val mutable VotedFor : string + [] val mutable ElectionTimeout : int + [] val mutable RequestTimeout : int + [] val mutable MaxLogDepth : int + +// * RaftState + +/// State to hold all Raft-specific fields. Progression of the Raft system is a series of incremental +/// changes to a value of this type. + +type RaftState = + { /// this server's own RaftMember information + Member : RaftMember + /// this server's current Raft state, i.e. follower, leader or candidate + State : MemberState + /// the server's current term, a monotonic counter for election cycles + CurrentTerm : Term + /// tracks the current Leader Id, or None if there isn't currently a leader + CurrentLeader : MemberId option + /// map of all known members in the cluster + Peers : Map + /// map of the previous cluster configuration. set if currently in a configuration change + OldPeers : Map option + /// count of all members in the cluster + NumMembers : int + /// the candidate this server voted for in its current term or None if it hasn't voted for any + /// other member yet + VotedFor : MemberId option + /// the replicated state machine command log + Log : Log + /// index of latest log entry known to be committed + CommitIndex : Index + /// index of latest log entry applied to state machine + LastAppliedIdx : Index + /// amount of time left until a new election will be called + TimeoutElapsed : Timeout + /// amount of time that needs to pass before a new election is called + ElectionTimeout : Timeout + /// amount of time to pass until we consider requests to be failed + RequestTimeout : Timeout + /// maximum log depth to reach before automatic snapshotting triggers + MaxLogDepth : int + /// the log entry which has a voting configuration change, otherwise None + ConfigChangeEntry : LogEntry option } + + // ** optics + + static member Member_ = + (fun (rs:RaftState) -> rs.Member), + (fun mem (rs:RaftState) -> { rs with Member = mem }) + + static member State_ = + (fun (rs:RaftState) -> rs.State), + (fun state (rs:RaftState) -> { rs with State = state }) + + static member CurrentTerm_ = + (fun (rs:RaftState) -> rs.CurrentTerm), + (fun currentTerm (rs:RaftState) -> { rs with CurrentTerm = currentTerm }) + + static member CurrentLeader_ = + (fun (rs:RaftState) -> rs.CurrentLeader), + (fun currentLeader (rs:RaftState) -> { rs with CurrentLeader = currentLeader }) + + static member Peers_ = + (fun (rs:RaftState) -> rs.Peers), + (fun peers (rs:RaftState) -> { rs with Peers = peers }) + + static member OldPeers_ = + (fun (rs:RaftState) -> rs.OldPeers), + (fun oldPeers (rs:RaftState) -> { rs with OldPeers = oldPeers }) + + static member NumMembers_ = + (fun (rs:RaftState) -> rs.NumMembers), + (fun numMembers (rs:RaftState) -> { rs with NumMembers = numMembers }) + + static member VotedFor_ = + (fun (rs:RaftState) -> rs.VotedFor), + (fun votedFor (rs:RaftState) -> { rs with VotedFor = votedFor }) + + static member Log_ = + (fun (rs:RaftState) -> rs.Log), + (fun log (rs:RaftState) -> { rs with Log = log }) + + static member CommitIndex_ = + (fun (rs:RaftState) -> rs.CommitIndex), + (fun commitIndex (rs:RaftState) -> { rs with CommitIndex = commitIndex }) + + static member LastAppliedIdx_ = + (fun (rs:RaftState) -> rs.LastAppliedIdx), + (fun lastAppliedIdx (rs:RaftState) -> { rs with LastAppliedIdx = lastAppliedIdx }) + + static member TimeoutElapsed_ = + (fun (rs:RaftState) -> rs.TimeoutElapsed), + (fun timeoutElapsed (rs:RaftState) -> { rs with TimeoutElapsed = timeoutElapsed }) + + static member ElectionTimeout_ = + (fun (rs:RaftState) -> rs.ElectionTimeout), + (fun electionTimeout (rs:RaftState) -> { rs with ElectionTimeout = electionTimeout }) + + static member RequestTimeout_ = + (fun (rs:RaftState) -> rs.RequestTimeout), + (fun requestTimeout (rs:RaftState) -> { rs with RequestTimeout = requestTimeout }) + + static member MaxLogDepth_ = + (fun (rs:RaftState) -> rs.MaxLogDepth), + (fun maxLogDepth (rs:RaftState) -> { rs with MaxLogDepth = maxLogDepth }) + + static member ConfigChangeEntry_ = + (fun (rs:RaftState) -> rs.ConfigChangeEntry), + (fun configChangeEntry (rs:RaftState) -> { rs with ConfigChangeEntry = configChangeEntry }) + + static member CurrentIndex_ = RaftState.Log_ >-> Log.Index_ + + // ** ToString + + override self.ToString() = + sprintf "Member = %s +State = %A +CurrentTerm = %A +CurrentLeader = %A +NumMembers = %A +VotedFor = %A +MaxLogDepth = %A +CommitIndex = %A +LastAppliedIdx = %A +TimeoutElapsed = %A +ElectionTimeout = %A +RequestTimeout = %A +ConfigChangeEntry = %s +" + (self.Member.ToString()) + self.State + self.CurrentTerm + self.CurrentLeader + self.NumMembers + self.VotedFor + self.MaxLogDepth + self.CommitIndex + self.LastAppliedIdx + self.TimeoutElapsed + self.ElectionTimeout + self.RequestTimeout + (if Option.isSome self.ConfigChangeEntry then + Option.get self.ConfigChangeEntry |> string + else Constants.EMPTY) + + // ** IsLeader + + member self.IsLeader = + match self.CurrentLeader with + | Some lid -> self.Member.Id = lid + | _ -> false + + // ** ToYaml + + #if !FABLE_COMPILER && !DISCO_NODES + + member self.ToYaml() = + let yaml = RaftStateYaml() + yaml.Member <- string self.Member.Id + yaml.Term <- self.CurrentTerm + + Option.map + (fun leader -> yaml.Leader <- string leader) + self.CurrentLeader + |> ignore + + Option.map + (fun voted -> yaml.VotedFor <- string voted) + self.VotedFor + |> ignore + + yaml.ElectionTimeout <- int self.ElectionTimeout + yaml.RequestTimeout <- int self.RequestTimeout + yaml.MaxLogDepth <- self.MaxLogDepth + yaml + + // ** FromYaml + + static member FromYaml (yaml: RaftStateYaml) : Either = + either { + let! id = DiscoId.TryParse yaml.Member + + let! leader = + if isNull yaml.Leader + then Right None + else DiscoId.TryParse yaml.Leader |> Either.map Some + + let! votedfor = + if isNull yaml.VotedFor + then Right None + else DiscoId.TryParse yaml.VotedFor |> Either.map Some + + return { + Member = Member.create id + State = Follower + CurrentTerm = yaml.Term + CurrentLeader = leader + Peers = Map.empty + OldPeers = None + NumMembers = 0 + VotedFor = votedfor + Log = Log.empty + CommitIndex = index 0 + LastAppliedIdx = index 0 + TimeoutElapsed = 0 + ElectionTimeout = yaml.ElectionTimeout * 1 + RequestTimeout = yaml.RequestTimeout * 1 + MaxLogDepth = yaml.MaxLogDepth + ConfigChangeEntry = None + } + } + + #endif + +// * RaftState module + +/// Pure functions to manipulate RaftState values. To work with Raft code, please create/use the +/// functions from the RaftMonad module. + +[] +module RaftState = + + // ** getters + + let ``member`` = Optic.get RaftState.Member_ + let state = Optic.get RaftState.State_ + let currentTerm = Optic.get RaftState.CurrentTerm_ + let currentLeader = Optic.get RaftState.CurrentLeader_ + let peers = Optic.get RaftState.Peers_ + let oldPeers = Optic.get RaftState.OldPeers_ + let numMembers = Optic.get RaftState.NumMembers_ + let votedFor = Optic.get RaftState.VotedFor_ + let log = Optic.get RaftState.Log_ + let commitIndex = Optic.get RaftState.CommitIndex_ + let lastAppliedIdx = Optic.get RaftState.LastAppliedIdx_ + let timeoutElapsed = Optic.get RaftState.TimeoutElapsed_ + let electionTimeout = Optic.get RaftState.ElectionTimeout_ + let requestTimeout = Optic.get RaftState.RequestTimeout_ + let maxLogDepth = Optic.get RaftState.MaxLogDepth_ + let configChangeEntry = Optic.get RaftState.ConfigChangeEntry_ + + // ** setters + + let setMember = Optic.set RaftState.Member_ + let setState = Optic.set RaftState.State_ + let setCurrentTerm = Optic.set RaftState.CurrentTerm_ + let setCurrentLeader = Optic.set RaftState.CurrentLeader_ + let setPeers = Optic.set RaftState.Peers_ + let setOldPeers = Optic.set RaftState.OldPeers_ + let setNumMembers = Optic.set RaftState.NumMembers_ + let setVotedFor = Optic.set RaftState.VotedFor_ + let setLog = Optic.set RaftState.Log_ + let setCommitIndex = Optic.set RaftState.CommitIndex_ + let setLastAppliedIdx = Optic.set RaftState.LastAppliedIdx_ + let setTimeoutElapsed = Optic.set RaftState.TimeoutElapsed_ + let setElectionTimeout = Optic.set RaftState.ElectionTimeout_ + let setRequestTimeout = Optic.set RaftState.RequestTimeout_ + let setMaxLogDepth = Optic.set RaftState.MaxLogDepth_ + let setConfigChangeEntry = Optic.set RaftState.ConfigChangeEntry_ + + // ** create + + let create (self: RaftMember) = + { Member = self + State = Follower + CurrentTerm = term 0 + CurrentLeader = None + Peers = Map.ofList [(self.Id, self)] + OldPeers = None + NumMembers = 1 + VotedFor = None + Log = Log.empty + CommitIndex = 0 + LastAppliedIdx = 0 + TimeoutElapsed = 0 + ElectionTimeout = Constants.RAFT_ELECTION_TIMEOUT * 1 + RequestTimeout = Constants.RAFT_REQUEST_TIMEOUT * 1 + MaxLogDepth = Constants.RAFT_MAX_LOGDEPTH + ConfigChangeEntry = None } + + // ** currentIndex + + let currentIndex = Optic.get RaftState.CurrentIndex_ + + // ** isFollower + + let isFollower state = state.State = Follower + + // ** isCandidate + + let isCandidate state = state.State = Candidate + + // ** isLeader + + let isLeader state = state.State = Leader + + // ** inJointConsensus + + let inJointConsensus = configChangeEntry >> function + | Some (JointConsensus _) -> true + | _ -> false + + // ** hasNonVotingMembers + + let hasNonVotingMembers (state: RaftState) = + Map.fold + (fun b _ n -> + if b then + b + else + not (Member.hasSufficientLogs n && Member.isVoting n)) + false + state.Peers + + // ** configurationChanges + + let configurationChanges = configChangeEntry >> function + | Some (JointConsensus(_,_,_,changes,_)) -> Some changes + | _ -> None + + // ** logicalPeers + + let logicalPeers (state: RaftState) = + // when setting the NumMembers counter we have to include the old config + if inJointConsensus state then + // take the old peers as seed and apply the new peers on top + match state.OldPeers with + | Some peers -> Map.fold (fun m k n -> Map.add k n m) peers state.Peers + | _ -> state.Peers + else state.Peers + + // ** countMembers + + let countMembers peers = Map.count peers + + // ** numLogicalPeers + + let numLogicalPeers: RaftState -> int = logicalPeers >> countMembers + + // ** recountPeers + + let recountPeers state = setNumMembers (numLogicalPeers state) state + + // ** hasMember + + let hasMember nid = peers >> Map.containsKey nid + + // ** getMember + + let getMember (nid : MemberId) (state: RaftState) = + if inJointConsensus state then + state + |> logicalPeers + |> Map.tryFind nid + else + Map.tryFind nid state.Peers + + // ** updateMember + + /// Update a member in the RaftState. If it has structurally changed, the first part of the + /// two-tuple returned indicates that a change occurred. + + let updateMember (mem: RaftMember) (state: RaftState) = + let members = peers state + // if we are in joint consensus, we must update the mem value in either the + // new or the old configuration, or both. + if inJointConsensus state then + // first process the regular members + let peersUpdated, peers = + match Map.tryFind mem.Id members with + | Some old when old <> mem -> true, Map.add mem.Id mem members + | _ -> false, members + // next, look at the old cluster configuration and update if changed + let oldPeersUpdated, oldPeers = + match state.OldPeers with + | Some peers -> + match Map.tryFind mem.Id peers with + | Some old when old <> mem -> true, Some (Map.add mem.Id mem peers) + | _ -> false, Some peers + | _ -> + // if OldPeers is empty, but there is a ConfigChangeEntry re-build the OldPeers + match configurationChanges state with + | Some changes -> + let peers = + Array.fold (fun m -> function + | MemberAdded peer -> Map.remove peer.Id m // we must do the inverse operation here + | MemberRemoved peer -> Map.add peer.Id peer m) /// and here too + members + changes + if Map.containsKey mem.Id peers + then true, Some (Map.add mem.Id mem peers) + else false, Some peers + | _ -> false, None + let state = + state + |> setPeers peers + |> setOldPeers oldPeers + peersUpdated || oldPeersUpdated, state + else + let peersUpdated, peers = + match Map.tryFind mem.Id members with + | Some old when old <> mem -> true, Map.add mem.Id mem members + | _ -> false, members + peersUpdated, setPeers peers state + + // ** setNextIndex + + /// Set the nextIndex field on Member corresponding to supplied Id (should it exist, that is). + + let setNextIndex (nid : MemberId) idx (state: RaftState) = + let mem = getMember nid state + let nextIdx = if idx < index 1 then index 1 else idx + match mem with + | Some mem -> + mem + |> Member.setNextIndex nextIdx + |> flip updateMember state + | _ -> false, state + + // ** setMatchIndex + + /// Set the matchIndex field on Member to supplied index. + + let setMatchIndex nid idx (state: RaftState) = + let mem = getMember nid state + match mem with + | Some peer -> + peer + |> Member.setMatchIndex idx + |> flip updateMember state + | _ -> false, state + + // ** setLeader + + /// Set States CurrentLeader field to supplied MemberId. + + let setLeader (leader : MemberId option) (state: RaftState) = + if leader <> state.CurrentLeader then + let peers = + Map.map + (fun id peer -> + if Some id = leader + then Member.setState Leader peer + else Member.setState Follower peer) + state.Peers + let state = + state + |> setCurrentLeader leader + |> setPeers peers + true, state + else false, state + + // ** voteFor + + let voteFor (mem: RaftMember option) = + mem + |> Option.map Member.id + |> setVotedFor + + // ** setVoting + + let setVoting (mem : RaftMember) (vote : bool) = + mem + |> Member.setVotedForMe vote + |> updateMember + + // ** numOldMembers + + let numOldMembers (state: RaftState) = + match state.OldPeers with + | Some peers -> Map.count peers + | _ -> 0 + + // ** addMember + + /// Adds a mem to the list of known Members and increments NumMembers counter + + let addMember (mem: RaftMember) state = + state + |> peers + |> Map.add mem.Id mem + |> flip setPeers state + |> recountPeers + + // ** addNonVotingMember + + /// Add a Non-voting Peer to the list of known Members + + let addNonVotingMember = + Member.setVoting false >> Member.setStatus Joining >> addMember + + // ** removeMember + + /// Remove a Peer from the list of known Members and decrement NumMembers counter + let removeMember (mem: RaftMember) (state: RaftState) = + state + |> peers + |> Map.remove mem.Id + |> flip setPeers state + |> recountPeers + + // ** applyChanges + + let applyChanges changes state = + let folder _state = function + | MemberAdded mem -> addNonVotingMember mem _state + | MemberRemoved mem -> removeMember mem _state + Array.fold folder state changes + + // ** addMembers + + let addMembers mems state = + Map.fold (fun m _ n -> addMember n m) state mems + + // ** setMemberState + + let setMemberState mem memstate state = + match getMember mem state with + | Some mem -> + mem + |> Member.setState memstate + |> flip updateMember state + | _ -> false, state + + // ** resetVotes + + let resetVotes state = + let reset = Map.map (fun _ -> Member.setVotedForMe false) + { state with + Peers = reset state.Peers + OldPeers = Option.map reset state.OldPeers } + + // ** votedForMyself + + let votedForMyself (state: RaftState) = + match state.VotedFor with + | Some(nid) -> nid = state.Member.Id + | _ -> false + + // ** votingMembersForConfig + + let votingMembersForConfig peers = + let counter r _ n = + if Member.isVoting n then r + 1 else r + Map.fold counter 0 peers + + // ** votingMembers + + let votingMembers = peers >> votingMembersForConfig + + // ** votingMembersForOldConfig + + let votingMembersForOldConfig = + oldPeers + >> Option.map votingMembersForConfig + >> Option.defaultValue 0 + + // ** numLogs + + let numLogs = log >> Log.length + + // ** firstIndex + + let firstIndex term = log >> Log.firstIndex term + + // ** getLeader + + let getLeader state = + state + |> currentLeader + |> Option.bind (flip getMember state) + + // ** requestTimedOut + + let requestTimedOut (state: RaftState) : bool = + state.RequestTimeout <= state.TimeoutElapsed + + // ** electionTimedOut + + let electionTimedOut (state: RaftState) : bool = + state.ElectionTimeout <= state.TimeoutElapsed + + // ** lastLogTerm + + let lastLogTerm = log >> Log.term + + // ** entryAt + + let entryAt idx = log >> Log.at idx + + // ** entriesUntil + + let entriesUntil idx = log >> Log.until idx + + // ** entriesUntilExcluding + + let entriesUntilExcluding idx = log >> Log.untilExcluding idx diff --git a/src/Disco/Disco/Raft/Types.fs b/src/Disco/Disco/Raft/Types.fs index 29b4de2e..e9ec1168 100644 --- a/src/Disco/Disco/Raft/Types.fs +++ b/src/Disco/Disco/Raft/Types.fs @@ -12,14 +12,10 @@ open System open System.Net open Disco.Core open Disco.Serialization +open Aether +open Aether.Operators open FlatBuffers -#if !FABLE_COMPILER && !DISCO_NODES - -open SharpYaml.Serialization - -#endif - // * EntryResponse /// Response to an AppendEntry request @@ -77,7 +73,6 @@ type EntryResponse = [] module EntryResponse = - open Aether // ** getting @@ -164,7 +159,6 @@ type VoteRequest = // * VoteRequest module module VoteRequest = - open Aether // ** getters @@ -242,8 +236,6 @@ type VoteResponse = [] module VoteResponse = - open Aether - // ** getters let term = Optic.get VoteResponse.Term_ @@ -279,7 +271,7 @@ type AppendEntries = PrevLogIdx : Index PrevLogTerm : Term LeaderCommit : Index - Entries : RaftLogEntry option } + Entries : LogEntry option } // ** optics @@ -316,7 +308,7 @@ type AppendEntries = let entry = fb.Entries(i) if entry.HasValue then raw.[i] <- entry.Value - RaftLogEntry.FromFB raw + LogEntry.FromFB raw return { Term = term fb.Term PrevLogIdx = index fb.PrevLogIdx @@ -330,7 +322,7 @@ type AppendEntries = member self.ToOffset(builder: FlatBufferBuilder) = let entries = Option.map - (fun (entries: RaftLogEntry) -> + (fun (entries: LogEntry) -> let offsets = entries.ToOffset(builder) AppendEntriesFB.CreateEntriesVector(builder, offsets)) self.Entries @@ -349,7 +341,6 @@ type AppendEntries = // * AppendRequest module module AppendEntries = - open Aether // ** getters @@ -434,8 +425,6 @@ type AppendResponse = module AppendResponse = - open Aether - // ** getters let term = Optic.get AppendResponse.Term_ @@ -472,7 +461,7 @@ type InstallSnapshot = LeaderId: MemberId LastIndex: Index LastTerm: Term - Data: RaftLogEntry } + Data: LogEntry } // ** optics @@ -520,7 +509,7 @@ type InstallSnapshot = let data = fb.Data(i) if data.HasValue then raw.[i] <- data.Value - RaftLogEntry.FromFB raw + LogEntry.FromFB raw else "Invalid InstallSnapshot (no log data)" |> Error.asParseError "InstallSnapshot.FromFB" @@ -546,7 +535,6 @@ type InstallSnapshot = // * InstallSnapshot module module InstallSnapshot = - open Aether // ** getters @@ -563,294 +551,3 @@ module InstallSnapshot = let setLastIndex = Optic.set InstallSnapshot.LastIndex_ let setLastTerm = Optic.set InstallSnapshot.LastTerm_ let setData = Optic.set InstallSnapshot.Data_ - -// * Callback Interface - -type IRaftCallbacks = - - /// Request a vote from given Raft server - abstract member SendRequestVote: peer:RaftMember -> request:VoteRequest -> unit - - /// Send AppendEntries message to given server - abstract member SendAppendEntries: peer:RaftMember -> request:AppendEntries -> unit - - /// Send InstallSnapshot command to given serve - abstract member SendInstallSnapshot: peer:RaftMember -> request:InstallSnapshot -> unit - - /// given the current state of Raft, prepare and return a snapshot value of - /// current application state - abstract member PrepareSnapshot: current:RaftState -> RaftLog option - - /// perist the given Snapshot value to disk. For safety reasons this MUST - /// flush all changes to disk. - abstract member PersistSnapshot: snapshot:RaftLogEntry -> unit - - /// attempt to load a snapshot from disk. return None if no snapshot was found - abstract member RetrieveSnapshot: unit -> RaftLogEntry option - - /// apply the given command to state machine - abstract member ApplyLog: command:StateMachine -> unit - - /// a new server was added to the configuration - abstract member MemberAdded: peer:RaftMember -> unit - - /// a new server was added to the configuration - abstract member MemberUpdated: peer:RaftMember -> unit - - /// a server was removed from the configuration - abstract member MemberRemoved: peer:RaftMember -> unit - - /// a cluster configuration transition was successfully applied - abstract member Configured: members:RaftMember array -> unit - - /// a cluster configuration transition was successfully applied - abstract member JointConsensus: changes:ConfigChange array -> unit - - /// the state of Raft itself has changed from old state to new given state - abstract member StateChanged: oldstate:MemberState -> newstate:MemberState -> unit - - /// the leader node changed - abstract member LeaderChanged: leader:MemberId option -> unit - - /// persist vote data to disk. For safety reasons this callback MUST flush - /// the change to disk. - abstract member PersistVote: peer:RaftMember option -> unit - - /// persist term data to disk. For safety reasons this callback MUST flush - /// the change to disk> - abstract member PersistTerm: term:Term -> unit - - /// persist an entry added to the log to disk. For safety reasons this - /// callback MUST flush the change to disk. - abstract member PersistLog: log:RaftLogEntry -> unit - - /// persist the removal of the passed entry from the log to disk. For safety - /// reasons this callback MUST flush the change to disk. - abstract member DeleteLog: log:RaftLogEntry -> unit - -// * RaftStateYaml - -type RaftStateYaml() = - [] val mutable Member : string - [] val mutable Term : Term - [] val mutable Leader : string - [] val mutable VotedFor : string - [] val mutable ElectionTimeout : int - [] val mutable RequestTimeout : int - [] val mutable MaxLogDepth : int - -// * RaftState - -type RaftState = - { /// this server's own RaftMember information - Member : RaftMember - /// this server's current Raft state, i.e. follower, leader or candidate - State : MemberState - /// the server's current term, a monotonic counter for election cycles - CurrentTerm : Term - /// tracks the current Leader Id, or None if there isn't currently a leader - CurrentLeader : MemberId option - /// map of all known members in the cluster - Peers : Map - /// map of the previous cluster configuration. set if currently in a configuration change - OldPeers : Map option - /// count of all members in the cluster - NumMembers : int - /// the candidate this server voted for in its current term or None if it hasn't voted for any - /// other member yet - VotedFor : MemberId option - /// the replicated state machine command log - Log : RaftLog - /// index of latest log entry known to be committed - CommitIndex : Index - /// index of latest log entry applied to state machine - LastAppliedIdx : Index - /// amount of time left until a new election will be called - TimeoutElapsed : Timeout - /// amount of time that needs to pass before a new election is called - ElectionTimeout : Timeout - /// amount of time to pass until we consider requests to be failed - RequestTimeout : Timeout - /// maximum log depth to reach before automatic snapshotting triggers - MaxLogDepth : int - /// the log entry which has a voting configuration change, otherwise None - ConfigChangeEntry : RaftLogEntry option } - - // ** optics - - static member Member_ = - (fun (rs:RaftState) -> rs.Member), - (fun mem (rs:RaftState) -> { rs with Member = mem }) - - static member State_ = - (fun (rs:RaftState) -> rs.State), - (fun state (rs:RaftState) -> { rs with State = state }) - - static member CurrentTerm_ = - (fun (rs:RaftState) -> rs.CurrentTerm), - (fun currentTerm (rs:RaftState) -> { rs with CurrentTerm = currentTerm }) - - static member CurrentLeader_ = - (fun (rs:RaftState) -> rs.CurrentLeader), - (fun currentLeader (rs:RaftState) -> { rs with CurrentLeader = currentLeader }) - - static member Peers_ = - (fun (rs:RaftState) -> rs.Peers), - (fun peers (rs:RaftState) -> { rs with Peers = peers }) - - static member OldPeers_ = - (fun (rs:RaftState) -> rs.OldPeers), - (fun oldPeers (rs:RaftState) -> { rs with OldPeers = oldPeers }) - - static member NumMembers_ = - (fun (rs:RaftState) -> rs.NumMembers), - (fun numMembers (rs:RaftState) -> { rs with NumMembers = numMembers }) - - static member VotedFor_ = - (fun (rs:RaftState) -> rs.VotedFor), - (fun votedFor (rs:RaftState) -> { rs with VotedFor = votedFor }) - - static member Log_ = - (fun (rs:RaftState) -> rs.Log), - (fun log (rs:RaftState) -> { rs with Log = log }) - - static member CommitIndex_ = - (fun (rs:RaftState) -> rs.CommitIndex), - (fun commitIndex (rs:RaftState) -> { rs with CommitIndex = commitIndex }) - - static member LastAppliedIdx_ = - (fun (rs:RaftState) -> rs.LastAppliedIdx), - (fun lastAppliedIdx (rs:RaftState) -> { rs with LastAppliedIdx = lastAppliedIdx }) - - static member TimeoutElapsed_ = - (fun (rs:RaftState) -> rs.TimeoutElapsed), - (fun timeoutElapsed (rs:RaftState) -> { rs with TimeoutElapsed = timeoutElapsed }) - - static member ElectionTimeout_ = - (fun (rs:RaftState) -> rs.ElectionTimeout), - (fun electionTimeout (rs:RaftState) -> { rs with ElectionTimeout = electionTimeout }) - - static member RequestTimeout_ = - (fun (rs:RaftState) -> rs.RequestTimeout), - (fun requestTimeout (rs:RaftState) -> { rs with RequestTimeout = requestTimeout }) - - static member MaxLogDepth_ = - (fun (rs:RaftState) -> rs.MaxLogDepth), - (fun maxLogDepth (rs:RaftState) -> { rs with MaxLogDepth = maxLogDepth }) - - static member ConfigChangeEntry_ = - (fun (rs:RaftState) -> rs.ConfigChangeEntry), - (fun configChangeEntry (rs:RaftState) -> { rs with ConfigChangeEntry = configChangeEntry }) - - // ** ToString - - override self.ToString() = - sprintf "Member = %s -State = %A -CurrentTerm = %A -CurrentLeader = %A -NumMembers = %A -VotedFor = %A -MaxLogDepth = %A -CommitIndex = %A -LastAppliedIdx = %A -TimeoutElapsed = %A -ElectionTimeout = %A -RequestTimeout = %A -ConfigChangeEntry = %s -" - (self.Member.ToString()) - self.State - self.CurrentTerm - self.CurrentLeader - self.NumMembers - self.VotedFor - self.MaxLogDepth - self.CommitIndex - self.LastAppliedIdx - self.TimeoutElapsed - self.ElectionTimeout - self.RequestTimeout - (if Option.isSome self.ConfigChangeEntry then - Option.get self.ConfigChangeEntry |> string - else Constants.EMPTY) - - // ** IsLeader - - member self.IsLeader = - match self.CurrentLeader with - | Some lid -> self.Member.Id = lid - | _ -> false - - // ** ToYaml - - #if !FABLE_COMPILER && !DISCO_NODES - - member self.ToYaml() = - let yaml = RaftStateYaml() - yaml.Member <- string self.Member.Id - yaml.Term <- self.CurrentTerm - - Option.map - (fun leader -> yaml.Leader <- string leader) - self.CurrentLeader - |> ignore - - Option.map - (fun voted -> yaml.VotedFor <- string voted) - self.VotedFor - |> ignore - - yaml.ElectionTimeout <- int self.ElectionTimeout - yaml.RequestTimeout <- int self.RequestTimeout - yaml.MaxLogDepth <- self.MaxLogDepth - yaml - - // ** FromYaml - - static member FromYaml (yaml: RaftStateYaml) : Either = - either { - let! id = DiscoId.TryParse yaml.Member - - let! leader = - if isNull yaml.Leader - then Right None - else DiscoId.TryParse yaml.Leader |> Either.map Some - - let! votedfor = - if isNull yaml.VotedFor - then Right None - else DiscoId.TryParse yaml.VotedFor |> Either.map Some - - return { - Member = Member.create id - State = Follower - CurrentTerm = yaml.Term - CurrentLeader = leader - Peers = Map.empty - OldPeers = None - NumMembers = 0 - VotedFor = votedfor - Log = Log.empty - CommitIndex = index 0 - LastAppliedIdx = index 0 - TimeoutElapsed = 0 - ElectionTimeout = yaml.ElectionTimeout * 1 - RequestTimeout = yaml.RequestTimeout * 1 - MaxLogDepth = yaml.MaxLogDepth - ConfigChangeEntry = None - } - } - - #endif - -// * RaftMonad - -[] -type RaftMonad<'Env,'State,'T,'Error> = - MkRM of ('Env -> 'State -> Either<'Error * 'State,'T * 'State>) - -// * RaftM - -type RaftM<'t,'err> = - RaftMonad diff --git a/src/Disco/Disco/Service/DiscoService.fs b/src/Disco/Disco/Service/DiscoService.fs index 93004363..6564b0b8 100644 --- a/src/Disco/Disco/Service/DiscoService.fs +++ b/src/Disco/Disco/Service/DiscoService.fs @@ -666,7 +666,7 @@ module DiscoService = // ** persistSnapshot - let private persistSnapshot (state: DiscoState) (log: RaftLogEntry) = + let private persistSnapshot (state: DiscoState) (log: LogEntry) = match Persistence.persistSnapshot state.Store.State log with | Left error -> Logger.err (tag "persistSnapshot") (string error) | _ -> () diff --git a/src/Disco/Disco/Service/Interfaces.fs b/src/Disco/Disco/Service/Interfaces.fs index 72de95cc..d38a2208 100644 --- a/src/Disco/Disco/Service/Interfaces.fs +++ b/src/Disco/Disco/Service/Interfaces.fs @@ -109,7 +109,7 @@ type IFsWatcher = type IRaftSnapshotCallbacks = abstract PrepareSnapshot: unit -> State option - abstract RetrieveSnapshot: unit -> RaftLogEntry option + abstract RetrieveSnapshot: unit -> LogEntry option // * IRaftServer diff --git a/src/Disco/Disco/Service/Persistence.fs b/src/Disco/Disco/Service/Persistence.fs index 67a39014..2b8fb0f3 100644 --- a/src/Disco/Disco/Service/Persistence.fs +++ b/src/Disco/Disco/Service/Persistence.fs @@ -43,11 +43,11 @@ module Persistence = let state = mem |> ClusterMember.toRaftMember - |> Raft.create - |> Raft.addMembers (Map.map (fun _ -> ClusterMember.toRaftMember) mems) - |> Raft.setMaxLogDepth options.Raft.MaxLogDepth - |> Raft.setRequestTimeout options.Raft.RequestTimeout - |> Raft.setElectionTimeout options.Raft.ElectionTimeout + |> RaftState.create + |> RaftState.addMembers (Map.map (fun _ -> ClusterMember.toRaftMember) mems) + |> RaftState.setMaxLogDepth options.Raft.MaxLogDepth + |> RaftState.setRequestTimeout options.Raft.RequestTimeout + |> RaftState.setElectionTimeout options.Raft.ElectionTimeout return state } @@ -298,7 +298,7 @@ module Persistence = // ** persistSnapshot - let persistSnapshot (state: State) (log: RaftLogEntry) = + let persistSnapshot (state: State) (log: Disco.Raft.LogEntry) = either { let path = state.Project.Path do! state.Save(path) diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index b6a80a28..501ff139 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -357,7 +357,7 @@ module rec RaftServer = // ** appendEntry - let private appendEntry (state: RaftServerState) (entry: RaftLogEntry) = + let private appendEntry (state: RaftServerState) (entry: LogEntry) = let result = entry |> Raft.receiveEntry diff --git a/src/Disco/Disco/Tests/Core/Generators.fs b/src/Disco/Disco/Tests/Core/Generators.fs index e41bdaf9..2adfbe81 100644 --- a/src/Disco/Disco/Tests/Core/Generators.fs +++ b/src/Disco/Disco/Tests/Core/Generators.fs @@ -1252,17 +1252,15 @@ module Generators = let! lidx = indexGen let! ltrm = termGen let! entry = - Gen.oneof [ Gen.map (fun (mems, prev) -> RaftLogEntry.Configuration(id, idx, trm, mems, prev)) - (Gen.zip raftMemArr prev) - - Gen.map (fun (chs, prev) -> RaftLogEntry.JointConsensus(id, idx, trm, chs, prev)) - (Gen.zip changeArr prev) - - Gen.map (fun (data, prev) -> RaftLogEntry.LogEntry(id, idx, trm, data, prev)) - (Gen.zip stateMachineGen prev) - - Gen.map (fun (mems, data) -> RaftLogEntry.Snapshot(id, idx, trm, lidx, ltrm, mems, data)) - (Gen.zip raftMemArr stateMachineGen) ] + Gen.oneof [ + Gen.map (fun (mems, prev) -> LogEntry.Configuration(id, idx, trm, mems, prev)) + (Gen.zip raftMemArr prev) + Gen.map (fun (chs, prev) -> LogEntry.JointConsensus(id, idx, trm, chs, prev)) + (Gen.zip changeArr prev) + Gen.map (fun (data, prev) -> LogEntry.LogEntry(id, idx, trm, data, prev)) + (Gen.zip stateMachineGen prev) + Gen.map (fun (mems, data) -> LogEntry.Snapshot(id, idx, trm, lidx, ltrm, mems, data)) + (Gen.zip raftMemArr stateMachineGen) ] return entry } diff --git a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs index 17af38d4..7a789b36 100644 --- a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs +++ b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs @@ -130,7 +130,7 @@ module AppendEntries = expect "Should be a success" true AppendResponse.succeeded response do! expectM "Should have log count 1" 1 Raft.numLogs let! entry = Raft.getEntryAtM (index 1) - expect "Should have term 2" (term 2) (Option.get >> LogEntry.getTerm) entry + expect "Should have term 2" (term 2) (Option.get >> LogEntry.term) entry } |> runWithDefaults |> ignore diff --git a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs index e4143a6d..404d137c 100644 --- a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs +++ b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs @@ -276,7 +276,7 @@ module JointConsensus = do! expectM "(1) Should still have correct mem count for new configuration" (n / 2) Raft.numPeers do! expectM "(1) Should still have correct logical mem count" n Raft.numLogicalPeers do! expectM "(1) Should still have correct mem count for old configuration" n Raft.numOldPeers - do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.getId entry) (Raft.lastConfigChange >> Option.get >> LogEntry.getId) + do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) // _ _ _ ____ // ___| | ___ ___| |_(_) ___ _ __ |___ \ @@ -423,7 +423,7 @@ module JointConsensus = do! expectM "(2) Should still have correct mem count for new configuration 2" n Raft.numPeers do! expectM "(2) Should still have correct logical mem count 2" n Raft.numLogicalPeers do! expectM "(2) Should still have correct mem count for old configuration 2" (n / 2) Raft.numOldPeers - do! expectM "(2) Should have JointConsensus entry as ConfigChange 2" (LogEntry.getId entry) (Raft.lastConfigChange >> Option.get >> LogEntry.getId) + do! expectM "(2) Should have JointConsensus entry as ConfigChange 2" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) // _ _ _ ____ // ___| | ___ ___| |_(_) ___ _ __ | ___| @@ -606,7 +606,7 @@ module JointConsensus = do! expectM "Should still have correct mem count for new configuration" (n / 2) Raft.numPeers do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers do! expectM "Should still have correct mem count for old configuration" n Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.getId entry) (Raft.lastConfigChange >> Option.get >> LogEntry.getId) + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) do! expectM "Should be found in joint consensus configuration myself" true (Raft.getMember self.Id >> Option.isSome) // __ _ _ _ @@ -704,7 +704,7 @@ module JointConsensus = do! expectM "Should still have correct mem count for new configuration" n Raft.numPeers do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers do! expectM "Should still have correct mem count for old configuration" 1 Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.getId entry) (Raft.lastConfigChange >> Option.get >> LogEntry.getId) + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) do! expectM "Should be in joint consensus configuration" true Raft.inJointConsensus let! t = Raft.currentTermM () @@ -769,7 +769,7 @@ module JointConsensus = do! expectM "Should still have correct mem count for new configuration" n Raft.numPeers do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers do! expectM "Should still have correct mem count for old configuration" 1 Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.getId entry) (Raft.lastConfigChange >> Option.get >> LogEntry.getId) + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) do! expectM "Should be in joint consensus configuration" true Raft.inJointConsensus let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) @@ -874,7 +874,7 @@ module JointConsensus = do! expectM "(1) Should still have correct mem count for new configuration" (n / 2) Raft.numPeers do! expectM "(1) Should still have correct logical mem count" n Raft.numLogicalPeers do! expectM "(1) Should still have correct mem count for old configuration" n Raft.numOldPeers - do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.getId entry) (Raft.lastConfigChange >> Option.get >> LogEntry.getId) + do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) do! expectM "(1) Should be in joint consensus configuration" true Raft.inJointConsensus let! committed = Raft.responseCommitted response @@ -946,7 +946,7 @@ module JointConsensus = do! expectM "Should still have correct mem count for new configuration" n Raft.numPeers do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers do! expectM "Should still have correct mem count for old configuration" (n / 2) Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.getId entry) (Raft.lastConfigChange >> Option.get >> LogEntry.getId) + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) let! result = Raft.responseCommitted response do! expectM "Should be committed" true (konst result) diff --git a/src/Disco/Disco/Tests/Raft/LogTests.fs b/src/Disco/Disco/Tests/Raft/LogTests.fs index 98e429e6..469d155b 100644 --- a/src/Disco/Disco/Tests/Raft/LogTests.fs +++ b/src/Disco/Disco/Tests/Raft/LogTests.fs @@ -26,7 +26,7 @@ module Log = let log_new_log_is_empty = testCase "When create, a log should be empty" <| fun _ -> - let log : RaftLog = Log.empty + let log: Log = Log.empty expect "Should be zero" 0 Log.length log let log_is_non_empty = @@ -44,15 +44,15 @@ module Log = testCase "When I add an entry, it should have the correct index" <| fun _ -> Log.empty |> Log.append (Log.make (term 1) defSM) - |> assume "Should have currentIndex 1" (index 1) Log.getIndex - |> assume "Should have currentTerm 1" (term 1) Log.getTerm + |> assume "Should have currentIndex 1" (index 1) Log.index + |> assume "Should have currentTerm 1" (term 1) Log.term |> assume "Should have no lastTerm" None Log.prevTerm |> assume "Should have no lastIndex" None Log.prevIndex |> Log.append (Log.make (term 1) defSM) - |> assume "Should have currentIndex 2" (index 2) Log.getIndex - |> assume "Should have currentTerm 1" (term 1) Log.getTerm + |> assume "Should have currentIndex 2" (index 2) Log.index + |> assume "Should have currentTerm 1" (term 1) Log.term |> assume "Should have lastTerm 1" (Some (term 1)) Log.prevTerm |> assume "Should have lastIndex 1" (Some (index 1)) Log.prevIndex |> ignore @@ -71,15 +71,15 @@ module Log = |> Log.append (LogEntry(id3, index 0, term 1, defSM, None)) Log.at (index 1) log - |> assume "Should be correct one" id1 (LogEntry.getId << Option.get) + |> assume "Should be correct one" id1 (LogEntry.id << Option.get) |> ignore Log.at (index 2) log - |> assume "Should also be correct one" id2 (LogEntry.getId << Option.get) + |> assume "Should also be correct one" id2 (LogEntry.id << Option.get) |> ignore Log.at (index 3) log - |> assume "Should also be correct one" id3 (LogEntry.getId << Option.get) + |> assume "Should also be correct one" id3 (LogEntry.id << Option.get) |> ignore expect "Should find none at invalid index" None (Log.at (index 8)) log @@ -97,15 +97,15 @@ module Log = |> Log.append (LogEntry(id3, index 0, term 1, defSM, None)) Log.find id1 log - |> assume "Should be correct one" id1 (LogEntry.getId << Option.get) + |> assume "Should be correct one" id1 (LogEntry.id << Option.get) |> ignore Log.find id2 log - |> assume "Should also be correct one" id2 (LogEntry.getId << Option.get) + |> assume "Should also be correct one" id2 (LogEntry.id << Option.get) |> ignore Log.find id3 log - |> assume "Should also be correct one" id3 (LogEntry.getId << Option.get) + |> assume "Should also be correct one" id3 (LogEntry.id << Option.get) |> ignore Log.find (DiscoId.Create()) log @@ -133,7 +133,7 @@ module Log = |> Log.append (Log.make (term 1) sm) |> Log.append (Log.make (term 1) defSM) - let folder (m: int) (log: RaftLogEntry) : Continue = + let folder (m: int) (log: LogEntry) : Continue = let value = (LogEntry.data >> Option.get) log if value = sm then LogEntry.finish (m + 9) @@ -164,7 +164,7 @@ module Log = testCase "Should have monotonic index" <| fun _ -> let isMonotonic log = let __mono (last,ret) _log = - let i = LogEntry.getIndex _log + let i = LogEntry.index _log if ret then (i, i = (last + index 1)) else (i, ret) Log.foldLogR __mono (index 0,true) log @@ -268,7 +268,7 @@ module Log = Log.append newer log |> assume "Should have length 3" 3 Log.length - |> expect "Should have proper id" id3 (Log.entries >> Option.get >> LogEntry.getId) + |> expect "Should have proper id" id3 (Log.entries >> Option.get >> LogEntry.id) let log_snapshot_remembers_last_state = @@ -288,7 +288,7 @@ module Log = Log.snapshot mems (DataSnapshot(State.Empty)) log |> assume "Should have correct lastTerm" (Some term) Log.lastTerm - |> expect "Should have correct lastIndex" (Some <| Log.getIndex log) Log.lastIndex + |> expect "Should have correct lastIndex" (Some <| Log.index log) Log.lastIndex let log_untilExcluding_should_return_expected_enries = testCase "untilExcluding should return expected enries" <| fun _ -> @@ -302,7 +302,7 @@ module Log = } ] |> List.fold (fun m s -> Log.append (Log.make (term 0) s) m) Log.empty |> assume "Should be at correct index" num Log.length - |> assume "Should pick correct item" (index 16) (Log.untilExcluding (index 15) >> Option.get >> LogEntry.last >> LogEntry.getIndex) + |> assume "Should pick correct item" (index 16) (Log.untilExcluding (index 15) >> Option.get >> LogEntry.last >> LogEntry.index) |> assume "Should have correct index" (AddCue { Id = id; Name = name "16"; Slices = [| |] } |> Some) (Log.untilExcluding (index 15) >> Option.get >> LogEntry.last >> LogEntry.data) |> assume "Should have correct index" (AddCue { Id = id; Name = name "15"; Slices = [| |] } |> Some) (Log.until (index 15) >> Option.get >> LogEntry.last >> LogEntry.data) |> ignore diff --git a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs index de56a6d3..401e0016 100644 --- a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs +++ b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs @@ -46,9 +46,9 @@ module RaftTestUtils = { SendRequestVote : RaftMember -> VoteRequest -> unit SendAppendEntries : RaftMember -> AppendEntries -> unit SendInstallSnapshot : RaftMember -> InstallSnapshot -> unit - PersistSnapshot : RaftLogEntry -> unit - PrepareSnapshot : RaftState -> RaftLog option - RetrieveSnapshot : unit -> RaftLogEntry option + PersistSnapshot : LogEntry -> unit + PrepareSnapshot : RaftState -> Log option + RetrieveSnapshot : unit -> LogEntry option ApplyLog : StateMachine -> unit MemberAdded : RaftMember -> unit MemberUpdated : RaftMember -> unit @@ -59,8 +59,8 @@ module RaftTestUtils = LeaderChanged : MemberId option -> unit PersistVote : RaftMember option -> unit PersistTerm : Term -> unit - PersistLog : RaftLogEntry -> unit - DeleteLog : RaftLogEntry -> unit + PersistLog : LogEntry -> unit + DeleteLog : LogEntry -> unit LogMsg : RaftMember -> CallSite -> LogLevel -> String -> unit } interface IRaftCallbacks with @@ -99,7 +99,7 @@ module RaftTestUtils = PrepareSnapshot = fun raft -> Raft.createSnapshot raft !data |> Some - PersistSnapshot = fun (entry: RaftLogEntry) -> + PersistSnapshot = fun (entry: LogEntry) -> if debug then sprintf "Perisisting Snapshot: %A" entry |> Logger.debug "PersistSnapshot" diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index ecd852d8..ef23f4a3 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -1283,8 +1283,8 @@ module ServerTests = |> getAppendEntries |> assume "Should have PrevLogIdx 0" (index 0) (fun ae -> ae.PrevLogIdx) |> assume "Should have one entry" 1 (fun ae -> ae.Entries |> Option.get |> LogEntry.depth) - |> assume "Should have entry with correct id" (LogEntry.getId log) (fun ae -> ae.Entries |> Option.get |> LogEntry.getId) - |> expect "Should have entry with term" (term 2) (fun ae -> ae.Entries |> Option.get |> LogEntry.getTerm) + |> assume "Should have entry with correct id" (LogEntry.id log) (fun ae -> ae.Entries |> Option.get |> LogEntry.id) + |> expect "Should have entry with term" (term 2) (fun ae -> ae.Entries |> Option.get |> LogEntry.term) sender.Outbox := List.empty // reset outbox @@ -2303,7 +2303,7 @@ module ServerTests = let init = defaultServer () - let cb l = count := LogEntry.getId l :: !count + let cb l = count := LogEntry.id l :: !count let cbs = { Callbacks.Create (ref defSM) with @@ -2317,7 +2317,7 @@ module ServerTests = let ids = [ log3; log2; log1; ] - |> List.map LogEntry.getId + |> List.map LogEntry.id do! Raft.setStateM Leader @@ -2341,7 +2341,7 @@ module ServerTests = let init = defaultServer () let cb l = - let fltr l r = LogEntry.getId l <> LogEntry.getId r + let fltr l r = LogEntry.id l <> LogEntry.id r in count := List.filter (fltr l) !count let cbs = diff --git a/src/Disco/Disco/Tests/TestUtilities.fs b/src/Disco/Disco/Tests/TestUtilities.fs index 3856aa5b..6d4affac 100644 --- a/src/Disco/Disco/Tests/TestUtilities.fs +++ b/src/Disco/Disco/Tests/TestUtilities.fs @@ -399,7 +399,7 @@ module TestData = [| for _ in 0 .. n do yield mkChange () |] - let mkLog _ : Either = + let mkLog _ : Either = either { let! state = mkTmpDir() |> mkState return diff --git a/src/Disco/Projects/Core/Core.fsproj b/src/Disco/Projects/Core/Core.fsproj index 0964ab25..744d34df 100644 --- a/src/Disco/Projects/Core/Core.fsproj +++ b/src/Disco/Projects/Core/Core.fsproj @@ -184,6 +184,12 @@ Types.fs + + RaftState.fs + + + RaftMonad.fs + Raft.fs From dac09bc588d34357573890c53f094c33e49b9790 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Thu, 8 Feb 2018 15:25:25 +0100 Subject: [PATCH 08/27] more work separating effectful from pure Raft code --- src/Disco/Disco/Core/Util.fs | 4 + src/Disco/Disco/Raft/LogEntry.fs | 8 +- src/Disco/Disco/Raft/Raft.fs | 98 +- src/Disco/Disco/Raft/RaftMonad.fs | 47 +- src/Disco/Disco/Raft/RaftState.fs | 23 +- src/Disco/Disco/Service/RaftServer.fs | 87 +- .../Disco/Tests/Raft/AppendEntriesTests.fs | 96 +- .../Disco/Tests/Raft/JointConsensusTests.fs | 352 +++---- src/Disco/Disco/Tests/Raft/RaftTestUtils.fs | 2 +- src/Disco/Disco/Tests/Raft/Scenarios.fs | 18 +- src/Disco/Disco/Tests/Raft/ServerTests.fs | 938 +++++++++--------- 11 files changed, 834 insertions(+), 839 deletions(-) diff --git a/src/Disco/Disco/Core/Util.fs b/src/Disco/Disco/Core/Util.fs index 60143927..3f7f7d7b 100644 --- a/src/Disco/Disco/Core/Util.fs +++ b/src/Disco/Disco/Core/Util.fs @@ -531,6 +531,10 @@ module Functional = let cons (xs: 'a list) (x: 'a) = x::xs + // ** ($) + + let ($) = (<|) /// $ rules! + // * Tuple module Tuple = diff --git a/src/Disco/Disco/Raft/LogEntry.fs b/src/Disco/Disco/Raft/LogEntry.fs index 6f26ae21..64982694 100644 --- a/src/Disco/Disco/Raft/LogEntry.fs +++ b/src/Disco/Disco/Raft/LogEntry.fs @@ -625,10 +625,6 @@ module LogEntry = open Aether - // ** ($) - - let private ($) = (<|) - // ** getters let id = Optic.get LogEntry.Id_ @@ -641,6 +637,10 @@ module LogEntry = let setIndex = Optic.set LogEntry.Index_ let setTerm = Optic.set LogEntry.Term_ + // ** create + + let create index term entry = LogEntry(DiscoId.Create(),index,term,entry,None) + // ** isConfigChange // _ ____ __ _ ____ _ diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index c3a1c557..93013ead 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -56,44 +56,32 @@ module rec Raft = // ** appendEntry - let private appendEntry (log: LogEntry) = + let appendEntry (entry: LogEntry) = raft { - let! state = get + let! current = log () // create the new log by appending - let newlog = Log.append log state.Log + let newlog = Log.append entry current do! setLog newlog // get back the entries just added // (with correct monotonic idx's) - return Log.getn (LogEntry.depth log) newlog - } + let result = Log.getn (LogEntry.depth entry) newlog - // ** appendEntryM - - let appendEntryM (log: LogEntry) = - raft { - let! result = appendEntry log match result with | Some entries -> do! persistLog entries | _ -> () + return result } - // ** createEntryM - - // _ _____ _ - // ___ _ __ ___ __ _| |_ ___| ____|_ __ | |_ _ __ _ _ - // / __| '__/ _ \/ _` | __/ _ \ _| | '_ \| __| '__| | | | - // | (__| | | __/ (_| | || __/ |___| | | | |_| | | |_| | - // \___|_| \___|\__,_|\__\___|_____|_| |_|\__|_| \__, | - // |___/ + // ** createEntry - let createEntryM (entry: StateMachine) = + let createEntry (entry: StateMachine) = raft { - let! state = get - let log = LogEntry(DiscoId.Create(),index 0,state.CurrentTerm,entry,None) - return! appendEntryM log + let! term = currentTerm () + let log = LogEntry.create 0 term entry + return! appendEntry log } // ** updateLogEntries @@ -108,26 +96,25 @@ module rec Raft = /// Delete a log entry at the index specified. Returns the original value if /// the record is not found. - let private removeEntry idx (cbs: IRaftCallbacks) state = - match Log.at idx state.Log with - | Some log -> - match LogEntry.pop log with - | Some newlog -> - match Log.until idx state.Log with - | Some items -> LogEntry.iter (fun _ entry -> cbs.DeleteLog entry) items - | _ -> () - updateLogEntries newlog state - | _ -> - cbs.DeleteLog log - RaftState.setLog Log.empty state - | _ -> state - - // ** removeEntryM - let removeEntryM idx = + let removeEntry idx = raft { let! env = read - do! removeEntry idx env |> modify + let! current = log () + match Log.at idx current with + | Some log -> + match LogEntry.pop log with + | Some newlog -> + // fire delete log callback for all removed items + match Log.until idx current with + | Some items -> LogEntry.iter (fun _ entry -> do env.DeleteLog entry) items + | _ -> () + // save the modified log to state + do! modify (updateLogEntries newlog) + | _ -> + do env.DeleteLog log + do! modify (RaftState.setLog Log.empty) + | _ -> () } // ** makeResponse @@ -208,11 +195,11 @@ module rec Raft = | Some entry -> if LogEntry.term entry <> LogEntry.term remote then // removes entry at idx (and all following entries) - do! removeEntryM idx + do! removeEntry idx | _ -> () | _ -> if Option.isSome local then - do! removeEntryM idx + do! removeEntry idx } // ** applyRemainder @@ -221,7 +208,7 @@ module rec Raft = raft { match msg.Entries with | Some entries -> - let! result = appendEntryM entries + let! result = appendEntry entries match result with | Some log -> let! fst = currentTerm () >>= firstIndex @@ -287,7 +274,7 @@ module rec Raft = msg.PrevLogIdx |> error "receiveAppendEntries" let response = { resp with CurrentIndex = msg.PrevLogIdx - index 1 } - do! removeEntryM msg.PrevLogIdx + do! removeEntry msg.PrevLogIdx return response else return! processEntry nid msg resp @@ -528,11 +515,11 @@ module rec Raft = | _ -> return () } - // ** sendAllAppendEntriesM + // ** sendAllAppendEntries - let sendAllAppendEntriesM () = + let sendAllAppendEntries () = raft { - let! self = ``member``() + let! self = self () let! peers = logicalPeers () for KeyValue(id,peer) in peers do @@ -621,7 +608,7 @@ module rec Raft = let private handleLog entry resp = raft { - let! result = appendEntryM entry + let! result = appendEntry entry match result with | Some appended -> @@ -1060,11 +1047,12 @@ module rec Raft = ///////////////////////////////////////////////////////////////////////////// let private maybeSetIndex nid nextIdx matchIdx = - let mapper peer = - if Member.isVoting peer && peer.Id <> nid - then { peer with NextIndex = nextIdx; MatchIndex = matchIdx } + updateMembers $ fun peer -> + if Member.isVoting peer && peer.Id <> nid then + peer + |> Member.setNextIndex nextIdx + |> Member.setMatchIndex matchIdx else peer - updateMembers mapper // ** becomeLeader @@ -1077,7 +1065,7 @@ module rec Raft = do! setState Leader do! setLeader (Some state.Member.Id) do! maybeSetIndex state.Member.Id (current + 1) (index 0) - do! sendAllAppendEntriesM () + do! sendAllAppendEntries () } // ** becomeFollower @@ -1259,7 +1247,7 @@ module rec Raft = let requestAllVotes () = raft { - let! self = ``member`` () + let! self = self () let! peers = logicalPeers () do! RaftMonad.info "requestAllVotes" "requesting all votes" for peer in peers do @@ -1484,10 +1472,10 @@ module rec Raft = let log = Configuration(response.Id, index 0, term, mems, None) do! handleLog log response >>= ignoreM else - do! sendAllAppendEntriesM () + do! sendAllAppendEntries () // the regular case is we need to ping our followers so as to not provoke an election elif timedout then - do! sendAllAppendEntriesM () + do! sendAllAppendEntries () | _ -> // have to double check the code here to ensure new elections are really only called when diff --git a/src/Disco/Disco/Raft/RaftMonad.fs b/src/Disco/Disco/Raft/RaftMonad.fs index 6e2b5167..9abcaaab 100644 --- a/src/Disco/Disco/Raft/RaftMonad.fs +++ b/src/Disco/Disco/Raft/RaftMonad.fs @@ -199,29 +199,28 @@ module RaftMonad = let private tag (str: string) = String.Format("Raft.{0}",str) - // ** log + // ** logMsg - let log site level message = + let logMsg site level message = message |> Logger.log level (tag site) |> returnM // ** debug - let debug site str = log site Debug str + let debug site str = logMsg site Debug str // ** info - let info site str = log site Info str + let info site str = logMsg site Info str // ** warn - let warn site str = log site Warn str + let warn site str = logMsg site Warn str // ** error - let error site str = log site Err str - + let error site str = logMsg site Err str // ** currentIndex @@ -283,13 +282,17 @@ module RaftMonad = let getMembers () = zoom RaftState.peers - // ** member + // ** self + + let self () = zoom RaftState.self - let ``member`` () = zoom RaftState.``member`` + // ** setSelf - // ** lastConfigChange + let setSelf self = modify (RaftState.setSelf self) - let lastConfigChange () = zoom RaftState.configChangeEntry + // ** configChangeEntry + + let configChangeEntry () = zoom RaftState.configChangeEntry // ** persistVote @@ -607,11 +610,11 @@ module RaftMonad = // ** lastAppliedIndex - let lastAppliedIndex () = zoom RaftState.lastAppliedIdx + let lastAppliedIndex () = zoom RaftState.lastAppliedIndex // ** setLastAppliedIndex - let setLastAppliedIndex index = modify (RaftState.setLastAppliedIdx index) + let setLastAppliedIndex index = modify (RaftState.setLastAppliedIndex index) // ** lastLogTerm @@ -629,6 +632,24 @@ module RaftMonad = let entriesUntilExcluding idx = zoom (RaftState.entriesUntilExcluding idx) + // ** log + + let log () = zoom RaftState.log + // ** setLog let setLog log = modify (RaftState.setLog log) + + // ** updateMembers + + let updateMembers f = + raft { + let! state = get + let updated, state = RaftState.updateMembers f state + do! put state + if updated then + let! env = read + let! peers = logicalPeers() + for KeyValue(_,peer) in peers do + do env.MemberUpdated peer + } diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index dfc82ff6..aedb9931 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -187,7 +187,7 @@ type RaftState = (fun (rs:RaftState) -> rs.CommitIndex), (fun commitIndex (rs:RaftState) -> { rs with CommitIndex = commitIndex }) - static member LastAppliedIdx_ = + static member LastAppliedIndex_ = (fun (rs:RaftState) -> rs.LastAppliedIdx), (fun lastAppliedIdx (rs:RaftState) -> { rs with LastAppliedIdx = lastAppliedIdx }) @@ -325,7 +325,7 @@ module RaftState = // ** getters - let ``member`` = Optic.get RaftState.Member_ + let self = Optic.get RaftState.Member_ let state = Optic.get RaftState.State_ let currentTerm = Optic.get RaftState.CurrentTerm_ let currentLeader = Optic.get RaftState.CurrentLeader_ @@ -335,7 +335,7 @@ module RaftState = let votedFor = Optic.get RaftState.VotedFor_ let log = Optic.get RaftState.Log_ let commitIndex = Optic.get RaftState.CommitIndex_ - let lastAppliedIdx = Optic.get RaftState.LastAppliedIdx_ + let lastAppliedIndex = Optic.get RaftState.LastAppliedIndex_ let timeoutElapsed = Optic.get RaftState.TimeoutElapsed_ let electionTimeout = Optic.get RaftState.ElectionTimeout_ let requestTimeout = Optic.get RaftState.RequestTimeout_ @@ -344,7 +344,7 @@ module RaftState = // ** setters - let setMember = Optic.set RaftState.Member_ + let setSelf = Optic.set RaftState.Member_ let setState = Optic.set RaftState.State_ let setCurrentTerm = Optic.set RaftState.CurrentTerm_ let setCurrentLeader = Optic.set RaftState.CurrentLeader_ @@ -354,7 +354,7 @@ module RaftState = let setVotedFor = Optic.set RaftState.VotedFor_ let setLog = Optic.set RaftState.Log_ let setCommitIndex = Optic.set RaftState.CommitIndex_ - let setLastAppliedIdx = Optic.set RaftState.LastAppliedIdx_ + let setLastAppliedIndex = Optic.set RaftState.LastAppliedIndex_ let setTimeoutElapsed = Optic.set RaftState.TimeoutElapsed_ let setElectionTimeout = Optic.set RaftState.ElectionTimeout_ let setRequestTimeout = Optic.set RaftState.RequestTimeout_ @@ -506,6 +506,17 @@ module RaftState = | _ -> false, members peersUpdated, setPeers peers state + // ** updateMembers + + let updateMembers (f: RaftMember -> RaftMember) state = + state + |> logicalPeers + |> Map.fold + (fun (current, state') _ mem -> + let updated, state'' = updateMember (f mem) state' + current || updated, state'') + (false, state) + // ** setNextIndex /// Set the nextIndex field on Member corresponding to supplied Id (should it exist, that is). @@ -562,7 +573,7 @@ module RaftState = // ** setVoting - let setVoting (mem : RaftMember) (vote : bool) = + let setVoting (mem: RaftMember) (vote: bool) = mem |> Member.setVotedForMe vote |> updateMember diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index 501ff139..d526e35a 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -124,34 +124,15 @@ module rec RaftServer = // ** getMember - /// ## getMember - /// - /// Return the current mem. - /// - /// ### Signature: - /// - context: RaftServerState - /// - /// Returns: RaftMember - let private getMember (context: RaftServerState) = - context - |> getRaft - |> Raft.getSelf + /// Return the current RaftMember. + + let private getMember = getRaft >> RaftState.self // ** getMemberId - /// ## getMemberId - /// - /// Return the current mem Id. - /// - /// ### Signature: - /// - context: RaftServerState - /// - /// Returns: Id - let private getMemberId (context: RaftServerState) = - context - |> getRaft - |> Raft.getSelf - |> Member.id + /// Return the current RaftMember Id. + + let private getMemberId = getMember >> Member.id // ** updateRaft @@ -412,7 +393,7 @@ module rec RaftServer = /// /// Returns: Either let private addMembers (state: RaftServerState) (mems: RaftMember array) = - if Raft.isLeader state.Raft then + if RaftState.isLeader state.Raft then mems |> Array.map ConfigChange.MemberAdded |> Log.mkConfigChange state.Raft.CurrentTerm @@ -447,14 +428,13 @@ module rec RaftServer = // ** removeMember let private removeMember (state: RaftServerState) (id: MemberId) = - if Raft.isLeader state.Raft then + if RaftState.isLeader state.Raft then string id |> sprintf "attempting to remove members with id %A" |> Logger.debug (tag "removeMember") let potentialChange = - state.Raft - |> Raft.getMember id + RaftState.getMember id state.Raft match potentialChange with | Some mem -> removeMembers state [| mem |] @@ -501,7 +481,7 @@ module rec RaftServer = (cmd: StateMachine) (raw: Request) (agent: RaftAgent) = - if Raft.isLeader state.Raft then // I'm leader, so I try to append command + if RaftState.isLeader state.Raft then // I'm leader, so I try to append command match appendCommand state cmd with | Right (entry, newstate) -> // command was appended, now queue a message and the later entry // response to check its committed status, eventually @@ -519,7 +499,7 @@ module rec RaftServer = |> state.Server.Respond newstate else - match Raft.getLeader state.Raft with // redirect to known leader or fail + match RaftState.getLeader state.Raft with // redirect to known leader or fail | Some mem -> mem |> Redirect @@ -594,7 +574,7 @@ module rec RaftServer = /// /// Returns: Either let private doRedirect (state: RaftServerState) (raw: Request) = - match Raft.getLeader state.Raft with + match RaftState.getLeader state.Raft with | Some mem -> mem |> Redirect @@ -627,7 +607,7 @@ module rec RaftServer = /// Returns: RaftResponse let private processHandshake (state: RaftServerState) (mem: RaftMember) (raw: RawRequest) (agent: RaftAgent) = Tracing.trace (tag "processHandshake") <| fun () -> - if Raft.isLeader state.Raft then + if RaftState.isLeader state.Raft then match addMembers state [| mem |] with | Right (entry, newstate) -> let response = // response to check its committed status, eventually @@ -656,7 +636,7 @@ module rec RaftServer = let private processHandwaive (state: RaftServerState) (mem: RaftMember) (raw: RawRequest) (agent: RaftAgent) = Tracing.trace (tag "processHandwaive") <| fun () -> - if Raft.isLeader state.Raft then + if RaftState.isLeader state.Raft then match removeMember state mem.Id with | Right (entry, newstate) -> let response = // response to check its committed status, eventually @@ -837,7 +817,7 @@ module rec RaftServer = sprintf "Reached leader: %A Adding to mems." leader.Id |> Logger.info (tag "tryJoinCluster") - do! Raft.addMemberM leader + do! addMember leader do! Raft.becomeFollower () | Left err -> @@ -937,10 +917,10 @@ module rec RaftServer = do! Raft.becomeFollower () - let! peers = Raft.getMembersM () + let! peers = getMembers () for kv in peers do - do! Raft.removeMemberM kv.Value + do! Raft.removeMember kv.Value } |> runRaft state.Raft state.Callbacks @@ -950,24 +930,17 @@ module rec RaftServer = let private forceElection (state: RaftServerState) = raft { - let! timeout = Raft.electionTimeoutM () - do! Raft.setTimeoutElapsedM timeout + let! timeout = electionTimeout () + do! setTimeoutElapsed timeout do! Raft.periodic timeout } |> runRaft state.Raft state.Callbacks // ** startPeriodic - /// ## startPeriodic - /// /// Starts an asynchronous loop to run Raft's `periodic` function. Returns a token, with which the /// loop can be cancelled at a later time. - /// - /// ### Signature: - /// - timeout: interval at which the loop runs - /// - appState: current RaftServerState TVar - /// - /// Returns: CancellationTokenSource + let private startPeriodic (interval: int) (agent: RaftAgent) : IDisposable = Periodically.run interval <| fun () -> agent.Post(Msg.Periodic) @@ -1273,13 +1246,11 @@ module rec RaftServer = // ** handleClientState - let private handleClientState (state: RaftServerState) - (id: MemberId) - raftState = + let private handleClientState (state: RaftServerState) (id: MemberId) raftState = raft { - let! peer = Raft.getMemberM id + let! peer = RaftMonad.getMember id match peer with - | Some mem -> do! Raft.updateMemberM { mem with Status = raftState } + | Some mem -> do! RaftMonad.updateMember { mem with Status = raftState } | None -> () } |> runRaft state.Raft state.Callbacks @@ -1338,16 +1309,16 @@ module rec RaftServer = let rand = System.Random() raft { let term = term 0 - do! Raft.setTermM term - let! num = Raft.numMembersM () + do! setCurrentTerm term + let! num = RaftMonad.numMembers () if num = 1 then - do! Raft.setTimeoutElapsedM 0 + do! RaftMonad.setTimeoutElapsed 0 do! Raft.becomeLeader () else // set the timeout to something random, to prevent split votes let timeout = 1 * rand.Next(0, int state.ElectionTimeout) - do! Raft.setTimeoutElapsedM timeout + do! RaftMonad.setTimeoutElapsed timeout do! Raft.becomeFollower () } |> runRaft state callbacks @@ -1552,13 +1523,13 @@ module rec RaftServer = with get () = store.State.Connections member self.IsLeader - with get () = Raft.isLeader store.State.Raft + with get () = RaftState.isLeader store.State.Raft member self.RaftState with get () = store.State.Raft.State member self.Leader - with get () = Raft.getLeader store.State.Raft + with get () = RaftState.getLeader store.State.Raft member self.Dispose () = if not (Service.isDisposed store.State.Status) then diff --git a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs index 7a789b36..03136d79 100644 --- a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs +++ b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs @@ -30,9 +30,9 @@ module AppendEntries = let peer = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM peer - do! expectM "Should have no current leader" None Raft.currentLeader - do! Raft.setTermM (term 5) + do! addMember peer + do! expectM "Should have no current leader" None RaftState.currentLeader + do! setCurrentTerm 5 let msg = { Term = term 1 @@ -43,7 +43,7 @@ module AppendEntries = let! result = Raft.receiveAppendEntries (Some peer.Id) msg expect "Request should have failed" true AppendResponse.failed result - do! expectM "Should still not have a leader" None Raft.currentLeader + do! expectM "Should still not have a leader" None RaftState.currentLeader } |> runWithDefaults |> ignore @@ -51,7 +51,7 @@ module AppendEntries = let follower_recv_appendentries_does_not_need_mem = testCase "follower recv appendentries does not need mem" <| fun _ -> raft { - do! Raft.addMemberM (Member.create (DiscoId.Create())) + do! addMember (Member.create (DiscoId.Create())) let msg = { Term = term 1 ; PrevLogIdx = index 0 @@ -70,9 +70,9 @@ module AppendEntries = raft { let peer = Member.create (DiscoId.Create()) - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) - do! expectM "Should not have a leader" None Raft.currentLeader + do! addMember peer + do! setCurrentTerm 1 + do! expectM "Should not have a leader" None RaftState.currentLeader let msg = { Term = term 2 PrevLogIdx = index 0 @@ -86,8 +86,8 @@ module AppendEntries = expect "Should be successful" true AppendResponse.succeeded response expect "Response should have term 2" (term 2) AppendResponse.term response - do! expectM "Raft should have term 2" (term 2) Raft.currentTerm - do! expectM "should have leader" (Some peer.Id) Raft.currentLeader + do! expectM "Raft should have term 2" (term 2) RaftState.currentTerm + do! expectM "should have leader" (Some peer.Id) RaftState.currentLeader } |> runWithDefaults |> ignore @@ -96,9 +96,9 @@ module AppendEntries = testCase "follower recv appendentries does not log if no entries are specified" <| fun _ -> raft { let peer = Member.create (DiscoId.Create()) - do! Raft.addMemberM peer - do! Raft.setStateM Follower - do! expectM "Should have 0 log entries" 0 Raft.numLogs + do! addMember peer + do! setState Follower + do! expectM "Should have 0 log entries" 0 RaftState.numLogs let msg = { Term = term 1 ; PrevLogIdx = index 1 @@ -107,7 +107,7 @@ module AppendEntries = ; Entries = None } let! response = Raft.receiveAppendEntries (Some peer.Id) msg - do! expectM "Should still have 0 log entries" 0 Raft.numLogs + do! expectM "Should still have 0 log entries" 0 RaftState.numLogs } |> runWithDefaults |> ignore @@ -116,9 +116,9 @@ module AppendEntries = testCase "follower recv appendentries increases log" <| fun _ -> raft { let peer = Member.create (DiscoId.Create()) - do! Raft.addMemberM peer - do! Raft.setStateM Follower - do! expectM "Should log count 0" 0 Raft.numLogs + do! addMember peer + do! setState Follower + do! expectM "Should log count 0" 0 RaftState.numLogs let msg = { Term = term 3 ; PrevLogIdx = index 0 @@ -128,8 +128,8 @@ module AppendEntries = } let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should be a success" true AppendResponse.succeeded response - do! expectM "Should have log count 1" 1 Raft.numLogs - let! entry = Raft.getEntryAtM (index 1) + do! expectM "Should have log count 1" 1 RaftState.numLogs + let! entry = entryAt (index 1) expect "Should have term 2" (term 2) (Option.get >> LogEntry.term) entry } |> runWithDefaults @@ -139,8 +139,8 @@ module AppendEntries = testCase "follower recv appendentries reply false if doesnt have log at prev log idx which matches prev log term" <| fun _ -> raft { let peer = Member.create (DiscoId.Create()) - do! Raft.addMemberM peer - do! Raft.setTermM (term 2) + do! addMember peer + do! setCurrentTerm 2 let msg = { Term = term 2 @@ -158,7 +158,7 @@ module AppendEntries = let _entries_for_conflict_tests (payload : StateMachine array) = raft { for t in payload do - do! Raft.createEntryM t >>= ignoreM + do! Raft.createEntry t >>= ignoreM } let follower_recv_appendentries_delete_entries_if_conflict_with_new_entries = @@ -168,7 +168,7 @@ module AppendEntries = raft { let getNth n = - Raft.getEntryAt n >> + RaftState.entryAt n >> Option.get >> LogEntry.data >> Option.get @@ -183,8 +183,8 @@ module AppendEntries = let peer = Member.create (DiscoId.Create()) - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) + do! addMember peer + do! setCurrentTerm 1 do! _entries_for_conflict_tests data // add some log entries @@ -205,7 +205,7 @@ module AppendEntries = let! response = Raft.receiveAppendEntries (Some peer.Id) newer expect "Should have succeeded" true AppendResponse.succeeded response - do! expectM "Should have 2 entries" 2 Raft.numLogs + do! expectM "Should have 2 entries" 2 RaftState.numLogs do! expectM "First should have 'one' value" (data.[0]) (getNth (index 1)) do! expectM "second should have 'four' value" (addCue) (getNth (index 2)) @@ -217,7 +217,7 @@ module AppendEntries = testCase "follower recv appendentries delete entries if current idx greater than prev log idx" <| fun _ -> let getNth n = raft { - let! entry = Raft.getEntryAtM n + let! entry = entryAt n return entry |> Option.get |> LogEntry.data } @@ -234,8 +234,8 @@ module AppendEntries = let cbs = Callbacks.Create (ref defSM) :> IRaftCallbacks raft { - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) + do! addMember peer + do! setCurrentTerm 1 do! _entries_for_conflict_tests data // add some log entries let newer = @@ -248,7 +248,7 @@ module AppendEntries = let! response = Raft.receiveAppendEntries (Some peer.Id) newer expect "Should have succeeded" true AppendResponse.succeeded response - do! expectM "Should have 1 log entry" 1 Raft.numLogs + do! expectM "Should have 1 log entry" 1 RaftState.numLogs let! entry = getNth (index 1) expect "Should have correct value" (Some data.[0]) id entry } @@ -264,8 +264,8 @@ module AppendEntries = Some <| LogEntry((DiscoId.Create()), index 2, term 1, DataSnapshot (State.Empty), None)) raft { - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) + do! addMember peer + do! setCurrentTerm 1 let newer = { Term = term 1 @@ -277,7 +277,7 @@ module AppendEntries = let! response = Raft.receiveAppendEntries (Some peer.Id) newer expect "Should be a success" true AppendResponse.succeeded response - do! expectM "Should have 2 logs" 2 Raft.numLogs + do! expectM "Should have 2 logs" 2 RaftState.numLogs } |> runWithDefaults |> ignore @@ -301,21 +301,21 @@ module AppendEntries = let cbs = Callbacks.Create (ref defSM) :> IRaftCallbacks raft { - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) + do! addMember peer + do! setCurrentTerm 1 let! response = Raft.receiveAppendEntries (Some peer.Id) next expect "Should be a success" true AppendResponse.succeeded response let! response = Raft.receiveAppendEntries (Some peer.Id) next expect "Should still be a success" true AppendResponse.succeeded response - do! expectM "Should have log count 1" 1 Raft.numLogs + do! expectM "Should have log count 1" 1 RaftState.numLogs let log'' = Log.append (Log.make (term 1) (DataSnapshot (State.Empty))) log let msg = { next with Entries = log''.Data } let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should be a success" true AppendResponse.succeeded response - do! expectM "Should have 2 entries now" 2 Raft.numLogs + do! expectM "Should have 2 entries now" 2 RaftState.numLogs } |> runWithRaft raft' cbs |> ignore @@ -339,11 +339,11 @@ module AppendEntries = } raft { - do! Raft.addMemberM peer + do! addMember peer let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should have been successful" true AppendResponse.succeeded response expect "Should have correct CurrentIndex" (index 4) AppendResponse.currentIndex response - do! expectM "Should have commit index 4" (index 4) Raft.commitIndex + do! expectM "Should have commit index 4" (index 4) RaftState.commitIndex } |> runWithDefaults |> ignore @@ -367,11 +367,11 @@ module AppendEntries = } raft { - do! Raft.addMemberM peer + do! addMember peer let! response1 = Raft.receiveAppendEntries (Some peer.Id) msg let! response2 = Raft.receiveAppendEntries (Some peer.Id) { msg with PrevLogIdx = index 3; LeaderCommit = index 3; Entries = None } expect "Should have been successful" true AppendResponse.succeeded response2 - do! expectM "Should have commit index 3" (index 3) Raft.commitIndex + do! expectM "Should have commit index 3" (index 3) RaftState.commitIndex } |> runWithDefaults |> ignore @@ -392,15 +392,15 @@ module AppendEntries = } raft { - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) - do! Raft.appendEntryM (log (DiscoId.Create())) >>= ignoreM + do! addMember peer + do! setCurrentTerm 1 + do! Raft.appendEntry (log (DiscoId.Create())) >>= ignoreM let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should not be successful" true AppendResponse.failed response expect "Should have current index 1" (index 1) AppendResponse.currentIndex response - do! Raft.appendEntryM (log (DiscoId.Create())) >>= ignoreM + do! Raft.appendEntry (log (DiscoId.Create())) >>= ignoreM let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should not be successful" true AppendResponse.failed response expect "Should have current index 2" (index 2) AppendResponse.currentIndex response @@ -421,11 +421,11 @@ module AppendEntries = } raft { - do! Raft.setElectionTimeoutM 1000 - do! Raft.addMemberM peer + do! setElectionTimeout 1000 + do! addMember peer do! Raft.periodic 900 let! response = Raft.receiveAppendEntries (Some peer.Id) msg - do! expectM "Should have timeout elapsed 0" 0 Raft.timeoutElapsed + do! expectM "Should have timeout elapsed 0" 0 RaftState.timeoutElapsed } |> runWithDefaults |> ignore diff --git a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs index 404d137c..fbaf7fdd 100644 --- a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs +++ b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs @@ -43,11 +43,11 @@ module JointConsensus = raft { do! Raft.becomeLeader () do! Raft.receiveEntry log >>= ignoreM - let! me = Raft.selfM() + let! me = self () - do! expectM "Should have 1 mems" 1 Raft.numMembers + do! expectM "Should have 1 mems" 1 RaftState.numMembers do! Raft.periodic 10 - do! expectM "Should have 2 mems" 2 Raft.numMembers + do! expectM "Should have 2 mems" 2 RaftState.numMembers do! expectM "Should have correct mems" (List.sort [me.Id; mem2.Id]) getstuff } |> runWithDefaults @@ -75,27 +75,27 @@ module JointConsensus = FirstIndex = index 1 } raft { - do! Raft.setElectionTimeoutM 1000 + do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) Raft.commitIndex - do! expectM "Should have mem count of one" 1 Raft.numMembers - let! term = Raft.currentTermM () + do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex + do! expectM "Should have mem count of one" 1 RaftState.numMembers + let! term = currentTerm () // Add the first entry - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx // otherwise we get a StaleResponse error let! one = Raft.receiveEntry (Log.make term defSM) - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id // Add another entry - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx let! two = Raft.receiveEntry (Log.make term defSM) - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id @@ -106,11 +106,11 @@ module JointConsensus = do! expectM "'two' should be committed" true (konst r2) // enter the 2-phase commit for configuration change - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx let! three = Raft.receiveEntry (mkjc term) - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id @@ -118,21 +118,21 @@ module JointConsensus = do! expectM "'three' should be committed" true (konst r3) // call periodic to apply join consensus entry - do! expectM "Should not be in joint-consensus yet" false Raft.inJointConsensus - let! idx = Raft.currentIndexM () + do! expectM "Should not be in joint-consensus yet" false RaftState.inJointConsensus + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 - do! expectM "Should be in joint-consensus now" true Raft.inJointConsensus + do! expectM "Should be in joint-consensus now" true RaftState.inJointConsensus - do! expectM "Should be non-voting mem for start" false (Raft.getMember nid2 >> Option.get >> Member.isVoting) - do! expectM "Should be in joining state for start" Joining (Raft.getMember nid2 >> Option.get >> Member.status) + do! expectM "Should be non-voting mem for start" false (RaftState.getMember nid2 >> Option.get >> Member.isVoting) + do! expectM "Should be in joining state for start" Joining (RaftState.getMember nid2 >> Option.get >> Member.status) // add another regular entry - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx let! four = Raft.receiveEntry (Log.make term defSM) - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id @@ -140,32 +140,32 @@ module JointConsensus = do! expectM "'four' should not be committed" false (konst r4) // and another - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx let! five = Raft.receiveEntry (Log.make term defSM) - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id let! r5 = Raft.responseCommitted five do! expectM "'five' should not be committed" false (konst r5) - do! expectM "Should still be in joint-consensus" true Raft.inJointConsensus + do! expectM "Should still be in joint-consensus" true RaftState.inJointConsensus // call periodic to ensure these are applied - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx + index 1 do! Raft.periodic 1000 - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id // when the server notices that all mems are up-to-date it will atomatically append // a Configuration entry to exit the JointConsensus - do! expectM "Should not be in joint-consensus anymore" false Raft.inJointConsensus - do! expectM "Should have nothing in ConfigChange" None Raft.lastConfigChange + do! expectM "Should not be in joint-consensus anymore" false RaftState.inJointConsensus + do! expectM "Should have nothing in ConfigChange" None RaftState.configChangeEntry let! r6 = Raft.responseCommitted three let! r7 = Raft.responseCommitted four @@ -205,17 +205,17 @@ module JointConsensus = raft { let me = snd mems.[0] - do! Raft.setSelfM me - do! Raft.setPeersM (mems |> Map.ofArray) + do! setSelf me + do! setPeers (mems |> Map.ofArray) // same as calling becomeCandidate but not circumventing requestAllVotes - do! Raft.setTermM !trm - do! Raft.resetVotesM () - do! Raft.voteForMyself () - do! Raft.setLeaderM None - do! Raft.setStateM Candidate + do! setCurrentTerm !trm + do! resetVotes () + do! voteForMyself () + do! setLeader None + do! setState Candidate - do! expectM "Should have $n mems" n Raft.numMembers + do! expectM "Should have $n mems" n RaftState.numMembers // _ _ _ _ // ___| | ___ ___| |_(_) ___ _ __ / | @@ -225,16 +225,16 @@ module JointConsensus = // // with the full cluster of 10 mems in total - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - do! expectM "Should use the regular configuration" false Raft.inJointConsensus + do! expectM "Should use the regular configuration" false RaftState.inJointConsensus // we need only 5 votes coming in (plus our own) to make a majority for nid in 1 .. (n / 2) do do! Raft.receiveVoteResponse (fst mems.[int nid]) { vote with Term = !trm } - do! expectM "Should be leader in base configuration" Leader Raft.getState + do! expectM "Should be leader in base configuration" Leader RaftState.state // __ _ // _ __ _____ __ ___ ___ _ __ / _(_) __ _ @@ -242,7 +242,7 @@ module JointConsensus = // | | | | __/\ V V / | (_| (_) | | | | _| | (_| | // |_| |_|\___| \_/\_/ \___\___/|_| |_|_| |_|\__, | // |___/ - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) // we establish a new cluster configuration *without* the last 5 mems let entry = @@ -252,14 +252,14 @@ module JointConsensus = |> Log.calculateChanges peers |> Log.mkConfigChange (term 1) - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx let! response = Raft.receiveEntry entry for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 @@ -273,10 +273,10 @@ module JointConsensus = for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "(1) Should still have correct mem count for new configuration" (n / 2) Raft.numPeers - do! expectM "(1) Should still have correct logical mem count" n Raft.numLogicalPeers - do! expectM "(1) Should still have correct mem count for old configuration" n Raft.numOldPeers - do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) + do! expectM "(1) Should still have correct mem count for new configuration" (n / 2) RaftState.numMembers + do! expectM "(1) Should still have correct logical mem count" n RaftState.numLogicalPeers + do! expectM "(1) Should still have correct mem count for old configuration" n RaftState.numOldMembers + do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (RaftState.configChangeEntry >> Option.get >> LogEntry.id) // _ _ _ ____ // ___| | ___ ___| |_(_) ___ _ __ |___ \ @@ -287,13 +287,13 @@ module JointConsensus = // now in joint consensus state, with 2 configurations (old and new) // same as calling becomeCandidate but not circumventing requestAllVotes - do! Raft.setTermM (!trm + term 1) - do! Raft.resetVotesM () - do! Raft.voteForMyself () - do! Raft.setLeaderM None - do! Raft.setStateM Candidate + do! setCurrentTerm (!trm + 1) + do! resetVotes () + do! voteForMyself () + do! setLeader None + do! setState Candidate - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t // testing with the new configuration (the mems with the lower id values) @@ -303,7 +303,7 @@ module JointConsensus = let nid = fst <| mems.[int idx] do! Raft.receiveVoteResponse nid { vote with Term = !trm } - do! expectM "Should be leader in joint consensus with votes from the new configuration" Leader Raft.getState + do! expectM "Should be leader in joint consensus with votes from the new configuration" Leader RaftState.state // _ _ _ _____ // ___| | ___ ___| |_(_) ___ _ __ |___ / @@ -314,13 +314,13 @@ module JointConsensus = // still in joint consensus state // same as calling becomeCandidate but not circumventing requestAllVotes - do! Raft.setTermM (!trm + term 1) - do! Raft.resetVotesM () - do! Raft.voteForMyself () - do! Raft.setLeaderM None - do! Raft.setStateM Candidate + do! setCurrentTerm (!trm + 1) + do! resetVotes () + do! voteForMyself () + do! setLeader None + do! setState Candidate - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t // testing with the old configuration (the mems with the higher id @@ -329,7 +329,7 @@ module JointConsensus = let nid = fst mems.[int idx] do! Raft.receiveVoteResponse nid { vote with Term = !trm } - do! expectM "Should be leader in joint consensus with votes from the old configuration" Leader Raft.getState + do! expectM "Should be leader in joint consensus with votes from the old configuration" Leader RaftState.state // __ _ _ _ // _ __ ___ ___ ___ _ __ / _(_) __ _ _ _ _ __ __ _| |_(_) ___ _ __ @@ -339,30 +339,30 @@ module JointConsensus = // is now complete! |___/ // appends Configuration entry - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id // when configuration entry is considered committed, joint-consensus is over - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id do! Raft.periodic 1000 - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should only have half the mems" (n / 2) Raft.numMembers - do! expectM "Should have None as ConfigChange" None Raft.lastConfigChange + do! expectM "Should only have half the mems" (n / 2) RaftState.numMembers + do! expectM "Should have None as ConfigChange" None RaftState.configChangeEntry // _ _ _ _ _ // ___| | ___ ___| |_(_) ___ _ __ | || | @@ -373,19 +373,19 @@ module JointConsensus = // with the new configuration only (should not work with mems in old config anymore) // same as calling becomeCandidate but not circumventing requestAllVotes - do! Raft.setTermM (!trm + term 1) - do! Raft.resetVotesM () - do! Raft.voteForMyself () - do! Raft.setLeaderM None - do! Raft.setStateM Candidate + do! setCurrentTerm (!trm + 1) + do! resetVotes () + do! voteForMyself () + do! setLeader None + do! setState Candidate - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t for nid in 1 .. ((n / 2) / 2) do do! Raft.receiveVoteResponse (fst mems.[int nid]) { vote with Term = !trm } - do! expectM "Should be leader in election with regular configuration" Leader Raft.getState + do! expectM "Should be leader in election with regular configuration" Leader RaftState.state // _ _ _ // __ _ __| | __| | _ __ ___ __| | ___ ___ @@ -393,7 +393,7 @@ module JointConsensus = // | (_| | (_| | (_| | | | | | (_) | (_| | __/\__ \ // \__,_|\__,_|\__,_| |_| |_|\___/ \__,_|\___||___/ - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) // we establish a new cluster configuration with 5 new mems let entry = @@ -402,14 +402,14 @@ module JointConsensus = |> Log.calculateChanges peers |> Log.mkConfigChange (term 1) - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx let! response = Raft.receiveEntry entry for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 @@ -420,10 +420,10 @@ module JointConsensus = for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "(2) Should still have correct mem count for new configuration 2" n Raft.numPeers - do! expectM "(2) Should still have correct logical mem count 2" n Raft.numLogicalPeers - do! expectM "(2) Should still have correct mem count for old configuration 2" (n / 2) Raft.numOldPeers - do! expectM "(2) Should have JointConsensus entry as ConfigChange 2" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) + do! expectM "(2) Should still have correct mem count for new configuration 2" n RaftState.numMembers + do! expectM "(2) Should still have correct logical mem count 2" n RaftState.numLogicalPeers + do! expectM "(2) Should still have correct mem count for old configuration 2" (n / 2) RaftState.numOldMembers + do! expectM "(2) Should have JointConsensus entry as ConfigChange 2" (LogEntry.id entry) (RaftState.configChangeEntry >> Option.get >> LogEntry.id) // _ _ _ ____ // ___| | ___ ___| |_(_) ___ _ __ | ___| @@ -432,20 +432,20 @@ module JointConsensus = // \___|_|\___|\___|\__|_|\___/|_| |_| |____/ // same as calling becomeCandidate but not circumventing requestAllVotes - do! Raft.setTermM (!trm + term 1) - do! Raft.resetVotesM () - do! Raft.voteForMyself () - do! Raft.setLeaderM None - do! Raft.setStateM Candidate + do! setCurrentTerm (!trm + 1) + do! resetVotes () + do! voteForMyself () + do! setLeader None + do! setState Candidate - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t // should become candidate with the old configuration of 5 mems only for nid in 1 .. ((n / 2) / 2) do do! Raft.receiveVoteResponse (fst mems.[int nid]) { vote with Term = !trm } - do! expectM "Should be leader in election in joint consensus with old configuration" Leader Raft.getState + do! expectM "Should be leader in election in joint consensus with old configuration" Leader RaftState.state // _ _ _ __ // ___| | ___ ___| |_(_) ___ _ __ / /_ @@ -454,28 +454,28 @@ module JointConsensus = // \___|_|\___|\___|\__|_|\___/|_| |_| \___/ // same as calling becomeCandidate but not circumventing requestAllVotes - do! Raft.setTermM (!trm + term 1) - do! Raft.resetVotesM () - do! Raft.voteForMyself () - do! Raft.setLeaderM None - do! Raft.setStateM Candidate + do! setCurrentTerm (!trm + 1) + do! resetVotes () + do! voteForMyself () + do! setLeader None + do! setState Candidate - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t // should become candidate with the new configuration of 10 mems also for id in (n / 2) .. (n - 1) do let nid = fst mems.[int id] - let! result = Raft.getMemberM nid + let! result = getMember nid match result with | Some mem -> // the mems are not able to vote at first, because they will need // to be up to date to do that - do! Raft.updateMemberM { mem with Status = Running; Voting = true } + do! updateMember { mem with Status = Running; Voting = true } do! Raft.receiveVoteResponse nid { vote with Term = !trm } | _ -> failwith "Member not found. :(" - do! expectM "Should be leader in election in joint consensus with new configuration" Leader Raft.getState + do! expectM "Should be leader in election in joint consensus with new configuration" Leader RaftState.state // __ _ _ _ // _ __ ___ ___ ___ _ __ / _(_) __ _ _ _ _ __ __ _| |_(_) ___ _ __ @@ -485,18 +485,18 @@ module JointConsensus = // is now complete. |___/ // append Configuration and wait for it to be committed - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id // make sure Configuration is committed - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 for peer in peers do @@ -506,8 +506,8 @@ module JointConsensus = for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should have all the mems" n Raft.numMembers - do! expectM "Should have None as ConfigChange" None Raft.lastConfigChange + do! expectM "Should have all the mems" n RaftState.numMembers + do! expectM "Should have None as ConfigChange" None RaftState.configChangeEntry } |> runWithCBS cbs |> noError @@ -537,19 +537,19 @@ module JointConsensus = raft { let self = snd mems.[0] // - do! Raft.setSelfM self + do! setSelf self - do! Raft.setPeersM (mems |> Map.ofArray) + do! setPeers (mems |> Map.ofArray) // same as calling becomeCandidate, but w/o the IO - do! Raft.setTermM !trm - do! Raft.resetVotesM () - do! Raft.voteForMyself () - do! Raft.setLeaderM None - do! Raft.setStateM Candidate + do! setCurrentTerm !trm + do! resetVotes () + do! voteForMyself () + do! setLeader None + do! setState Candidate - do! expectM "Should have be candidate" Candidate Raft.getState - do! expectM "Should have $n mems" n Raft.numMembers + do! expectM "Should have be candidate" Candidate RaftState.state + do! expectM "Should have $n mems" n RaftState.numMembers // _ _ _ _ // ___| | ___ ___| |_(_) ___ _ __ / | @@ -558,16 +558,16 @@ module JointConsensus = // \___|_|\___|\___|\__|_|\___/|_| |_| |_| // // with the full cluster of 10 mems in total - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - do! expectM "Should use the regular configuration" false Raft.inJointConsensus + do! expectM "Should use the regular configuration" false RaftState.inJointConsensus // we need only 5 votes coming in (plus our own) to make a majority for nid in 1 .. (n / 2) do do! Raft.receiveVoteResponse (fst mems.[int nid]) { vote with Term = !trm } - do! expectM "Should be leader in base configuration" Leader Raft.getState + do! expectM "Should be leader in base configuration" Leader RaftState.state // __ _ // _ __ _____ __ ___ ___ _ __ / _(_) __ _ @@ -575,10 +575,10 @@ module JointConsensus = // | | | | __/\ V V / | (_| (_) | | | | _| | (_| | // |_| |_|\___| \_/\_/ \___\___/|_| |_|_| |_|\__, | // |___/ - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) // we establish a new cluster configuration *without* the last 5 mems let entry = @@ -592,7 +592,7 @@ module JointConsensus = for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 @@ -603,11 +603,11 @@ module JointConsensus = for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should still have correct mem count for new configuration" (n / 2) Raft.numPeers - do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers - do! expectM "Should still have correct mem count for old configuration" n Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) - do! expectM "Should be found in joint consensus configuration myself" true (Raft.getMember self.Id >> Option.isSome) + do! expectM "Should still have correct mem count for new configuration" (n / 2) RaftState.numMembers + do! expectM "Should still have correct logical mem count" n RaftState.numLogicalPeers + do! expectM "Should still have correct mem count for old configuration" n RaftState.numOldMembers + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (RaftState.configChangeEntry >> Option.get >> LogEntry.id) + do! expectM "Should be found in joint consensus configuration myself" true (RaftState.getMember self.Id >> Option.isSome) // __ _ _ _ // _ __ ___ ___ ___ _ __ / _(_) __ _ _ _ _ __ __ _| |_(_) ___ _ __ @@ -617,30 +617,30 @@ module JointConsensus = // is now complete! |___/ // appends a Configuration entry - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1001 for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id // finalizes the joint-consensus mode - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1001 for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id do! Raft.periodic 1001 - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should only have half one mem (myself)" 1 Raft.numMembers - do! expectM "Should have None as ConfigChange" None Raft.lastConfigChange + do! expectM "Should only have half one mem (myself)" 1 RaftState.numMembers + do! expectM "Should have None as ConfigChange" None RaftState.configChangeEntry } |> runWithCBS cbs |> noError @@ -667,13 +667,13 @@ module JointConsensus = |> Map.ofArray raft { - let! self = Raft.getSelfM () + let! self = self () do! Raft.becomeLeader () // increases term! - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - do! expectM "Should be Leader" Leader Raft.getState + do! expectM "Should be Leader" Leader RaftState.state // __ _ // _ __ _____ __ ___ ___ _ __ / _(_) __ _ @@ -682,7 +682,7 @@ module JointConsensus = // |_| |_|\___| \_/\_/ \___\___/|_| |_|_| |_|\__, | // |___/ adding a ton of mems - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) // we establish a new cluster configuration *without* the last 5 mems // with mem id's 5 - 9 @@ -695,19 +695,19 @@ module JointConsensus = let! response = Raft.receiveEntry entry - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 // need to call periodic apply entry (add mems for real) do! Raft.periodic 1000 // appendAllEntries now called - do! expectM "Should still have correct mem count for new configuration" n Raft.numPeers - do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers - do! expectM "Should still have correct mem count for old configuration" 1 Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) - do! expectM "Should be in joint consensus configuration" true Raft.inJointConsensus + do! expectM "Should still have correct mem count for new configuration" n RaftState.numMembers + do! expectM "Should still have correct logical mem count" n RaftState.numLogicalPeers + do! expectM "Should still have correct mem count for old configuration" 1 RaftState.numOldMembers + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (RaftState.configChangeEntry >> Option.get >> LogEntry.id) + do! expectM "Should be in joint consensus configuration" true RaftState.inJointConsensus - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t let! response = Raft.receiveEntry (Log.make !trm defSM) @@ -739,10 +739,10 @@ module JointConsensus = yield (nid, Member.create nid) |] // create mem in the Raft state raft { - let! self = Raft.getSelfM () + let! self = self () do! Raft.becomeLeader () // increases term! - do! expectM "Should have be Leader" Leader Raft.getState + do! expectM "Should have be Leader" Leader RaftState.state // __ _ // _ __ _____ __ ___ ___ _ __ / _(_) __ _ @@ -751,7 +751,7 @@ module JointConsensus = // |_| |_|\___| \_/\_/ \___\___/|_| |_|_| |_|\__, | // |___/ adding a ton of mems - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) // we establish a new cluster configuration *without* the last 5 mems // with mem id's 5 - 9 @@ -766,16 +766,16 @@ module JointConsensus = do! Raft.periodic 1000 - do! expectM "Should still have correct mem count for new configuration" n Raft.numPeers - do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers - do! expectM "Should still have correct mem count for old configuration" 1 Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) - do! expectM "Should be in joint consensus configuration" true Raft.inJointConsensus + do! expectM "Should still have correct mem count for new configuration" n RaftState.numMembers + do! expectM "Should still have correct logical mem count" n RaftState.numLogicalPeers + do! expectM "Should still have correct mem count for old configuration" 1 RaftState.numOldMembers + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (RaftState.configChangeEntry >> Option.get >> LogEntry.id) + do! expectM "Should be in joint consensus configuration" true RaftState.inJointConsensus - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do - do! Raft.updateMemberM { peer with Status = Running; Voting = true } + do! updateMember { peer with Status = Running; Voting = true } do! Raft.startElection () @@ -798,7 +798,7 @@ module JointConsensus = let ci = ref (index 0) let trm = ref (term 1) let count = ref 0 - let init = Raft.create self + let init = RaftState.create self let cbs = { Callbacks.Create (ref defSM) with SendAppendEntries = fun _ _ -> lock lokk <| fun _ -> count := 1 + !count } @@ -811,22 +811,22 @@ module JointConsensus = FirstIndex = index 1 } raft { - do! Raft.setPeersM (mems |> Map.ofArray) - do! Raft.setStateM Candidate - do! Raft.setTermM !trm + do! setPeers (mems |> Map.ofArray) + do! setState Candidate + do! setCurrentTerm !trm do! Raft.becomeLeader () // increases term! - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t - do! expectM "Should have be Leader" Leader Raft.getState - do! expectM "Should have $n mems" n Raft.numMembers + do! expectM "Should have be Leader" Leader RaftState.state + do! expectM "Should have $n mems" n RaftState.numMembers // __ _ // _ __ _____ __ ___ ___ _ __ / _(_) __ _ @@ -835,7 +835,7 @@ module JointConsensus = // |_| |_|\___| \_/\_/ \___\___/|_| |_|_| |_|\__, | // |___/ - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) // we establish a new cluster configuration *without* the last 5 mems // with mem id's 5 - 9 @@ -851,7 +851,7 @@ module JointConsensus = for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! expectM "This count should be correct" ((n - 1) * 2) (!count |> konst) @@ -871,11 +871,11 @@ module JointConsensus = for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "(1) Should still have correct mem count for new configuration" (n / 2) Raft.numPeers - do! expectM "(1) Should still have correct logical mem count" n Raft.numLogicalPeers - do! expectM "(1) Should still have correct mem count for old configuration" n Raft.numOldPeers - do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) - do! expectM "(1) Should be in joint consensus configuration" true Raft.inJointConsensus + do! expectM "(1) Should still have correct mem count for new configuration" (n / 2) RaftState.numMembers + do! expectM "(1) Should still have correct logical mem count" n RaftState.numLogicalPeers + do! expectM "(1) Should still have correct mem count for old configuration" n RaftState.numOldMembers + do! expectM "(1) Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (RaftState.configChangeEntry >> Option.get >> LogEntry.id) + do! expectM "(1) Should be in joint consensus configuration" true RaftState.inJointConsensus let! committed = Raft.responseCommitted response do! expectM "should have been committed" true (konst committed) @@ -887,26 +887,26 @@ module JointConsensus = // |_| \___| \___\___/|_| |_|_| |_|\__, |\__,_|_| \__,_|\__|_|\___/|_| |_| // is now complete! |___/ - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx do! Raft.periodic 1000 for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id // after this periodic, the new cluster configuraion is applied - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) do! Raft.periodic 1000 for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "(2) Should only have half the mems" (n / 2) Raft.numMembers - do! expectM "(2) Should have None as ConfigChange" None Raft.lastConfigChange + do! expectM "(2) Should only have half the mems" (n / 2) RaftState.numMembers + do! expectM "(2) Should have None as ConfigChange" None RaftState.configChangeEntry // _ _ _ // __ _ __| | __| | _ __ ___ __| | ___ ___ @@ -914,7 +914,7 @@ module JointConsensus = // | (_| | (_| | (_| | | | | | (_) | (_| | __/\__ \ // \__,_|\__,_|\__,_| |_| |_|\___/ \__,_|\___||___/ - let! peers = Raft.getMembersM () >>= (Map.toArray >> Array.map snd >> returnM) + let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) // we establish a new cluster configuration with 5 new mems let entry = @@ -929,7 +929,7 @@ module JointConsensus = for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id - let! idx = Raft.currentIndexM () + let! idx = currentIndex () ci := idx let! result = Raft.responseCommitted response @@ -943,10 +943,10 @@ module JointConsensus = for peer in peers do do! makeResponse () |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should still have correct mem count for new configuration" n Raft.numPeers - do! expectM "Should still have correct logical mem count" n Raft.numLogicalPeers - do! expectM "Should still have correct mem count for old configuration" (n / 2) Raft.numOldPeers - do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (Raft.lastConfigChange >> Option.get >> LogEntry.id) + do! expectM "Should still have correct mem count for new configuration" n RaftState.numMembers + do! expectM "Should still have correct logical mem count" n RaftState.numLogicalPeers + do! expectM "Should still have correct mem count for old configuration" (n / 2) RaftState.numOldMembers + do! expectM "Should have JointConsensus entry as ConfigChange" (LogEntry.id entry) (RaftState.configChangeEntry >> Option.get >> LogEntry.id) let! result = Raft.responseCommitted response do! expectM "Should be committed" true (konst result) diff --git a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs index 401e0016..0f93f4ec 100644 --- a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs +++ b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs @@ -161,7 +161,7 @@ module RaftTestUtils = let defaultServer () = DiscoId.Create() |> Member.create - |> Raft.create + |> RaftState.create let runWithCBS cbs action = let raft = defaultServer() diff --git a/src/Disco/Disco/Tests/Raft/Scenarios.fs b/src/Disco/Disco/Tests/Raft/Scenarios.fs index b60ef9bc..721fda23 100644 --- a/src/Disco/Disco/Tests/Raft/Scenarios.fs +++ b/src/Disco/Disco/Tests/Raft/Scenarios.fs @@ -84,7 +84,7 @@ module Scenarios = raft { match msg with | RequestVote(sid,req) -> - let! peer = Raft.getMemberM sid + let! peer = getMember sid if Option.isSome peer then let sender = Option.get peer @@ -92,7 +92,7 @@ module Scenarios = let! response = Raft.receiveVoteRequest sid req let! raft' = get - let receiver = Raft.self raft' + let receiver = RaftState.self raft' if not response.Granted then __logg <| sprintf "(1) result was not granted" let updated = { response with Term = raft'.CurrentTerm } @@ -110,8 +110,8 @@ module Scenarios = if not response.Success then __logg "(2) result was Fail" let! raft' = get - let sender = Raft.self raft' - let! peer = Raft.getMemberM sid + let sender = RaftState.self raft' + let! peer = getMember sid match peer with | Some receiver -> let msg = AppendEntriesResponse(sender.Id, response) @@ -197,9 +197,9 @@ module Scenarios = } :> IRaftCallbacks let raft = - Raft.create peers.[int n] - |> Raft.setElectionTimeout 500 - |> Raft.addMembers (Array.map toPair peers |> Map.ofArray) + RaftState.create peers.[int n] + |> RaftState.setElectionTimeout 500 + |> RaftState.addMembers (Array.map toPair peers |> Map.ofArray) yield (raft,callbacks) |] @@ -209,7 +209,7 @@ module Scenarios = |> fun result -> Array.set servers 0 (result, snd servers.[0]) - expect "Should be candidate now" Candidate Raft.getState (fst servers.[0]) + expect "Should be candidate now" Candidate RaftState.state (fst servers.[0]) for j in 0..19 do Map.fold totalMsgs 0 senders @@ -233,7 +233,7 @@ module Scenarios = |> fun r -> Array.set servers (int n) (r, snd srv) let __fldr result raft = - if Raft.isLeader raft then result + 1 else result + if RaftState.isLeader raft then result + 1 else result let leaders = Array.map fst servers |> Array.fold __fldr 0 Expect.equal leaders 1 "System should have have one leader" diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index ef23f4a3..768c6dd5 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -26,14 +26,14 @@ module ServerTests = testCase "Raft server voted for records who we voted for" <| fun _ -> let id1 = DiscoId.Create() raft { - do! expectM "Should one mem" 1 Raft.numMembers - do! Raft.addMemberM (Member.create id1) - do! expectM "Should two mems" 2 Raft.numMembers + do! expectM "Should one mem" 1 RaftState.numMembers + do! addMember (Member.create id1) + do! expectM "Should two mems" 2 RaftState.numMembers - let! mem = Raft.getMemberM id1 - do! Raft.voteFor mem + let! mem = getMember id1 + do! voteFor mem - do! expectM "Should have voted for last id" id1 (Raft.votedFor >> Option.get) + do! expectM "Should have voted for last id" id1 (RaftState.votedFor >> Option.get) } |> runWithDefaults |> noError @@ -41,13 +41,13 @@ module ServerTests = let server_idx_starts_at_one = testCase "Raft server index should start at 1" <| fun _ -> raft { - do! expectM "Should have default idx" (index 0) Raft.currentIndex - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! expectM "Should have current idx" (index 1) Raft.currentIndex - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! expectM "Should have current idx" (index 2) Raft.currentIndex - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! expectM "Should have current idx" (index 3) Raft.currentIndex + do! expectM "Should have default idx" (0) RaftState.currentIndex + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! expectM "Should have current idx" (1) RaftState.currentIndex + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! expectM "Should have current idx" (2) RaftState.currentIndex + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! expectM "Should have current idx" (3) RaftState.currentIndex } |> runWithDefaults |> noError @@ -55,7 +55,7 @@ module ServerTests = let server_currentterm_defaults_to_zero = testCase "Raft server current Term should default to zero" <| fun _ -> raft { - do! expectM "Should be Zero" (term 0) Raft.currentTerm // + do! expectM "Should be Zero" (term 0) RaftState.currentTerm // } |> runWithDefaults |> noError @@ -63,8 +63,8 @@ module ServerTests = let server_set_currentterm_sets_term = testCase "Raft server set term sets term" <| fun _ -> raft { - do! Raft.setTermM (term 5) - do! expectM "Should be correct term" (term 5) Raft.currentTerm + do! setCurrentTerm 5 + do! expectM "Should be correct term" (term 5) RaftState.currentTerm } |> runWithDefaults |> noError @@ -76,12 +76,12 @@ module ServerTests = raft { // add mem and vote for it - do! Raft.addMemberM mem1 - do! Raft.voteFor (Some mem1) - do! expectM "should be correct id" mem1.Id (Raft.votedFor >> Option.get) - do! Raft.addMemberM mem2 - do! Raft.voteFor (Some mem2) - do! expectM "should be correct id" mem2.Id (Raft.votedFor >> Option.get) + do! addMember mem1 + do! voteFor (Some mem1) + do! expectM "should be correct id" mem1.Id (RaftState.votedFor >> Option.get) + do! addMember mem2 + do! voteFor (Some mem2) + do! expectM "should be correct id" mem2.Id (RaftState.votedFor >> Option.get) } |> runWithDefaults |> noError @@ -91,13 +91,13 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) raft { - do! Raft.addNonVotingMemberM mem - let! peer = Raft.getMemberM mem.Id + do! addNonVotingMember mem + let! peer = getMember mem.Id expect "Non-voting mem should not be voting" false Member.isVoting (Option.get peer) - do! Raft.addMemberM mem - let! peer = Raft.getMemberM mem.Id + do! addMember mem + let! peer = getMember mem.Id expect "Member should be voting" true Member.isVoting (Option.get peer) - do! expectM "Should have two mems (incl. self)" 2 Raft.numMembers + do! expectM "Should have two mems (incl. self)" 2 RaftState.numMembers } |> runWithDefaults |> noError @@ -108,14 +108,14 @@ module ServerTests = let mem2 = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM mem1 - do! expectM "Should have Member count of two" 2 Raft.numMembers - do! Raft.addMemberM mem2 - do! expectM "Should have Member count of three" 3 Raft.numMembers - do! Raft.removeMemberM mem1 - do! expectM "Should have Member count of two" 2 Raft.numMembers - do! Raft.removeMemberM mem2 - do! expectM "Should have Member count of one" 1 Raft.numMembers + do! addMember mem1 + do! expectM "Should have Member count of two" 2 RaftState.numMembers + do! addMember mem2 + do! expectM "Should have Member count of three" 3 RaftState.numMembers + do! removeMember mem1 + do! expectM "Should have Member count of two" 2 RaftState.numMembers + do! removeMember mem2 + do! expectM "Should have Member count of one" 1 RaftState.numMembers } |> runWithDefaults |> noError @@ -123,9 +123,9 @@ module ServerTests = let server_election_start_increments_term = testCase "Raft election increments current term" <| fun _ -> raft { - do! Raft.setTermM (term 2) + do! setCurrentTerm 2 do! Raft.startElection () - do! expectM "Raft should have correct term" (term 3) Raft.currentTerm + do! expectM "Raft should have correct term" (term 3) RaftState.currentTerm } |> runWithDefaults |> noError @@ -134,8 +134,8 @@ module ServerTests = let server_set_state = testCase "Raft set state should set supplied state" <| fun _ -> raft { - do! Raft.setStateM Leader - do! expectM "Raft should be leader now" Leader Raft.getState + do! setState Leader + do! expectM "Raft should be leader now" Leader RaftState.state } |> runWithDefaults |> noError @@ -143,7 +143,7 @@ module ServerTests = let server_starts_as_follower = testCase "Raft starts as follower" <| fun _ -> raft { - do! expectM "Raft state should be Follower" Follower Raft.getState + do! expectM "Raft state should be Follower" Follower RaftState.state } |> runWithDefaults |> noError @@ -158,18 +158,18 @@ module ServerTests = let cbs = Callbacks.Create (ref (DataSnapshot (State.Empty))) :> IRaftCallbacks raft { - do! Raft.setStateM Candidate - do! Raft.setTermM (term 5) + do! setState Candidate + do! setCurrentTerm 5 - do! Raft.createEntryM msg2 >>= ignoreM - let! entry = Raft.getEntryAtM (index 1) + do! Raft.createEntry msg2 >>= ignoreM + let! entry = entryAt (index 1) match Option.get entry with | LogEntry(_,_,_,data,_) -> Expect.equal data msg2 "Should have correct contents" | _ -> failwith "Should be a Log" - do! Raft.createEntryM msg3 >>= ignoreM - let! entry = Raft.getEntryAtM (index 2) + do! Raft.createEntry msg3 >>= ignoreM + let! entry = entryAt (index 2) match Option.get entry with | LogEntry(_,_,_,data,_) -> Expect.equal data msg3 "Should have correct contents" @@ -181,12 +181,12 @@ module ServerTests = let server_wont_apply_entry_if_we_dont_have_entry_to_apply = testCase "Raft won't apply entry if we don't have entry to apply" <| fun _ -> raft { - do! Raft.setCommitIndexM (index 0) - do! Raft.setLastAppliedIdxM (index 0) + do! setCommitIndex (index 0) + do! setLastAppliedIndex (index 0) do! Raft.applyEntries () - let! lidx = Raft.lastAppliedIdx() - let! cidx = Raft.commitIndexM() + let! lidx = lastAppliedIndex() + let! cidx = commitIndex () expect "Last applied index should be zero" 0 id lidx expect "Last commit index should be zero" 0 id cidx @@ -205,22 +205,22 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.setCommitIndexM (index 0) - do! Raft.setLastAppliedIdxM (index 0) - do! Raft.addMembersM mems + do! setCommitIndex (index 0) + do! setLastAppliedIndex (index 0) + do! addMembers mems do! Raft.applyEntries () - let! lidx = Raft.lastAppliedIdx() - let! cidx = Raft.commitIndexM() + let! lidx = lastAppliedIndex() + let! cidx = commitIndex () expect "Should not have incremented last applied index" 0 id lidx expect "Should not have incremented commit index" 0 id cidx - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! Raft.applyEntries () >>= ignoreM - let! lidx = Raft.lastAppliedIdx() - let! cidx = Raft.commitIndexM() + let! lidx = lastAppliedIndex() + let! cidx = commitIndex () expect "Should not have incremented last applied index" 0 id lidx expect "Should not have incremented commit index" 0 id cidx @@ -232,13 +232,13 @@ module ServerTests = let server_increment_lastApplied_when_lastApplied_lt_commitidx = testCase "Raft increment lastApplied when lastApplied lt commitidx" <| fun _ -> raft { - do! Raft.setStateM Follower - do! Raft.setTermM (term 1) - do! Raft.setLastAppliedIdxM (index 0) - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! Raft.setCommitIndexM (index 1) + do! setState Follower + do! setCurrentTerm 1 + do! setLastAppliedIndex (index 0) + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! setCommitIndex (index 1) do! Raft.periodic 1 - let! lidx = Raft.lastAppliedIdx() + let! lidx = lastAppliedIndex() expect "Should have last applied index 1" 1 id lidx } |> runWithDefaults @@ -247,11 +247,11 @@ module ServerTests = let server_apply_entry_increments_last_applied_idx = testCase "Raft applyEntry increments LastAppliedIndex" <| fun _ -> raft { - do! Raft.setLastAppliedIdxM (index 0) - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! Raft.setCommitIndexM (index 1) + do! setLastAppliedIndex (index 0) + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! setCommitIndex (index 1) do! Raft.applyEntries () - let! lidx = Raft.lastAppliedIdx() + let! lidx = lastAppliedIndex() expect "Should have last applied index 1" 1 id lidx } |> runWithDefaults @@ -260,12 +260,12 @@ module ServerTests = let server_periodic_elapses_election_timeout = testCase "Raft Periodic elapses election timeout" <| fun _ -> raft { - do! Raft.setElectionTimeoutM 1000 - do! expectM "Timeout elapsed should be zero" 0 Raft.timeoutElapsed + do! setElectionTimeout 1000 + do! expectM "Timeout elapsed should be zero" 0 RaftState.timeoutElapsed do! Raft.periodic 0 - do! expectM "Timeout elapsed should be zero" 0 Raft.timeoutElapsed + do! expectM "Timeout elapsed should be zero" 0 RaftState.timeoutElapsed do! Raft.periodic 100 - do! expectM "Timeout elapsed should be 100" 100 Raft.timeoutElapsed + do! expectM "Timeout elapsed should be 100" 100 RaftState.timeoutElapsed } |> runWithDefaults |> noError @@ -273,10 +273,10 @@ module ServerTests = let server_election_timeout_does_no_promote_us_to_leader_if_there_is_only_1_mem = testCase "Election timeout does not promote us to leader if there is only 1 mem" <| fun _ -> raft { - do! Raft.addMemberM (Member.create (DiscoId.Create())) - do! Raft.setElectionTimeoutM 1000 + do! addMember (Member.create (DiscoId.Create())) + do! setElectionTimeout 1000 do! Raft.periodic 1001 - do! expectM "Should not be Leader" false Raft.isLeader + do! expectM "Should not be Leader" false RaftState.isLeader } |> runWithDefaults |> noError @@ -285,14 +285,14 @@ module ServerTests = testCase "Receive entry auto-commits if we are the only mem" <| fun _ -> let entry = LogEntry(DiscoId.Create(),index 0,term 0,DataSnapshot (State.Empty),None) raft { - do! Raft.setElectionTimeoutM 1000 + do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx 0" (index 0) Raft.commitIndex + do! expectM "Should have commit idx 0" (index 0) RaftState.commitIndex let! result = Raft.receiveEntry entry - do! expectM "Should have log count 1" 1 Raft.numLogs - do! expectM "Should have commit idx 1" (index 1) Raft.commitIndex + do! expectM "Should have log count 1" 1 RaftState.numLogs + do! expectM "Should have commit idx 1" (index 1) RaftState.commitIndex } |> runWithDefaults |> noError @@ -304,18 +304,18 @@ module ServerTests = JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberAdded(mem) |] , None) raft { - do! Raft.setElectionTimeoutM 1000 + do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) Raft.commitIndex + do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex - let! term = Raft.currentTermM () + let! term = currentTerm () let! result = Raft.receiveEntry (mklog term) do! Raft.periodic 1000 // important, as only now the changes take effect - do! expectM "Should have log count of one" 1 Raft.numLogs + do! expectM "Should have log count of one" 1 RaftState.numLogs - let! term = Raft.currentTermM () + let! term = currentTerm () return! Raft.receiveEntry (mklog term) } |> runWithDefaults @@ -329,14 +329,14 @@ module ServerTests = JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberAdded(mem) |] , None) raft { - do! Raft.setElectionTimeoutM 1000 + do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) Raft.commitIndex - do! expectM "Should have mem count of one" 1 Raft.numMembers - let! term = Raft.currentTermM () + do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex + do! expectM "Should have mem count of one" 1 RaftState.numMembers + let! term = currentTerm () let! result = Raft.receiveEntry (mklog term) do! Raft.periodic 10 - do! expectM "Should have mem count of two" 2 Raft.numMembers + do! expectM "Should have mem count of two" 2 RaftState.numMembers } |> runWithDefaults |> noError @@ -349,17 +349,17 @@ module ServerTests = JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberAdded(mem) |] , None) raft { - do! Raft.setElectionTimeoutM 1000 + do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) Raft.commitIndex - do! expectM "Should have mem count of one" 1 Raft.numMembers + do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex + do! expectM "Should have mem count of one" 1 RaftState.numMembers - let! term = Raft.currentTermM () + let! term = currentTerm () let! result = Raft.receiveEntry (mklog term) do! Raft.periodic 10 - do! expectM "Should be non-voting mem for start" false (Raft.getMember nid >> Option.get >> Member.isVoting) + do! expectM "Should be non-voting mem for start" false (RaftState.getMember nid >> Option.get >> Member.isVoting) } |> runWithDefaults |> noError @@ -374,10 +374,10 @@ module ServerTests = JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberRemoved mem |] , None) raft { - do! Raft.setElectionTimeoutM 1000 - do! Raft.addMemberM mem + do! setElectionTimeout 1000 + do! addMember mem do! Raft.becomeLeader () - do! expectM "Should have mem count of two" 2 Raft.numMembers + do! expectM "Should have mem count of two" 2 RaftState.numMembers ci := 1 @@ -395,7 +395,7 @@ module ServerTests = do! Raft.periodic 1000 // after entry was applied, we'll see the change - do! expectM "Should have mem count of one" 1 Raft.numMembers + do! expectM "Should have mem count of one" 1 RaftState.numMembers } |> runWithDefaults |> noError @@ -411,8 +411,8 @@ module ServerTests = raft { for mem in mems do - do! Raft.addMemberM mem - do! expectM "Should have 13 mems now" 13 Raft.numMembers + do! addMember mem + do! expectM "Should have 13 mems now" 13 RaftState.numMembers } |> runWithDefaults |> noError @@ -442,12 +442,12 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 1) - do! Raft.setStateM Candidate + do! addMember mem + do! setCurrentTerm 1 + do! setState Candidate do! expectM "Votes for me should be zero" 0 Raft.numVotesForMe - let! term = Raft.currentTermM () + let! term = currentTerm () let response = { Term = term; Granted = false; Reason = Some OK } let! result = Raft.receiveVoteResponse mem.Id response do! expectM "Votes for me should be zero" 0 Raft.numVotesForMe @@ -460,9 +460,9 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 3) - do! Raft.setStateM Candidate + do! addMember mem + do! setCurrentTerm 3 + do! setState Candidate do! expectM "Should have zero votes for me" 0 Raft.numVotesForMe let response = { Term = term 2; Granted = true; Reason = None } @@ -475,8 +475,8 @@ module ServerTests = testCase "Recv requestvote response increase votes for me" <| fun _ -> let mem = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 1) + do! addMember mem + do! setCurrentTerm 1 do! expectM "Should have zero votes for me" 0 Raft.numVotesForMe do! Raft.becomeCandidate () do! Raft.receiveVoteResponse mem.Id { Term = term 2; Granted = true; Reason = None } @@ -494,8 +494,8 @@ module ServerTests = |> Error.asRaftError "Raft.receiveVoteResponse" raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 1) + do! addMember mem + do! setCurrentTerm 1 let response = { Term = term 1; Granted = true; Reason = None } do! Raft.receiveVoteResponse mem.Id response } @@ -511,15 +511,15 @@ module ServerTests = |> Error.asRaftError "Raft.receiveVoteResponse" raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 3) + do! addMember mem + do! setCurrentTerm 3 do! Raft.becomeCandidate () let! response = Raft.receiveVoteResponse mem.Id { Term = term 3 Granted = true Reason = None } - do! expectM "Should have term 4" (term 4) Raft.currentTerm + do! expectM "Should have term 4" (term 4) RaftState.currentTerm } |> runWithDefaults |> expectError err @@ -544,7 +544,7 @@ module ServerTests = } raft { - do! Raft.setTermM (term 2) + do! setCurrentTerm 2 let! (res,_) = Raft.shouldGrantVote vote expect "Should not grant vote" false id res } @@ -564,8 +564,8 @@ module ServerTests = } raft { - do! Raft.setTermM (term 2) - do! Raft.voteForMyself () + do! setCurrentTerm 2 + do! voteForMyself () let! (res,_) = Raft.shouldGrantVote vote expect "Should not grant vote" false id res } @@ -584,11 +584,11 @@ module ServerTests = } raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 1) - do! Raft.voteFor None - do! expectM "Should have currentIndex zero" (index 0) Raft.currentIndex - do! expectM "Should have voted for nobody" None Raft.votedFor + do! addMember mem + do! setCurrentTerm 1 + do! voteFor None + do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex + do! expectM "Should have voted for nobody" None RaftState.votedFor let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res } @@ -607,13 +607,13 @@ module ServerTests = } raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 1) - do! Raft.voteFor None - do! expectM "Should have currentIndex zero" (index 0) Raft.currentIndex - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! expectM "Should have currentIndex one" (index 2) Raft.currentIndex + do! addMember mem + do! setCurrentTerm 1 + do! voteFor None + do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! expectM "Should have currentIndex one" (index 2) RaftState.currentIndex let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res } @@ -632,13 +632,13 @@ module ServerTests = } raft { - do! Raft.addMemberM mem - do! Raft.setTermM (term 2) - do! Raft.voteFor None - do! expectM "Should have currentIndex zero" (index 0) Raft.currentIndex - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! Raft.createEntryM (DataSnapshot (State.Empty)) >>= ignoreM - do! expectM "Should have currentIndex one" (index 2) Raft.currentIndex + do! addMember mem + do! setCurrentTerm 2 + do! voteFor None + do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! expectM "Should have currentIndex one" (index 2) RaftState.currentIndex let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res } @@ -650,11 +650,11 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) - do! Raft.voteForMyself () + do! addMember peer + do! setCurrentTerm 1 + do! voteForMyself () do! Raft.becomeLeader () - do! expectM "Should be leader" Leader Raft.getState + do! expectM "Should be leader" Leader RaftState.state let request = { Term = term 1 ; Candidate = peer @@ -662,7 +662,7 @@ module ServerTests = ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request - do! expectM "Should be leader" Leader Raft.getState + do! expectM "Should be leader" Leader RaftState.state } |> runWithDefaults |> noError @@ -673,8 +673,8 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) + do! addMember peer + do! setCurrentTerm 1 let request = { Term = term 2 ; Candidate = peer @@ -692,9 +692,9 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM peer - do! Raft.setTermM (term 1) - do! Raft.setElectionTimeoutM 1000 + do! addMember peer + do! setCurrentTerm 1 + do! setElectionTimeout 1000 do! Raft.periodic 900 let request = { Term = term 2 @@ -704,7 +704,7 @@ module ServerTests = } let! resp = Raft.receiveVoteRequest peer.Id request expect "Vote should be granted" true VoteResponse.granted resp - do! expectM "Timeout Elapsed should be reset" 0 Raft.timeoutElapsed + do! expectM "Timeout Elapsed should be reset" 0 RaftState.timeoutElapsed } |> runWithDefaults |> noError @@ -714,11 +714,11 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM peer + do! addMember peer do! Raft.becomeCandidate () - do! Raft.setTermM (term 1) - do! expectM "Should have voted for myself" true Raft.votedForMyself - do! expectM "Should have term 1" (term 1) Raft.currentTerm + do! setCurrentTerm 1 + do! expectM "Should have voted for myself" true RaftState.votedForMyself + do! expectM "Should have term 1" (term 1) RaftState.currentTerm let request = { Term = term 2 ; Candidate = peer @@ -726,9 +726,9 @@ module ServerTests = ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request - do! expectM "Should now be Follower" Follower Raft.getState - do! expectM "Should have term 2" (term 2) Raft.currentTerm - do! expectM "Should have voted for peer" peer.Id (Raft.votedFor >> Option.get) + do! expectM "Should now be Follower" Follower RaftState.state + do! expectM "Should have term 2" (term 2) RaftState.currentTerm + do! expectM "Should have voted for peer" peer.Id (RaftState.votedFor >> Option.get) } |> runWithDefaults |> noError @@ -739,10 +739,10 @@ module ServerTests = let other = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM peer + do! addMember peer do! Raft.becomeCandidate () - do! Raft.setTermM (term 1) - do! expectM "Should have voted for myself" true Raft.votedForMyself + do! setCurrentTerm 1 + do! expectM "Should have voted for myself" true RaftState.votedForMyself let request = { Term = term 2 ; Candidate = other @@ -750,7 +750,7 @@ module ServerTests = ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest other.Id request - do! expectM "Should have added mem" None (Raft.getMember other.Id) + do! expectM "Should have added mem" None (RaftState.getMember other.Id) expect "Should not have granted vote" false VoteResponse.granted resp } |> runWithDefaults @@ -768,12 +768,12 @@ module ServerTests = } raft { - do! Raft.addMembersM (Map.ofArray [| (peer1.Id, peer1); (peer2.Id, peer2) |]) - do! Raft.setTermM (term 1) - do! Raft.voteForMyself () - do! Raft.setTermM (term 1) - do! expectM "Should have voted for myself" true Raft.votedForMyself - do! expectM "Should have 3 mems" 3 Raft.numMembers + do! addMembers (Map.ofArray [| (peer1.Id, peer1); (peer2.Id, peer2) |]) + do! setCurrentTerm 1 + do! voteForMyself () + do! setCurrentTerm 1 + do! expectM "Should have voted for myself" true RaftState.votedForMyself + do! expectM "Should have 3 mems" 3 RaftState.numMembers let! raft' = get let req1 = { request with Candidate = raft'.Member } @@ -788,9 +788,9 @@ module ServerTests = testCase "follower becomes follower is follower" <| fun _ -> raft { do! Raft.becomeLeader () - do! expectM "Should be leader now" Leader Raft.getState + do! expectM "Should be leader now" Leader RaftState.state do! Raft.becomeFollower () - do! expectM "Should be follower now" Follower Raft.getState + do! expectM "Should be follower now" Follower RaftState.state } |> runWithDefaults |> noError @@ -798,10 +798,10 @@ module ServerTests = let follower_becomes_follower_does_not_clear_voted_for = testCase "follower becomes follower does not clear voted for" <| fun _ -> raft { - do! Raft.voteForMyself () - do! expectM "Should have voted for myself" true Raft.votedForMyself + do! voteForMyself () + do! expectM "Should have voted for myself" true RaftState.votedForMyself do! Raft.becomeFollower () - do! expectM "Should have voted for myself" true Raft.votedForMyself + do! expectM "Should have voted for myself" true RaftState.votedForMyself } |> runWithDefaults |> noError @@ -810,7 +810,7 @@ module ServerTests = testCase "candidate becomes candidate is candidate" <| fun _ -> raft { do! Raft.becomeCandidate () - do! expectM "Should be Candidate" true Raft.isCandidate + do! expectM "Should be Candidate" true RaftState.isCandidate } |> runWithDefaults |> noError @@ -822,13 +822,13 @@ module ServerTests = // thereby increasing the term again). let peer = Member.create (DiscoId.Create()) raft { - do! Raft.addMemberM peer - do! Raft.setElectionTimeoutM 1000 - do! expectM "Should be at term zero" (term 0) Raft.currentTerm + do! addMember peer + do! setElectionTimeout 1000 + do! expectM "Should be at term zero" (term 0) RaftState.currentTerm do! Raft.becomeCandidate () - do! expectM "Should be at term one" (term 1) Raft.currentTerm + do! expectM "Should be at term one" (term 1) RaftState.currentTerm do! Raft.periodic 1001 - do! expectM "Should be at term two" (term 2) Raft.currentTerm + do! expectM "Should be at term two" (term 2) RaftState.currentTerm } |> runWithDefaults |> noError @@ -839,10 +839,10 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) raft { - do! Raft.setElectionTimeoutM 1000 - do! Raft.addMemberM peer + do! setElectionTimeout 1000 + do! addMember peer do! Raft.periodic 1001 - do! expectM "Should be candidate now" Candidate Raft.getState + do! expectM "Should be candidate now" Candidate RaftState.state } |> runWithDefaults |> noError @@ -855,10 +855,10 @@ module ServerTests = let log2 = LogEntry(DiscoId.Create(), index 0, term 2, (DataSnapshot (State.Empty)), None) raft { - do! Raft.addPeerM peer - do! Raft.setTermM (term 1) - do! Raft.appendEntryM log1 >>= ignoreM - do! Raft.appendEntryM log2 >>= ignoreM + do! addMember peer + do! setCurrentTerm 1 + do! Raft.appendEntry log1 >>= ignoreM + do! Raft.appendEntry log2 >>= ignoreM let! state = get let vote : VoteRequest = @@ -871,7 +871,7 @@ module ServerTests = let! resp = Raft.receiveVoteRequest peer.Id vote expect "Should have failed" false id resp.Granted - do! Raft.setTermM (term 2) + do! setCurrentTerm 2 let! resp = Raft.receiveVoteRequest peer.Id { vote with Term = term 2; LastLogTerm = term 3; } expect "Should be granted" true VoteResponse.granted resp @@ -882,9 +882,9 @@ module ServerTests = let follower_becoming_candidate_increments_current_term = testCase "follower becoming candidate increments current term" <| fun _ -> raft { - do! expectM "Should have term 0" (term 0) Raft.currentTerm + do! expectM "Should have term 0" (term 0) RaftState.currentTerm do! Raft.becomeCandidate () - do! expectM "Should have term 1" (term 1) Raft.currentTerm + do! expectM "Should have term 1" (term 1) RaftState.currentTerm } |> runWithDefaults |> noError @@ -894,10 +894,10 @@ module ServerTests = raft { let peer = Member.create (DiscoId.Create()) let! raft' = get - do! Raft.addMemberM peer - do! expectM "Should have no VotedFor" None Raft.votedFor + do! addMember peer + do! expectM "Should have no VotedFor" None RaftState.votedFor do! Raft.becomeCandidate () - do! expectM "Should have voted for myself" (Some raft'.Member.Id) Raft.votedFor + do! expectM "Should have voted for myself" (Some raft'.Member.Id) RaftState.votedFor do! expectM "Should have one vote for me" 1 Raft.numVotesForMe } |> runWithDefaults @@ -906,12 +906,12 @@ module ServerTests = let follower_becoming_candidate_resets_election_timeout = testCase "follower becoming candidate resets election timeout" <| fun _ -> raft { - do! Raft.setElectionTimeoutM 1000 - do! expectM "Should have zero elapsed timout" 0 Raft.timeoutElapsed + do! setElectionTimeout 1000 + do! expectM "Should have zero elapsed timout" 0 RaftState.timeoutElapsed do! Raft.periodic 900 - do! expectM "Should have 900 elapsed timout" 900 Raft.timeoutElapsed + do! expectM "Should have 900 elapsed timout" 900 RaftState.timeoutElapsed do! Raft.becomeCandidate () - do! expectM "Should have timeout elapsed below 1000" true (Raft.timeoutElapsed >> ((>) 1000)) + do! expectM "Should have timeout elapsed below 1000" true (RaftState.timeoutElapsed >> ((>) 1000)) } |> runWithDefaults |> noError @@ -922,7 +922,7 @@ module ServerTests = let peer1 = Member.create (DiscoId.Create()) let peer2 = Member.create (DiscoId.Create()) - let state = Raft.create peer0 + let state = RaftState.create peer0 let lokk = new System.Object() let i = ref 0 let cbs = @@ -931,9 +931,9 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.addMemberM peer1 - do! Raft.addMemberM peer2 - do! Raft.setTermM (term 2) + do! addMember peer1 + do! addMember peer2 + do! setCurrentTerm 2 do! Raft.becomeCandidate () expect "Should have two vote requests" 2 id !i } @@ -949,16 +949,16 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addPeersM peers - do! expectM "Should have 5 mems" 5 Raft.numMembers + do! addMembers peers + do! expectM "Should have 5 mems" 5 RaftState.numMembers do! Raft.becomeCandidate () - let! term = Raft.currentTermM () + let! term = currentTerm () for KeyValue(id,_) in peers do do! Raft.receiveVoteResponse id { Term = term; Granted = true; Reason = None } - do! expectM "Should be leader" true Raft.isLeader + do! expectM "Should be leader" true RaftState.isLeader } |> runWithDefaults |> noError @@ -973,8 +973,8 @@ module ServerTests = Candidate = raft'.Member // term for this to work LastLogIndex = index 0 LastLogTerm = term 0 } - do! Raft.addPeerM peer - do! Raft.voteFor (Some raft'.Member) + do! addMember peer + do! voteFor (Some raft'.Member) let! resp = Raft.receiveVoteRequest peer.Id vote expect "Should have failed" true VoteResponse.declined resp } @@ -984,7 +984,7 @@ module ServerTests = let candidate_requestvote_includes_logidx = testCase "candidate requestvote includes logidx" <| fun _ -> let self = Member.create (DiscoId.Create()) - let raft' = Raft.create self + let raft' = RaftState.create self let sender = Sender.create let response = { Term = term 5; Granted = true; Reason = None } let cbs = @@ -1006,10 +1006,10 @@ module ServerTests = Some <| LogEntry(DiscoId.Create(),index 0, term 1, DataSnapshot (State.Empty), Some <| LogEntry(DiscoId.Create(),index 0, term 1, DataSnapshot (State.Empty), None))) - do! Raft.addPeersM peers - do! Raft.setStateM Candidate - do! Raft.setTermM (term 5) - do! Raft.appendEntryM log >>= ignoreM + do! addMembers peers + do! setState Candidate + do! setCurrentTerm 5 + do! Raft.appendEntry log >>= ignoreM let! request = Raft.sendVoteRequest peer1 @@ -1030,17 +1030,17 @@ module ServerTests = raft { let peer = Member.create (DiscoId.Create()) let response = { Term = term 2 ; Granted = false; Reason = None } - do! Raft.addPeerM peer - do! Raft.setTermM (term 1) - do! Raft.setStateM Candidate - do! Raft.voteFor None - do! expectM "Should not be follower" false Raft.isFollower - do! expectM "Should not *have* a leader" None Raft.currentLeader - do! expectM "Should have term 1" (term 1) Raft.currentTerm + do! addMember peer + do! setCurrentTerm 1 + do! setState Candidate + do! voteFor None + do! expectM "Should not be follower" false RaftState.isFollower + do! expectM "Should not *have* a leader" None RaftState.currentLeader + do! expectM "Should have term 1" (term 1) RaftState.currentTerm do! Raft.receiveVoteResponse peer.Id response - do! expectM "Should be Follower" Follower Raft.getState - do! expectM "Should have term 2" (term 2) Raft.currentTerm - do! expectM "Should have voted for nobody" None Raft.votedFor + do! expectM "Should be Follower" Follower RaftState.state + do! expectM "Should have term 2" (term 2) RaftState.currentTerm + do! expectM "Should have voted for nobody" None RaftState.votedFor } |> runWithDefaults |> noError @@ -1058,17 +1058,17 @@ module ServerTests = } raft { - do! Raft.addPeerM peer - do! Raft.setStateM Candidate - do! Raft.voteFor None - do! expectM "Should not be follower" false Raft.isFollower - do! expectM "Should have no leader" None Raft.currentLeader - do! expectM "Should have term 0" (term 0) Raft.currentTerm + do! addMember peer + do! setState Candidate + do! voteFor None + do! expectM "Should not be follower" false RaftState.isFollower + do! expectM "Should have no leader" None RaftState.currentLeader + do! expectM "Should have term 0" (term 0) RaftState.currentTerm let! resp = Raft.receiveAppendEntries (Some peer.Id) ae - do! expectM "Should be follower" Follower Raft.getState - do! expectM "Should have peer as leader" (Some peer.Id) Raft.currentLeader - do! expectM "Should have term 1" (term 1) Raft.currentTerm - do! expectM "Should have voted for noone" None Raft.votedFor + do! expectM "Should be follower" Follower RaftState.state + do! expectM "Should have peer as leader" (Some peer.Id) RaftState.currentLeader + do! expectM "Should have term 1" (term 1) RaftState.currentTerm + do! expectM "Should have voted for noone" None RaftState.votedFor } |> runWithDefaults |> noError @@ -1085,12 +1085,12 @@ module ServerTests = } raft { - do! Raft.addPeerM peer - do! Raft.setTermM (term 2) - do! Raft.setStateM Candidate - do! expectM "Should not be follower" false Raft.isFollower + do! addMember peer + do! setCurrentTerm 2 + do! setState Candidate + do! expectM "Should not be follower" false RaftState.isFollower let! resp = Raft.receiveAppendEntries (Some peer.Id) ae - do! expectM "Should not be candidate anymore" false Raft.isCandidate + do! expectM "Should not be candidate anymore" false RaftState.isCandidate } |> runWithDefaults |> noError @@ -1099,7 +1099,7 @@ module ServerTests = testCase "leader becomes leader is leader" <| fun _ -> raft { do! Raft.becomeLeader () - do! expectM "Should be leader" Leader Raft.getState + do! expectM "Should be leader" Leader RaftState.state } |> runWithDefaults |> noError @@ -1108,10 +1108,10 @@ module ServerTests = testCase "leader becomes leader does not clear voted for" <| fun _ -> raft { let! raft' = get - do! Raft.voteForMyself () - do! expectM "Should have voted for myself" (Some raft'.Member.Id) Raft.votedFor + do! voteForMyself () + do! expectM "Should have voted for myself" (Some raft'.Member.Id) RaftState.votedFor do! Raft.becomeLeader () - do! expectM "Should still have votedFor" (Some raft'.Member.Id) Raft.votedFor + do! expectM "Should still have votedFor" (Some raft'.Member.Id) RaftState.votedFor } |> runWithDefaults |> noError @@ -1122,12 +1122,12 @@ module ServerTests = let peer2 = Member.create (DiscoId.Create()) raft { - do! Raft.addPeerM peer1 - do! Raft.addPeerM peer2 - do! Raft.setStateM Candidate + do! addMember peer1 + do! addMember peer2 + do! setState Candidate do! Raft.becomeLeader () let! raft' = get - let cidx = Raft.currentIndex raft' + index 1 + let cidx = RaftState.currentIndex raft' + index 1 for peer in raft'.Peers do if peer.Value.Id <> raft'.Member.Id then @@ -1151,9 +1151,9 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.addPeerM peer1 - do! Raft.addPeerM peer2 - do! Raft.setStateM Candidate + do! addMember peer1 + do! addMember peer2 + do! setState Candidate do! Raft.becomeLeader () expect "Should have two messages" 2 id !count } @@ -1166,11 +1166,11 @@ module ServerTests = let log = LogEntry(DiscoId.Create(),index 0,term 0,DataSnapshot (State.Empty),None) raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader - do! expectM "Should have log count 0" 0 Raft.numLogs + do! addMember peer + do! setState Leader + do! expectM "Should have log count 0" 0 RaftState.numLogs let! resp = Raft.receiveEntry log - do! expectM "Should have log count 1" 1 Raft.numLogs + do! expectM "Should have log count 1" 1 RaftState.numLogs do! Raft.applyEntries () let response = { Term = term 0; Success = true; CurrentIndex = index 1; FirstIndex = index 1 } do! Raft.receiveAppendEntriesResponse peer.Id response @@ -1191,8 +1191,8 @@ module ServerTests = |> Error.asRaftError "Raft.receiveEntry" raft { - do! Raft.addMemberM peer - do! Raft.setStateM Follower + do! addMember peer + do! setState Follower let! resp = Raft.receiveEntry log return "never reached" } @@ -1211,9 +1211,9 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader - do! Raft.sendAllAppendEntriesM () + do! addMember peer + do! setState Leader + do! Raft.sendAllAppendEntries () expect "Should have one message in cue" 1 List.length (!sender.Outbox) } |> runWithRaft raft' cbs @@ -1230,15 +1230,15 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader + do! addMember peer + do! setState Leader for n in 0 .. 9 do let l = LogEntry(DiscoId.Create(), index 0, term 1, DataSnapshot (State.Empty), None) - do! Raft.appendEntryM l >>= ignoreM + do! Raft.appendEntry l >>= ignoreM - do! Raft.setCommitIndexM (index 10) - do! Raft.sendAllAppendEntriesM () + do! setCommitIndex (index 10) + do! Raft.sendAllAppendEntries () (!sender.Outbox) |> List.head @@ -1259,8 +1259,8 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader + do! addMember peer + do! setState Leader let! request = Raft.sendAppendEntry peer @@ -1271,10 +1271,10 @@ module ServerTests = let log = LogEntry(DiscoId.Create(),index 0,term 2,DataSnapshot (State.Empty),None) - do! Raft.appendEntryM log >>= ignoreM - do! Raft.setNextIndexM peer.Id (index 1) + do! Raft.appendEntry log >>= ignoreM + do! setNextIndex peer.Id (index 1) - let! peer = Raft.getMemberM peer.Id >>= (Option.get >> returnM) + let! peer = getMember peer.Id >>= (Option.get >> returnM) let! request = Raft.sendAppendEntry peer @@ -1288,8 +1288,8 @@ module ServerTests = sender.Outbox := List.empty // reset outbox - do! Raft.setNextIndexM peer.Id (index 2) - let! peer = Raft.getMemberM peer.Id >>= (Option.get >> returnM) + do! setNextIndex peer.Id (index 2) + let! peer = getMember peer.Id >>= (Option.get >> returnM) let! request = Raft.sendAppendEntry peer (!sender.Outbox) @@ -1311,8 +1311,8 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader + do! addMember peer + do! setState Leader let! request = Raft.sendAppendEntry peer (!sender.Outbox) @@ -1324,8 +1324,8 @@ module ServerTests = let log = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty), None) - do! Raft.setNextIndexM peer.Id (index 1) - do! Raft.appendEntryM log >>= ignoreM + do! setNextIndex peer.Id (index 1) + do! Raft.appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer (!sender.Outbox) @@ -1347,8 +1347,8 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader + do! addMember peer + do! setState Leader let! request = Raft.sendAppendEntry peer (!sender.Outbox) |> expect "Should have a message" 1 List.length @@ -1366,11 +1366,11 @@ module ServerTests = let cbs = Callbacks.Create (ref (DataSnapshot (State.Empty))) :> IRaftCallbacks raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader - do! expectM "Should have zero logs" 0 Raft.numLogs + do! addMember peer + do! setState Leader + do! expectM "Should have zero logs" 0 RaftState.numLogs let! resp = Raft.receiveEntry log - do! expectM "Should have on log" 1 Raft.numLogs + do! expectM "Should have on log" 1 RaftState.numLogs } |> runWithRaft raft' cbs |> noError @@ -1406,14 +1406,14 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addMembersM peers - do! Raft.setStateM Leader - do! Raft.setTermM (term 1) - do! Raft.setCommitIndexM (index 0) - do! Raft.setLastAppliedIdxM (index 0) - do! Raft.appendEntryM log1 >>= ignoreM - do! Raft.appendEntryM log2 >>= ignoreM - do! Raft.appendEntryM log3 >>= ignoreM + do! addMembers peers + do! setState Leader + do! setCurrentTerm 1 + do! setCommitIndex (index 0) + do! setLastAppliedIndex (index 0) + do! Raft.appendEntry log1 >>= ignoreM + do! Raft.appendEntry log2 >>= ignoreM + do! Raft.appendEntry log3 >>= ignoreM // peer 1 let! request = Raft.sendAppendEntry peer1 @@ -1423,18 +1423,18 @@ module ServerTests = do! Raft.receiveAppendEntriesResponse peer1.Id response // first response, no majority yet, will not set commit idx - do! expectM "Should have commit index 0" (index 0) Raft.commitIndex + do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex do! Raft.receiveAppendEntriesResponse peer2.Id response // leader will now have majority followers who have appended this log - do! expectM "Should have commit index 3" (index 3) Raft.commitIndex + do! expectM "Should have commit index 3" (index 3) RaftState.commitIndex - let! lidx = Raft.lastAppliedIdx() + let! lidx = lastAppliedIndex() expect "Should have last applied index 0" 0 id lidx do! Raft.periodic 1 - let! lidx = Raft.lastAppliedIdx() + let! lidx = lastAppliedIndex() expect "Should have last applied index 3" 3 id lidx } |> runWithRaft raft' cbs @@ -1467,20 +1467,20 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addMembersM peers - do! Raft.setStateM Leader - do! Raft.setTermM (term 1) - do! Raft.setCommitIndexM (index 0) - do! Raft.setLastAppliedIdxM (index 0) - do! Raft.appendEntryM log1 >>= ignoreM - do! Raft.appendEntryM log2 >>= ignoreM - do! Raft.appendEntryM log3 >>= ignoreM - do! Raft.sendAllAppendEntriesM () + do! addMembers peers + do! setState Leader + do! setCurrentTerm 1 + do! setCommitIndex (index 0) + do! setLastAppliedIndex (index 0) + do! Raft.appendEntry log1 >>= ignoreM + do! Raft.appendEntry log2 >>= ignoreM + do! Raft.appendEntry log3 >>= ignoreM + do! Raft.sendAllAppendEntries () do! Raft.receiveAppendEntriesResponse peer1.Id response do! Raft.receiveAppendEntriesResponse peer2.Id response - do! expectM "Should have matchIdx 1" (index 1) (Raft.getMember peer1.Id >> Option.get >> Member.matchIndex) + do! expectM "Should have matchIdx 1" (index 1) (RaftState.getMember peer1.Id >> Option.get >> Member.matchIndex) do! Raft.receiveAppendEntriesResponse peer1.Id response - do! expectM "Should still have matchIdx 1" (index 1) (Raft.getMember peer1.Id >> Option.get >> Member.matchIndex) + do! expectM "Should still have matchIdx 1" (index 1) (RaftState.getMember peer1.Id >> Option.get >> Member.matchIndex) } |> runWithRaft raft' cbs |> noError @@ -1510,28 +1510,28 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addMembersM peers - do! Raft.setStateM Leader - do! Raft.setTermM (term 2) - do! Raft.setCommitIndexM (index 0) - do! Raft.setLastAppliedIdxM (index 0) - do! Raft.appendEntryM log1 >>= ignoreM - do! Raft.appendEntryM log2 >>= ignoreM - do! Raft.appendEntryM log3 >>= ignoreM + do! addMembers peers + do! setState Leader + do! setCurrentTerm 2 + do! setCommitIndex (index 0) + do! setLastAppliedIndex (index 0) + do! Raft.appendEntry log1 >>= ignoreM + do! Raft.appendEntry log2 >>= ignoreM + do! Raft.appendEntry log3 >>= ignoreM let! request = Raft.sendAppendEntry peer1 let! request = Raft.sendAppendEntry peer2 do! Raft.receiveAppendEntriesResponse peer1.Id response - do! expectM "Should have commit index 0" (index 0) Raft.commitIndex + do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex do! Raft.receiveAppendEntriesResponse peer2.Id response - do! expectM "Should have commit index 0" (index 0) Raft.commitIndex + do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex do! Raft.periodic 1 - let! lidx = Raft.lastAppliedIdx() + let! lidx = lastAppliedIndex() expect "Should have last applied index 0" 0 id lidx let! request = Raft.sendAppendEntry peer1 @@ -1539,14 +1539,14 @@ module ServerTests = let! request = Raft.sendAppendEntry peer2 do! Raft.receiveAppendEntriesResponse peer1.Id { response with CurrentIndex = index 2; FirstIndex = index 2 } - do! expectM "Should have commit index 0" (index 0) Raft.commitIndex + do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex do! Raft.receiveAppendEntriesResponse peer2.Id { response with CurrentIndex = index 2; FirstIndex = index 2 } - do! expectM "Should have commit index 0" (index 0) Raft.commitIndex + do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex do! Raft.periodic 1 - let! lidx = Raft.lastAppliedIdx() + let! lidx = lastAppliedIndex() expect "Should have last applied index 0" 0 id lidx let! request = Raft.sendAppendEntry peer1 @@ -1554,14 +1554,14 @@ module ServerTests = let! request = Raft.sendAppendEntry peer2 do! Raft.receiveAppendEntriesResponse peer1.Id { response with Term = term 2; CurrentIndex = index 3; FirstIndex = index 3 } - do! expectM "Should have commit index 0" (index 0) Raft.commitIndex + do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex do! Raft.receiveAppendEntriesResponse peer2.Id { response with Term = term 2; CurrentIndex = index 3; FirstIndex = index 3 } - do! expectM "Should have commit index 3" (index 3) Raft.commitIndex + do! expectM "Should have commit index 3" (index 3) RaftState.commitIndex do! Raft.periodic 1 - let! lidx = Raft.lastAppliedIdx() + let! lidx = lastAppliedIndex() expect "Should have last applied index 3" 3 id lidx } |> runWithCBS cbs @@ -1594,37 +1594,37 @@ module ServerTests = ; FirstIndex = index 1 } raft { - do! Raft.addMemberM peer - do! Raft.setStateM Leader - do! Raft.setTermM (term 2) - do! Raft.setCommitIndexM (index 0) - do! Raft.setLastAppliedIdxM (index 0) - do! Raft.appendEntryM log1 >>= ignoreM - do! Raft.appendEntryM log2 >>= ignoreM - do! Raft.appendEntryM log3 >>= ignoreM - do! Raft.appendEntryM log4 >>= ignoreM + do! addMember peer + do! setState Leader + do! setCurrentTerm 2 + do! setCommitIndex (index 0) + do! setLastAppliedIndex (index 0) + do! Raft.appendEntry log1 >>= ignoreM + do! Raft.appendEntry log2 >>= ignoreM + do! Raft.appendEntry log3 >>= ignoreM + do! Raft.appendEntry log4 >>= ignoreM do! Raft.becomeLeader () - do! expectM "Should have nextIdx 5" (index 5) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 5" (index 5) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! expectM "Should have a msg 1" 1 (konst !count) // need to get an up-to-date version of the peer, because its nextIdx // will have been bumped when becoming leader! - let! peer = Raft.getMemberM peer.Id >>= (Option.get >> returnM) + let! peer = getMember peer.Id >>= (Option.get >> returnM) - do! Raft.sendAllAppendEntriesM () + do! Raft.sendAllAppendEntries () expect "Should have prevLogIdx 4" (index 4) AppendEntries.prevLogIdx (!appendReq |> Option.get) expect "Should have prevLogTerm 4" (term 4) AppendEntries.prevLogTerm (!appendReq |> Option.get) - let! trm = Raft.currentTermM () + let! trm = currentTerm () do! Raft.receiveAppendEntriesResponse peer.Id { response with Term = trm; Success = false; CurrentIndex = index 1 } - do! expectM "Should have NextIdx 2" (index 2) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) - do! expectM "Should have MatchIdx 2" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.matchIndex) + do! expectM "Should have NextIdx 2" (index 2) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have MatchIdx 2" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) do! expectM "Should have 2 msgs" 2 (konst !count) - do! Raft.sendAllAppendEntriesM () + do! Raft.sendAllAppendEntries () expect "Should have prevLogIdx 1" (index 1) AppendEntries.prevLogIdx (!appendReq |> Option.get) expect "Should have prevLogTerm 1" (term 1) AppendEntries.prevLogTerm (!appendReq |> Option.get) @@ -1655,13 +1655,13 @@ module ServerTests = FirstIndex = index 0 } raft { - do! Raft.addMemberM peer - do! Raft.setTermM !trm - do! Raft.setCommitIndexM (index 0) + do! addMember peer + do! setCurrentTerm !trm + do! setCommitIndex (index 0) for n in 1 .. 4 do do! LogEntry(DiscoId.Create(),0,term n,DataSnapshot(State.Empty),None) - |> Raft.appendEntryM + |> Raft.appendEntry >>= ignoreM ci := 0 @@ -1670,26 +1670,26 @@ module ServerTests = do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should have correct NextIndex" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) - do! expectM "Should have correct MatchIndex" (index 0) (Raft.getMember peer.Id >> Option.get >> Member.matchIndex) + do! expectM "Should have correct NextIndex" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have correct MatchIndex" (index 0) (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) do! expectM "Should have been called once" 1 (konst !count) // need to get updated peer, because nextIdx will be bumped when // becoming leader! - let! peer = Raft.getMemberM peer.Id >>= (Option.get >> returnM) + let! peer = getMember peer.Id >>= (Option.get >> returnM) // we pretend that the follower `peer` has now successfully appended those logs - let! t = Raft.currentTermM () + let! t = currentTerm () trm := t ci := (index 4) result := true // send again and process responses - do! Raft.sendAllAppendEntriesM () + do! Raft.sendAllAppendEntries () do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should finally have NextIndex 5" (index 5) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) - do! expectM "Should finally have MatchIndex 4" (index 4) (Raft.getMember peer.Id >> Option.get >> Member.matchIndex) + do! expectM "Should finally have NextIndex 5" (index 5) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should finally have MatchIndex 4" (index 4) (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) do! expectM "Should have been called twice" 2 (konst !count) } |> runWithCBS cbs @@ -1726,13 +1726,13 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addMembersM peers - do! Raft.setTermM (term 1) - do! Raft.setCommitIndexM (index 0) - do! Raft.setStateM Leader - do! Raft.setLastAppliedIdxM (index 0) + do! addMembers peers + do! setCurrentTerm 1 + do! setCommitIndex (index 0) + do! setState Leader + do! setLastAppliedIndex (index 0) - do! Raft.appendEntryM log >>= ignoreM + do! Raft.appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer1 @@ -1749,11 +1749,11 @@ module ServerTests = testCase "leader recv entry resets election timeout" <| fun _ -> let log = LogEntry(DiscoId.Create(), index 0, term 1, DataSnapshot (State.Empty), None) raft { - do! Raft.setElectionTimeoutM 1000 - do! Raft.setStateM Leader + do! setElectionTimeout 1000 + do! setState Leader do! Raft.periodic 1000 let! response = Raft.receiveEntry log - do! expectM "Should have reset timeout elapsed" 0 Raft.timeoutElapsed + do! expectM "Should have reset timeout elapsed" 0 RaftState.timeoutElapsed } |> runWithDefaults |> noError @@ -1764,15 +1764,15 @@ module ServerTests = let log = LogEntry(DiscoId.Create(), index 0, term 1, DataSnapshot (State.Empty), None) raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader + do! addMember peer + do! setState Leader - do! Raft.setCommitIndexM (index 0) + do! setCommitIndex (index 0) let! response = Raft.receiveEntry log let! committed = Raft.responseCommitted response expect "Should not have committed" false id committed - do! Raft.setCommitIndexM (index 1) + do! setCommitIndex (index 1) let! response = Raft.receiveEntry log let! committed = Raft.responseCommitted response expect "Should have committed" true id committed @@ -1798,12 +1798,12 @@ module ServerTests = |> Error.asRaftError "Raft.responseCommitted" raft { - do! Raft.addMemberM peer - do! Raft.setStateM Leader - do! Raft.setCommitIndexM (index 0) - do! Raft.setTermM (term 1) + do! addMember peer + do! setState Leader + do! setCommitIndex (index 0) + do! setCurrentTerm 1 - do! expectM "Should have current idx 0" (index 0) Raft.currentIndex + do! expectM "Should have current idx 0" (index 0) RaftState.currentIndex let! response = Raft.receiveEntry log let! committed = Raft.responseCommitted response @@ -1812,15 +1812,15 @@ module ServerTests = expect "Should have term 1" (term 1) EntryResponse.term response expect "Should have index 1" (index 1) EntryResponse.index response - do! expectM "(1) Should have current idx 1" (index 1) Raft.currentIndex - do! expectM "Should have commit idx 0" (index 0) Raft.commitIndex + do! expectM "(1) Should have current idx 1" (index 1) RaftState.currentIndex + do! expectM "Should have commit idx 0" (index 0) RaftState.commitIndex let! resp = Raft.receiveAppendEntries (Some peer.Id) ae expect "Should have succeeded" true AppendResponse.succeeded resp - do! expectM "(2) Should have current idx 1" (index 1) Raft.currentIndex - do! expectM "Should have commit idx 1" (index 1) Raft.commitIndex + do! expectM "(2) Should have current idx 1" (index 1) RaftState.currentIndex + do! expectM "Should have commit idx 1" (index 1) RaftState.commitIndex return! Raft.responseCommitted response } @@ -1843,12 +1843,12 @@ module ServerTests = let log = Log.make (term 1) defSM raft { - do! Raft.addMemberM peer - do! Raft.setStateM Leader - do! Raft.setTermM (term 1) - do! Raft.setCommitIndexM (index 0) - do! Raft.setNextIndexM peer.Id (index 1) - do! Raft.appendEntryM log >>= ignoreM + do! addMember peer + do! setState Leader + do! setCurrentTerm 1 + do! setCommitIndex (index 0) + do! setNextIndex peer.Id (index 1) + do! Raft.appendEntry log >>= ignoreM let! response = Raft.receiveEntry log !sender.Outbox @@ -1877,18 +1877,18 @@ module ServerTests = } raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader - do! Raft.setTermM (term 1) - do! Raft.setCommitIndexM (index 0) - do! Raft.appendEntryM log >>= ignoreM + do! addMember peer + do! setState Leader + do! setCurrentTerm 1 + do! setCommitIndex (index 0) + do! Raft.appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx Works 1" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx Works 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx Dont work 1" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx Dont work 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) } |> runWithRaft raft' cbs |> noError @@ -1911,12 +1911,12 @@ module ServerTests = } raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader - do! Raft.setTermM (term 1) - do! expectM "Should have nextIdx 1" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) + do! addMember peer + do! setState Leader + do! setCurrentTerm 1 + do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx 1" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) } |> runWithRaft raft' cbs |> noError @@ -1939,12 +1939,12 @@ module ServerTests = ; FirstIndex = index 1 } raft { - do! Raft.addPeerM peer - do! Raft.setStateM Leader - do! Raft.setTermM (term 2) - do! expectM "Should have nextIdx 1" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) + do! addMember peer + do! setState Leader + do! setCurrentTerm 2 + do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx 1" (index 1) (Raft.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) } |> runWithRaft raft' cbs |> noError @@ -1963,15 +1963,15 @@ module ServerTests = let! raft' = get let nid = Some raft'.Member.Id let pid = Some peer.Id - do! Raft.addMemberM peer - do! Raft.setStateM Leader - do! Raft.setLeaderM (Some raft'.Member.Id) - do! Raft.setTermM (term 5) - do! expectM "Should be leader" true Raft.isLeader - do! expectM "Should be leader" true (Raft.currentLeader >> ((=) nid)) + do! addMember peer + do! setState Leader + do! setLeader (Some raft'.Member.Id) + do! setCurrentTerm 5 + do! expectM "Should be leader" true RaftState.isLeader + do! expectM "Should be leader" true (RaftState.currentLeader >> ((=) nid)) let! response = Raft.receiveAppendEntries (Some peer.Id) ae - do! expectM "Should be follower" true Raft.isFollower - do! expectM "Should follow peer" true (Raft.currentLeader >> ((=) pid)) + do! expectM "Should be follower" true RaftState.isFollower + do! expectM "Should follow peer" true (RaftState.currentLeader >> ((=) pid)) } |> runWithDefaults |> noError @@ -1987,11 +1987,11 @@ module ServerTests = ; Entries = None } raft { - do! Raft.addMemberM peer - do! Raft.setStateM Leader - do! Raft.setTermM (term 5) + do! addMember peer + do! setState Leader + do! setCurrentTerm 5 let! response = Raft.receiveAppendEntries (Some peer.Id) resp - do! expectM "Should be follower" true Raft.isFollower + do! expectM "Should be follower" true RaftState.isFollower } |> runWithDefaults |> noError @@ -2023,18 +2023,18 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addMembersM peers - do! Raft.setElectionTimeoutM 1000 - do! Raft.setRequestTimeoutM 500 - do! expectM "Should have timout elapsed 0" 0 Raft.timeoutElapsed + do! addMembers peers + do! setElectionTimeout 1000 + do! setRequestTimeout 500 + do! expectM "Should have timout elapsed 0" 0 RaftState.timeoutElapsed - do! Raft.setStateM Candidate + do! setState Candidate do! Raft.becomeLeader () do! expectM "Should have 2 messages " 2 (konst !count) // update CurrentIndex to latest memIdx to prevent StaleResponse error - let! mem1 = Raft.getMemberM peer1.Id + let! mem1 = getMember peer1.Id response := { !response with CurrentIndex = Option.get mem1 |> Member.nextIndex |> ((+) (index 1)) } @@ -2065,13 +2065,13 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addMembersM peers - do! Raft.setElectionTimeoutM 1000 - do! Raft.setRequestTimeoutM 500 - do! expectM "Should have timout elapsed 0" 0 Raft.timeoutElapsed + do! addMembers peers + do! setElectionTimeout 1000 + do! setRequestTimeout 500 + do! expectM "Should have timout elapsed 0" 0 RaftState.timeoutElapsed do! Raft.startElection () do! Raft.receiveVoteResponse peer1.Id resp - do! expectM "Should be leader" Leader Raft.getState + do! expectM "Should be leader" Leader RaftState.state let! resp = Raft.receiveVoteRequest peer2.Id vote expect "Should have declined vote" true VoteResponse.declined resp } @@ -2099,16 +2099,16 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addMembersM peers - do! Raft.setElectionTimeoutM 1000 - do! Raft.setRequestTimeoutM 500 - do! expectM "Should have timout elapsed 0" 0 Raft.timeoutElapsed + do! addMembers peers + do! setElectionTimeout 1000 + do! setRequestTimeout 500 + do! expectM "Should have timout elapsed 0" 0 RaftState.timeoutElapsed do! Raft.startElection () do! Raft.receiveVoteResponse peer1.Id resp - do! expectM "Should be Leader" true Raft.isLeader + do! expectM "Should be Leader" true RaftState.isLeader let! resp = Raft.receiveVoteRequest peer2.Id vote - do! expectM "Should be Follower" true Raft.isFollower + do! expectM "Should be Follower" true RaftState.isFollower } |> runWithDefaults |> noError @@ -2123,7 +2123,7 @@ module ServerTests = let mutable i = 0 - let raft' = Raft.create mem1 + let raft' = RaftState.create mem1 let cbs = { Callbacks.Create (ref defSM) with SendRequestVote = fun _ _ -> i <- i + 1 } :> IRaftCallbacks @@ -2134,8 +2134,8 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addPeersM peers - do! Raft.setElectionTimeoutM 1000 + do! addMembers peers + do! setElectionTimeout 1000 do! Raft.periodic 1001 expect "Should have sent 3 requests" 3 id i } @@ -2158,11 +2158,11 @@ module ServerTests = |> Map.ofArray raft { - do! Raft.addPeersM peers - do! Raft.setElectionTimeoutM 1000 + do! addMembers peers + do! setElectionTimeout 1000 do! Raft.periodic 1001 do! Raft.receiveVoteResponse mem1.Id resp - do! expectM "Should be leader now" Leader Raft.getState + do! expectM "Should be leader now" Leader RaftState.state } |> runWithDefaults |> noError @@ -2173,18 +2173,18 @@ module ServerTests = raft { let trm = term 1 let depth = 40 - let! me = Raft.selfM () + let! me = self () - do! Raft.setMaxLogDepthM depth - do! Raft.setTermM trm + do! setMaxLogDepth depth + do! setCurrentTerm trm for n in 0 .. depth do - do! Raft.appendEntryM (Log.make trm defSM) >>= ignoreM + do! Raft.appendEntry (Log.make trm defSM) >>= ignoreM - do! Raft.setLeaderM (Some me.Id) - do! expectM "Should have correct number of entries" (depth + 1) Raft.numLogs + do! setLeader (Some me.Id) + do! expectM "Should have correct number of entries" (depth + 1) RaftState.numLogs do! Raft.periodic 10 - do! expectM "Should have correct number of entries" 1 Raft.numLogs + do! expectM "Should have correct number of entries" 1 RaftState.numLogs } |> runWithDefaults |> noError @@ -2212,10 +2212,10 @@ module ServerTests = ; Data = Snapshot(DiscoId.Create(), idx, trm, idx, trm, mems, defSM) } raft { - do! Raft.setTermM trm + do! setCurrentTerm trm let! response = Raft.receiveInstallSnapshot is - do! expectM "Should have correct number of mems" 4 Raft.numMembers // including our own mem - do! expectM "Should have correct number of log entries" 1 Raft.numLogs + do! expectM "Should have correct number of mems" 4 RaftState.numMembers // including our own mem + do! expectM "Should have correct number of log entries" 1 RaftState.numLogs expect "Should have called ApplyLog once" 1 id !count } |> runWithRaft init cbs @@ -2246,16 +2246,16 @@ module ServerTests = } raft { - do! Raft.setTermM trm + do! setCurrentTerm trm for n in 0 .. (int idx + num) do - do! Raft.appendEntryM (Log.make trm (DataSnapshot (State.Empty))) >>= ignoreM + do! Raft.appendEntry (Log.make trm (DataSnapshot (State.Empty))) >>= ignoreM do! Raft.applyEntries () let! response = Raft.receiveInstallSnapshot is - do! expectM "Should have correct number of mems" 4 Raft.numMembers // including our own mem - do! expectM "Should have correct number of log entries" 7 Raft.numLogs + do! expectM "Should have correct number of mems" 4 RaftState.numMembers // including our own mem + do! expectM "Should have correct number of log entries" 7 RaftState.numLogs expect "Should have called ApplyLog once" 7 id !count } |> runWithRaft init cbs @@ -2280,16 +2280,16 @@ module ServerTests = raft { let mem = Member.create (DiscoId.Create()) - do! Raft.setStateM Leader + do! setState Leader - do! Raft.appendEntryM (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberAdded(mem)|] ,None)) >>= ignoreM - do! Raft.setCommitIndexM (index 1) + do! Raft.appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberAdded(mem)|] ,None)) >>= ignoreM + do! setCommitIndex (index 1) do! Raft.applyEntries () expect "Should have count 1" 1 id !count - do! Raft.appendEntryM (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberRemoved mem |] ,None)) >>= ignoreM - do! Raft.setCommitIndexM (index 3) + do! Raft.appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberRemoved mem |] ,None)) >>= ignoreM + do! setCommitIndex (index 3) do! Raft.applyEntries () expect "Should have count 2" 2 id !count @@ -2319,11 +2319,11 @@ module ServerTests = [ log3; log2; log1; ] |> List.map LogEntry.id - do! Raft.setStateM Leader + do! setState Leader - do! Raft.appendEntryM log1 >>= ignoreM - do! Raft.appendEntryM log2 >>= ignoreM - do! Raft.appendEntryM log3 >>= ignoreM + do! Raft.appendEntry log1 >>= ignoreM + do! Raft.appendEntry log2 >>= ignoreM + do! Raft.appendEntry log3 >>= ignoreM expect "should have correct ids" ids id !count } @@ -2350,20 +2350,20 @@ module ServerTests = } :> IRaftCallbacks raft { - do! Raft.setStateM Leader + do! setState Leader - do! Raft.appendEntryM log1 >>= ignoreM - do! Raft.appendEntryM log2 >>= ignoreM - do! Raft.appendEntryM log3 >>= ignoreM + do! Raft.appendEntry log1 >>= ignoreM + do! Raft.appendEntry log2 >>= ignoreM + do! Raft.appendEntry log3 >>= ignoreM - do! Raft.removeEntryM (index 3) - do! expectM "Should have only 2 entries" 2 Raft.numLogs + do! Raft.removeEntry 3 + do! expectM "Should have only 2 entries" 2 RaftState.numLogs - do! Raft.removeEntryM (index 2) - do! expectM "Should have only 1 entry" 1 Raft.numLogs + do! Raft.removeEntry 2 + do! expectM "Should have only 1 entry" 1 RaftState.numLogs - do! Raft.removeEntryM (index 1) - do! expectM "Should have zero entries" 0 Raft.numLogs + do! Raft.removeEntry 1 + do! expectM "Should have zero entries" 0 RaftState.numLogs expect "should have deleted all logs" List.empty id !count } @@ -2381,10 +2381,10 @@ module ServerTests = raft { let mem = Member.create (DiscoId.Create()) - do! Raft.addMemberM mem - do! Raft.updateMemberM { mem with Status = MemberStatus.Joining } - do! Raft.updateMemberM { mem with Status = MemberStatus.Running } - do! Raft.updateMemberM { mem with Status = MemberStatus.Failed } + do! addMember mem + do! updateMember { mem with Status = MemberStatus.Joining } + do! updateMember { mem with Status = MemberStatus.Running } + do! updateMember { mem with Status = MemberStatus.Failed } expect "Should have called once" 3 id !count } @@ -2413,7 +2413,7 @@ module ServerTests = let trm = term 1 raft { - do! Raft.setTermM trm + do! setCurrentTerm trm do! Raft.becomeLeader () let! response = Log.make trm defSM |> Raft.receiveEntry @@ -2428,18 +2428,18 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) do! Raft.becomeFollower () - do! Raft.addMemberM peer + do! addMember peer - let! trm = Raft.currentTermM () - let! ci = Raft.currentIndexM () - let! fi = Raft.firstIndexM trm + let! trm = currentTerm () + let! ci = currentIndex () + let! fi = firstIndex trm let ping : AppendEntries = { Term = trm - ; PrevLogIdx = ci - ; PrevLogTerm = trm - ; LeaderCommit = ci - ; Entries = None } + PrevLogIdx = ci + PrevLogTerm = trm + LeaderCommit = ci + Entries = None } let! response = Raft.receiveAppendEntries (Some peer.Id) ping @@ -2460,10 +2460,10 @@ module ServerTests = :> IRaftCallbacks raft { - do! Raft.setTermM (term 1) + do! setCurrentTerm 1 do! Raft.becomeLeader () - let! term = Raft.currentTermM () + let! term = currentTerm () let log = Log.make term defSM let! result = Raft.receiveEntry log From 5ba394f6714d636c4436df3ca9a3fcc8640bffce Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Thu, 8 Feb 2018 16:59:48 +0100 Subject: [PATCH 09/27] groom Raft module even more --- src/Disco/Disco/Raft/Raft.fs | 551 +++++------------- src/Disco/Disco/Raft/RaftMonad.fs | 94 +++ src/Disco/Disco/Raft/RaftState.fs | 76 +++ .../Disco/Tests/Raft/AppendEntriesTests.fs | 6 +- src/Disco/Disco/Tests/Raft/ServerTests.fs | 120 ++-- 5 files changed, 387 insertions(+), 460 deletions(-) diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index 93013ead..b561952b 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -35,11 +35,13 @@ module rec Raft = |> not let peers = - if parting then // we have been kicked out of the configuration - [| (state.Member.Id, state.Member) |] - |> Map.ofArray - else // we are still part of the new cluster configuration - Array.map toPair mems + if parting + // we have been kicked out of the configuration + then Map [(state.Member.Id, state.Member)] + // we are still part of the new cluster configuration + else + mems + |> Array.map toPair |> Map.ofArray state @@ -49,94 +51,21 @@ module rec Raft = // ** handleJointConsensus let private handleJointConsensus (changes) (state:RaftState) = - let old = state.Peers state |> RaftState.applyChanges changes - |> RaftState.setOldPeers (Some old) - - // ** appendEntry - - let appendEntry (entry: LogEntry) = - raft { - let! current = log () - - // create the new log by appending - let newlog = Log.append entry current - do! setLog newlog - - // get back the entries just added - // (with correct monotonic idx's) - let result = Log.getn (LogEntry.depth entry) newlog - - match result with - | Some entries -> do! persistLog entries - | _ -> () - - return result - } - - // ** createEntry - - let createEntry (entry: StateMachine) = - raft { - let! term = currentTerm () - let log = LogEntry.create 0 term entry - return! appendEntry log - } - - // ** updateLogEntries + |> RaftState.setOldPeers (Some state.Peers) - let updateLogEntries (entries: LogEntry) (state: RaftState) = - { state with - Log = { Index = LogEntry.index entries - Depth = LogEntry.depth entries - Data = Some entries } } - - // ** removeEntry - - /// Delete a log entry at the index specified. Returns the original value if - /// the record is not found. - - let removeEntry idx = - raft { - let! env = read - let! current = log () - match Log.at idx current with - | Some log -> - match LogEntry.pop log with - | Some newlog -> - // fire delete log callback for all removed items - match Log.until idx current with - | Some items -> LogEntry.iter (fun _ entry -> do env.DeleteLog entry) items - | _ -> () - // save the modified log to state - do! modify (updateLogEntries newlog) - | _ -> - do env.DeleteLog log - do! modify (RaftState.setLog Log.empty) - | _ -> () - } - - // ** makeResponse - - ///////////////////////////////////////////////////////////////////////////// - // _ Receive _ _____ _ _ // - // / \ _ __ _ __ ___ _ __ __| | ____|_ __ | |_ _ __(_) ___ ___ // - // / _ \ | '_ \| '_ \ / _ \ '_ \ / _` | _| | '_ \| __| '__| |/ _ \/ __| // - // / ___ \| |_) | |_) | __/ | | | (_| | |___| | | | |_| | | | __/\__ \ // - // /_/ \_\ .__/| .__/ \___|_| |_|\__,_|_____|_| |_|\__|_| |_|\___||___/ // - // |_| |_| // - ///////////////////////////////////////////////////////////////////////////// + // ** createResponse /// Preliminary Checks on the AppendEntry value - let private makeResponse (nid: MemberId option) (msg: AppendEntries) = - raft { - let! state = get + let private createResponse (nid: MemberId option) (msg: AppendEntries) = + raft { let! term = currentTerm () let! current = currentIndex () let! first = firstIndex term >>= (Option.defaultValue 0 >> returnM) + let resp: AppendResponse = { Term = term Success = false @@ -181,9 +110,10 @@ module rec Raft = // If an existing entry conflicts with a new one (same index // but different terms), delete the existing entry and all that // follow it (§5.3) + let private handleConflicts (request: AppendEntries) = raft { - let idx = request.PrevLogIdx + index 1 + let idx = request.PrevLogIdx + 1 let! local = entryAt idx match request.Entries with @@ -224,11 +154,11 @@ module rec Raft = | _ -> return resp } - // ** maybeSetCommitIdx + // ** requestSetCommitIndex /// If leaderCommit > commitIndex, set commitIndex = /// min(leaderCommit, index of most recent entry) - let private maybeSetCommitIdx (msg : AppendEntries) = + let private requestSetCommitIndex (msg : AppendEntries) = raft { let! state = get let! cmmtidx = commitIndex () @@ -246,7 +176,7 @@ module rec Raft = raft { do! handleConflicts msg let! response = applyRemainder msg resp - do! maybeSetCommitIdx msg + do! requestSetCommitIndex msg do! setLeader nid return AppendResponse.setSuccess true resp } @@ -255,6 +185,7 @@ module rec Raft = /// 2. Reply false if log doesn't contain an entry at prevLogIndex whose /// term matches prevLogTerm (§5.3) + let private checkAndProcess entry nid msg resp = raft { let! current = currentIndex () @@ -273,30 +204,20 @@ module rec Raft = current msg.PrevLogIdx |> error "receiveAppendEntries" - let response = { resp with CurrentIndex = msg.PrevLogIdx - index 1 } do! removeEntry msg.PrevLogIdx - return response + return AppendResponse.setCurrentIndex (msg.PrevLogIdx - 1) resp else return! processEntry nid msg resp } // ** updateMemberIndices - ///////////////////////////////////////////////////////////////////////////// - // _ _ _____ _ _ // - // / \ _ __ _ __ ___ _ __ __| | ____|_ __ | |_ _ __(_) ___ ___ // - // / _ \ | '_ \| '_ \ / _ \ '_ \ / _` | _| | '_ \| __| '__| |/ _ \/ __| // - // / ___ \| |_) | |_) | __/ | | | (_| | |___| | | | |_| | | | __/\__ \ // - // /_/ \_\ .__/| .__/ \___|_| |_|\__,_|_____|_| |_|\__|_| |_|\___||___/ // - // |_| |_| // - ///////////////////////////////////////////////////////////////////////////// - let private updateMemberIndices (resp : AppendResponse) (mem : RaftMember) = raft { let peer = - { mem with - NextIndex = resp.CurrentIndex + index 1 - MatchIndex = resp.CurrentIndex } + mem + |> Member.setNextIndex (resp.CurrentIndex + 1) + |> Member.setMatchIndex resp.CurrentIndex let! current = currentIndex () @@ -314,16 +235,16 @@ module rec Raft = // ** shouldCommit let private shouldCommit peers state resp = - let folder (votes : int) nid (mem : RaftMember) = - if nid = state.Member.Id || not (Member.isVoting mem) then - votes + let folder (votes: int) nid (mem: RaftMember) = + if nid = state.Member.Id || not (Member.isVoting mem) + then votes elif mem.MatchIndex > 0 then match RaftState.entryAt mem.MatchIndex state with - | Some entry -> - if LogEntry.term entry = state.CurrentTerm && resp.CurrentIndex <= mem.MatchIndex - then votes + 1 - else votes - | _ -> votes + | Some entry -> + if LogEntry.term entry = state.CurrentTerm && resp.CurrentIndex <= mem.MatchIndex + then votes + 1 + else votes + | _ -> votes else votes let commit = RaftState.commitIndex state @@ -332,12 +253,11 @@ module rec Raft = (num / 2) < votes && commit < resp.CurrentIndex - // ** updateCommitIndex + // ** responseSetCommitIndex - let private updateCommitIndex (resp : AppendResponse) = + let private responseSetCommitIndex (resp: AppendResponse) = raft { let! state = get - let! inConsensus = inJointConsensus () let commitOk = if inConsensus then @@ -351,7 +271,6 @@ module rec Raft = else // the base case, not in joint consensus shouldCommit state.Peers state resp - if commitOk then do! setCommitIndex resp.CurrentIndex } @@ -365,23 +284,23 @@ module rec Raft = // log this if any entries are to be processed if Option.isSome msg.Entries then let! current = currentIndex () - let str = - sprintf "from: %A term: %d (ci: %d) (lc-idx: %d) (pli: %d) (plt: %d) (entries: %d)" - nid - msg.Term - current - msg.LeaderCommit - msg.PrevLogIdx - msg.PrevLogTerm - (Option.get msg.Entries |> LogEntry.depth) // let the world know - do! debug "receiveAppendEntries" str - - let! result = makeResponse nid msg // check terms et al match, fail otherwise + + do! sprintf "from: %A term: %d (ci: %d) (lc-idx: %d) (pli: %d) (plt: %d) (entries: %d)" + nid + msg.Term + current + msg.LeaderCommit + msg.PrevLogIdx + msg.PrevLogTerm + (Option.get msg.Entries |> LogEntry.depth) // let the world know + |> debug "receiveAppendEntries" + + let! result = createResponse nid msg // check terms et al match, fail otherwise match result with | Right resp -> // this is not the first AppendEntry we're receiving - if msg.PrevLogIdx > index 0 then + if msg.PrevLogIdx > 0 then let! entry = entryAt msg.PrevLogIdx match entry with | Some log -> @@ -416,21 +335,20 @@ module rec Raft = |> failM | Some peer -> if resp.CurrentIndex <> index 0 && resp.CurrentIndex < peer.MatchIndex then - let str = sprintf "Failed: peer not up to date yet (ci: %d) (match idx: %d)" - resp.CurrentIndex - peer.MatchIndex - do! error "receiveAppendEntriesResponse" str + do! sprintf "Failed: peer not up to date yet (ci: %d) (match idx: %d)" + resp.CurrentIndex + peer.MatchIndex + |> error "receiveAppendEntriesResponse" // set to current index at follower and try again - do! updateMember { peer with - NextIndex = resp.CurrentIndex + 1 - MatchIndex = resp.CurrentIndex } - return () + do! peer + |> Member.setNextIndex (resp.CurrentIndex + 1) + |> Member.setMatchIndex resp.CurrentIndex + |> updateMember else - let! state = get - + let! leader = isLeader () // we only process this if we are indeed the leader of the pack - if RaftState.isLeader state then - let term = RaftState.currentTerm state + if leader then + let! term = currentTerm () // If response contains term T > currentTerm: set currentTerm = T // and convert to follower (§5.3) if term < resp.Term then @@ -466,7 +384,7 @@ module rec Raft = do! setMatchIndex peer.Id (nextIndex - index 1) else do! updateMemberIndices resp peer - do! updateCommitIndex resp + do! responseSetCommitIndex resp else return! "Not Leader" @@ -521,26 +439,16 @@ module rec Raft = raft { let! self = self () let! peers = logicalPeers () - for KeyValue(id,peer) in peers do if id <> self.Id then do! sendAppendEntry peer - do! setTimeoutElapsed 0 } // ** createSnapshot - /////////////////////////////////////////////////// - // ____ _ _ // - // / ___| _ __ __ _ _ __ ___| |__ ___ | |_ // - // \___ \| '_ \ / _` | '_ \/ __| '_ \ / _ \| __| // - // ___) | | | | (_| | |_) \__ \ | | | (_) | |_ // - // |____/|_| |_|\__,_| .__/|___/_| |_|\___/ \__| // - // |_| // - /////////////////////////////////////////////////// - /// utiltity to create a snapshot for the current application and raft state + let createSnapshot (state: RaftState) (data: StateMachine) = let peers = Map.toArray state.Peers |> Array.map snd Log.snapshot peers data state.Log @@ -549,61 +457,43 @@ module rec Raft = let sendInstallSnapshot mem = raft { - let! state = get - let! cbs = read - - match cbs.RetrieveSnapshot () with + let! env = read + let! term = currentTerm() + let! leader = self () >>= (Member.id >> returnM) + match env.RetrieveSnapshot () with | Some (Snapshot(_,idx,term,_,_,_,_) as snapshot) -> - let is = - { Term = state.CurrentTerm - ; LeaderId = state.Member.Id - ; LastIndex = idx - ; LastTerm = term - ; Data = snapshot - } - cbs.SendInstallSnapshot mem is + env.SendInstallSnapshot mem { + Term = term + LeaderId = leader + LastIndex = idx + LastTerm = term + Data = snapshot + } | _ -> () } // ** responseCommitted - /////////////////////////////////////////////////////////////////// - // ____ _ _____ _ // - // | _ \ ___ ___ ___(_)_ _____ | ____|_ __ | |_ _ __ _ _ // - // | |_) / _ \/ __/ _ \ \ \ / / _ \ | _| | '_ \| __| '__| | | | // - // | _ < __/ (_| __/ |\ V / __/ | |___| | | | |_| | | |_| | // - // |_| \_\___|\___\___|_| \_/ \___| |_____|_| |_|\__|_| \__, | // - // |___/ // - /////////////////////////////////////////////////////////////////// - /// Check if an entry corresponding to a receiveEntry result has actually been /// committed to the state machine. + let responseCommitted (resp : EntryResponse) = raft { let! entry = entryAt resp.Index match entry with - | None -> return false - | Some entry -> - if resp.Term <> LogEntry.term entry then - return! - "Entry Invalidated" - |> Error.asRaftError (tag "responseCommitted") - |> failM - else - let! cidx = commitIndex () - return resp.Index <= cidx + | None -> return false + | Some entry -> + if resp.Term <> LogEntry.term entry + then + return! + "Entry Invalidated" + |> Error.asRaftError (tag "responseCommitted") + |> failM + else + let! cidx = commitIndex () + return resp.Index <= cidx } - // ** updateCommitIdx - - let private updateCommitIdx (state: RaftState) = - let idx = - if state.NumMembers = 1 then - RaftState.currentIndex state - else - state.CommitIndex - { state with CommitIndex = idx } - // ** handleLog let private handleLog entry resp = @@ -612,13 +502,14 @@ module rec Raft = match result with | Some appended -> - let! state = get + let! selfId = self () >>= (Member.id >> returnM) + let! maxDepth = maxLogDepth () let! peers = logicalPeers () // iterate through all peers and call sendAppendEntries to each for peer in peers do let mem = peer.Value - if mem.Id <> state.Member.Id then + if mem.Id <> selfId then let nxtidx = Member.nextIndex mem let! cidx = currentIndex () @@ -628,7 +519,7 @@ module rec Raft = let d = cidx - nxtidx if d < 0 then 0 else d - if difference <= (index (int state.MaxLogDepth) + 1) then + if difference <= (index (int maxDepth) + 1) then // Only send new entries. Don't send the entry to peers who are // behind, to prevent them from becoming congested. do! sendAppendEntry mem @@ -637,7 +528,7 @@ module rec Raft = // with a snapshot do! sendInstallSnapshot mem - do! updateCommitIdx |> modify + do! updateCommitIndex () let! term = currentTerm () return { resp with @@ -655,23 +546,26 @@ module rec Raft = let receiveEntry (entry: LogEntry) = raft { - let! state = get - let response = EntryResponse.create 0 0 + let! leader = isLeader () + let! configChange = configChangeEntry() - if LogEntry.isConfigChange entry && Option.isSome state.ConfigChangeEntry then + if LogEntry.isConfigChange entry && Option.isSome configChange then do! debug "receiveEntry" "Error: UnexpectedVotingChange" return! "Unexpected Voting Change" |> Error.asRaftError (tag "receiveEntry") |> failM - elif RaftState.isLeader state then - do! state.CurrentTerm + elif leader then + let! term = currentTerm() + let! idx = log () >>= (Log.index >> returnM) + + do! term |> sprintf "(id: %A) (idx: %d) (term: %d)" (LogEntry.id entry) - (Log.index state.Log + 1) + (idx + 1) |> debug "receiveEntry" - let! term = currentTerm () + let response = EntryResponse.create 0 0 match entry with | LogEntry(id,_,_,data,_) -> @@ -698,34 +592,6 @@ module rec Raft = |> failM } - // ** calculateChanges - - //////////////////////////////////////////////////////////////// - // _ _ _____ _ // - // / \ _ __ _ __ | |_ _ | ____|_ __ | |_ _ __ _ _ // - // / _ \ | '_ \| '_ \| | | | | | _| | '_ \| __| '__| | | | // - // / ___ \| |_) | |_) | | |_| | | |___| | | | |_| | | |_| | // - // /_/ \_\ .__/| .__/|_|\__, | |_____|_| |_|\__|_| \__, | // - // |_| |_| |___/ |___/ // - //////////////////////////////////////////////////////////////// - let calculateChanges (oldPeers: Map) (newPeers: Map) = - let oldmems = Map.toArray oldPeers |> Array.map snd - let newmems = Map.toArray newPeers |> Array.map snd - - let additions = - Array.fold - (fun lst (newmem: RaftMember) -> - match Array.tryFind (Member.id >> (=) newmem.Id) oldmems with - | Some _ -> lst - | _ -> MemberAdded(newmem) :: lst) [] newmems - - Array.fold - (fun lst (oldmem: RaftMember) -> - match Array.tryFind (Member.id >> (=) oldmem.Id) newmems with - | Some _ -> lst - | _ -> MemberRemoved(oldmem) :: lst) additions oldmems - |> List.toArray - // ** notifyChange let notifyChange (cbs: IRaftCallbacks) change = @@ -774,7 +640,7 @@ module rec Raft = let newstate = handleConfiguration mems state // when a new configuration is added, under certain circumstances a mem change // might not have been applied yet, so calculate those dangling changes - let changes = calculateChanges state.Peers newstate.Peers + let changes = RaftState.calculateChanges state.Peers newstate.Peers // apply dangling changes do Array.iter (notifyChange cbs) changes // apply the entry by calling the callback @@ -833,28 +699,14 @@ module rec Raft = // ** receiveInstallSnapshot (* - * ____ _ - * | _ \ ___ ___ ___(_)_ _____ - * | |_) / _ \/ __/ _ \ \ \ / / _ \ - * | _ < __/ (_| __/ |\ V / __/ - * |_| \_\___|\___\___|_| \_/ \___| - * - * ___ _ _ _ ____ _ _ - * |_ _|_ __ ___| |_ __ _| | / ___| _ __ __ _ _ __ ___| |__ ___ | |_ - * | || '_ \/ __| __/ _` | | \___ \| '_ \ / _` | '_ \/ __| '_ \ / _ \| __| - * | || | | \__ \ || (_| | | |___) | | | | (_| | |_) \__ \ | | | (_) | |_ - * |___|_| |_|___/\__\__,_|_|_|____/|_| |_|\__,_| .__/|___/_| |_|\___/ \__| - * |_| - * +-------------------------------------------------------------------------------------------------------------------------------+ - * | 1. Reply immediately if term < currentTerm | - * | 2. Create new snapshot file if first chunk (offset is 0) | - * | 3. Write data into snapshot file at given offset | - * | 4. Reply and wait for more data chunks if done is false | - * | 5. Save snapshot file, discard any existing or partial snapshot with a smaller index | - * | 6. If existing log entry has same index and term as snapshot’s last included entry, retain log entries following it and reply | - * | 7. Discard the entire log | - * | 8. Reset state machine using snapshot contents (and load snapshot’s cluster configuration) | - * +-------------------------------------------------------------------------------------------------------------------------------+ + * 1. Reply immediately if term < currentTerm + * 2. Create new snapshot file if first chunk (offset is 0) + * 3. Write data into snapshot file at given offset + * 4. Reply and wait for more data chunks if done is false + * 5. Save snapshot file, discard any existing or partial snapshot with a smaller index + * 6. If existing log entry has same index and term as snapshot’s last included entry, retain log entries following it and reply + * 7. Discard the entire log + * 8. Reset state machine using snapshot contents (and load snapshot’s cluster configuration) *) let receiveInstallSnapshot (is: InstallSnapshot) = raft { @@ -873,7 +725,7 @@ module rec Raft = | Snapshot(_,idx,_,_,_,mems, _) as snapshot -> // IMPROVEMENT: implementent chunked transmission as per paper - cbs.PersistSnapshot snapshot + do cbs.PersistSnapshot snapshot let! state = get @@ -902,10 +754,11 @@ module rec Raft = // apply all entries in the new log let! state = get + match state.Log.Data with - | Some data -> - LogEntry.foldr (fun _ entry -> applyEntry cbs entry) () data - | _ -> failwith "Fatal. Snapshot applied, but log is empty. Aborting." + | Some data -> + LogEntry.foldr (fun _ entry -> applyEntry cbs entry) () data + | _ -> failwith "Fatal. Snapshot applied, but log is empty. Aborting." // reset the counters,to apply all entries in the log do! setLastAppliedIndex (Log.index state.Log) @@ -914,17 +767,14 @@ module rec Raft = // construct reply let! term = currentTerm () let! ci = currentIndex () - let! fi = firstIndex term - - let ar : AppendResponse = - { Term = term - Success = true - CurrentIndex = ci - FirstIndex = match fi with - | Some i -> i - | _ -> index 0 } + let! fi = firstIndex term >>= (Option.defaultValue 0 >> returnM) - return ar + return { + Term = term + Success = true + CurrentIndex = ci + FirstIndex = fi + } | _ -> return! "Snapshot Format Error" @@ -956,96 +806,8 @@ module rec Raft = do! doSnapshot () } - // ** majority - - /////////////////////////////////////////////// - // _____ _ _ _ // - // | ____| | ___ ___| |_(_) ___ _ __ ___ // - // | _| | |/ _ \/ __| __| |/ _ \| '_ \/ __| // - // | |___| | __/ (__| |_| | (_) | | | \__ \ // - // |_____|_|\___|\___|\__|_|\___/|_| |_|___/ // - /////////////////////////////////////////////// - - /// ## majority - /// - /// Determine the majority from a total number of eligible voters and their respective votes. This - /// function is generic and should expect any numeric types. - /// - /// Turning off the warning about the cast due to sufficiently constrained requirements on the - /// input type (op_Explicit, comparison and division). - /// - /// ### Signature: - /// - total: the total number of votes cast - /// - yays: the number of yays in this election - /// - /// Returns: boolean - let majority total yays = - if total = 0 || yays = 0 then - false - elif yays > total then - false - else - yays > (total / 2) - - // ** regularMajorityM - - /// Determine whether a vote count constitutes a majority in the *regular* - /// configuration (does not cover the joint consensus state). - let regularMajorityM votes = - votingMembers () >>= fun num -> - majority num votes |> returnM - - // ** oldConfigMajorityM - - let oldConfigMajorityM votes = - votingMembersForOldConfig () >>= fun num -> - majority num votes |> returnM - - // ** numVotesForConfig - - let numVotesForConfig (self: RaftMember) (votedFor: MemberId option) peers = - let counter m _ (peer : RaftMember) = - if (peer.Id <> self.Id) && Member.canVote peer - then m + 1 - else m - - let start = - match votedFor with - | Some(nid) -> if nid = self.Id then 1 else 0 - | _ -> 0 - - Map.fold counter start peers - - // ** numVotesForMe - - let numVotesForMe (state: RaftState) = - numVotesForConfig state.Member state.VotedFor state.Peers - - // ** numVotesForMeM - - let numVotesForMeM _ = zoom numVotesForMe - - // ** numVotesForMeOldConfig - - let numVotesForMeOldConfig (state: RaftState) = - match state.OldPeers with - | Some peers -> numVotesForConfig state.Member state.VotedFor peers - | _ -> 0 - - // ** numVotesForMeOldConfigM - - let numVotesForMeOldConfigM _ = zoom numVotesForMeOldConfig - // ** maybeSetIndex - ///////////////////////////////////////////////////////////////////////////// - // ____ _ _ // - // | __ ) ___ ___ ___ _ __ ___ ___ | | ___ __ _ __| | ___ _ __ // - // | _ \ / _ \/ __/ _ \| '_ ` _ \ / _ \ | | / _ \/ _` |/ _` |/ _ \ '__| // - // | |_) | __/ (_| (_) | | | | | | __/ | |__| __/ (_| | (_| | __/ | // - // |____/ \___|\___\___/|_| |_| |_|\___| |_____\___|\__,_|\__,_|\___|_| // - ///////////////////////////////////////////////////////////////////////////// - let private maybeSetIndex nid nextIdx matchIdx = updateMembers $ fun peer -> if Member.isVoting peer && peer.Id <> nid then @@ -1188,11 +950,8 @@ module rec Raft = // \___/ \___/|_|_| |_|\__| consensus. // // we probe for a majority in both configurations - let! newConfig = - numVotesForMeM () >>= regularMajorityM - - let! oldConfig = - numVotesForMeOldConfigM () >>= oldConfigMajorityM + let! newConfig = numVotesForMe () >>= regularMajority + let! oldConfig = numVotesForMeOldConfig () >>= oldConfigMajority do! sprintf "In JointConsensus (majority new config: %b) (majority old config: %b)" newConfig @@ -1212,8 +971,7 @@ module rec Raft = // |___/ // the base case: we are not in joint consensus so we just use // regular configuration functions - let! majority = - numVotesForMeM () >>= regularMajorityM + let! majority = numVotesForMe () >>= regularMajority do! sprintf "(majority for config: %b)" majority |> debug "receiveVoteResponse" @@ -1227,20 +985,19 @@ module rec Raft = /// Request a from a given peer let sendVoteRequest (mem : RaftMember) = raft { - let! state = get + let! term = currentTerm() + let! self = self() + let! log = log() let! cbs = read - - let vote = - { Term = state.CurrentTerm - Candidate = state.Member - LastLogIndex = Log.index state.Log - LastLogTerm = Log.term state.Log } - do! mem.Status |> sprintf "(to: %s) (state: %A)" (string mem.Id) |> debug "sendVoteRequest" - - cbs.SendRequestVote mem vote + do cbs.SendRequestVote mem { + Term = term + Candidate = self + LastLogIndex = Log.index log + LastLogTerm = Log.term log + } } // ** requestAllVotes @@ -1361,31 +1118,31 @@ module rec Raft = raft { let! result = shouldGrantVote vote match result with - | (true,_) -> - let! leader = isLeader () - let! candidate = isCandidate () - if not leader && not candidate then - do! voteForId vote.Candidate.Id - do! setTimeoutElapsed 0 - let! term = currentTerm () - return { - Term = term - Granted = true - Reason = None - } - else - do! debug "processVoteRequest" "vote request denied: NotVotingState" - return! - "Not Voting State" - |> Error.asRaftError (tag "processVoteRequest") - |> failM - | (false, err) -> + | (true,_) -> + let! leader = isLeader () + let! candidate = isCandidate () + if not leader && not candidate then + do! voteForId vote.Candidate.Id + do! setTimeoutElapsed 0 let! term = currentTerm () return { Term = term - Granted = false - Reason = Some err + Granted = true + Reason = None } + else + do! debug "processVoteRequest" "vote request denied: NotVotingState" + return! + "Not Voting State" + |> Error.asRaftError (tag "processVoteRequest") + |> failM + | (false, err) -> + let! term = currentTerm () + return { + Term = term + Granted = false + Reason = Some err + } } // ** receiveVoteRequest @@ -1402,7 +1159,6 @@ module rec Raft = (string nid) result.Granted do! RaftMonad.info "receiveVoteRequest" str - return result | _ -> do! RaftMonad.info "receiveVoteRequest" <| sprintf "requested denied. NoMember %s" (string nid) @@ -1452,10 +1208,11 @@ module rec Raft = let periodic (elapsed : Timeout) = raft { - let! state = get - do! setTimeoutElapsed (state.TimeoutElapsed + elapsed) + let! state = state() + let! currentlyElapsed = timeoutElapsed () + do! setTimeoutElapsed (currentlyElapsed + elapsed) - match state.State with + match state with | Leader -> // if in JointConsensus let! consensus = inJointConsensus () diff --git a/src/Disco/Disco/Raft/RaftMonad.fs b/src/Disco/Disco/Raft/RaftMonad.fs index 9abcaaab..ca347702 100644 --- a/src/Disco/Disco/Raft/RaftMonad.fs +++ b/src/Disco/Disco/Raft/RaftMonad.fs @@ -653,3 +653,97 @@ module RaftMonad = for KeyValue(_,peer) in peers do do env.MemberUpdated peer } + + // ** appendEntry + + let appendEntry (entry: LogEntry) = + raft { + let! current = log () + + // create the new log by appending + let newlog = Log.append entry current + do! setLog newlog + + // get back the entries just added + // (with correct monotonic idx's) + let result = Log.getn (LogEntry.depth entry) newlog + + match result with + | Some entries -> do! persistLog entries + | _ -> () + + return result + } + + // ** createEntry + + let createEntry (entry: StateMachine) = + raft { + let! term = currentTerm () + let log = LogEntry.create 0 term entry + return! appendEntry log + } + + // ** removeEntry + + /// Delete a log entry at the index specified. Returns the original value if + /// the record is not found. + + let removeEntry idx = + raft { + let! env = read + let! current = log () + match Log.at idx current with + | Some log -> + match LogEntry.pop log with + | Some newlog -> + // fire delete log callback for all removed items + match Log.until idx current with + | Some items -> LogEntry.iter (fun _ entry -> do env.DeleteLog entry) items + | _ -> () + // save the modified log to state + do! modify (updateLogEntries newlog) + | _ -> + do env.DeleteLog log + do! modify (RaftState.setLog Log.empty) + | _ -> () + } + + // ** updateLogEntries + + let updateLogEntries (entries: LogEntry) (state: RaftState) = + { state with + Log = { Index = LogEntry.index entries + Depth = LogEntry.depth entries + Data = Some entries } } + + // ** updateCommitIndex + + let updateCommitIndex () = modify RaftState.updateCommitIndex + + // ** regularMajority + + /// Determine whether a vote count constitutes a majority in the *regular* + /// configuration (does not cover the joint consensus state). + + let regularMajority votes = + raft { + let! num = votingMembers () + return RaftState.majority num votes + } + + // ** oldConfigMajority + + let oldConfigMajority votes = + raft { + let! num = votingMembersForOldConfig () + return RaftState.majority num votes + } + + // ** numVotesForMe + + let numVotesForMe () = zoom RaftState.numVotesForMe + + // ** numVotesForMeOldConfig + + let numVotesForMeOldConfig () = zoom RaftState.numVotesForMeOldConfig diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index aedb9931..a2a283e5 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -709,3 +709,79 @@ module RaftState = // ** entriesUntilExcluding let entriesUntilExcluding idx = log >> Log.untilExcluding idx + + // ** updateCommitIndex + + let updateCommitIndex (state: RaftState) = + setCommitIndex + $ if state.NumMembers = 1 + then currentIndex state + else commitIndex state + $ state + + // ** calculateChanges + + let calculateChanges (oldPeers: Map) (newPeers: Map) = + let oldmems = Map.toArray oldPeers |> Array.map snd + let newmems = Map.toArray newPeers |> Array.map snd + + let additions = + Array.fold + (fun lst (newmem: RaftMember) -> + match Array.tryFind (Member.id >> (=) newmem.Id) oldmems with + | Some _ -> lst + | _ -> MemberAdded(newmem) :: lst) [] newmems + + Array.fold + (fun lst (oldmem: RaftMember) -> + match Array.tryFind (Member.id >> (=) oldmem.Id) newmems with + | Some _ -> lst + | _ -> MemberRemoved(oldmem) :: lst) additions oldmems + |> List.toArray + + // ** majority + + /// Determine the majority from a total number of eligible voters and their respective votes. This + /// function is generic and should expect any numeric types. + /// + /// Turning off the warning about the cast due to sufficiently constrained requirements on the + /// input type (op_Explicit, comparison and division). + /// + /// ### Signature: + /// - total: the total number of votes cast + /// - yays: the number of yays in this election + + let majority total yays = + if total = 0 || yays = 0 then + false + elif yays > total then + false + else + yays > (total / 2) + + // ** numVotesForConfig + + let numVotesForConfig (self: RaftMember) (votedFor: MemberId option) peers = + let counter m _ (peer : RaftMember) = + if (peer.Id <> self.Id) && Member.canVote peer + then m + 1 + else m + + let start = + match votedFor with + | Some(nid) -> if nid = self.Id then 1 else 0 + | _ -> 0 + + Map.fold counter start peers + + // ** numVotesForMe + + let numVotesForMe (state: RaftState) = + numVotesForConfig state.Member state.VotedFor state.Peers + + // ** numVotesForMeOldConfig + + let numVotesForMeOldConfig (state: RaftState) = + match state.OldPeers with + | Some peers -> numVotesForConfig state.Member state.VotedFor peers + | _ -> 0 diff --git a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs index 03136d79..86e4d8f4 100644 --- a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs +++ b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs @@ -158,7 +158,7 @@ module AppendEntries = let _entries_for_conflict_tests (payload : StateMachine array) = raft { for t in payload do - do! Raft.createEntry t >>= ignoreM + do! createEntry t >>= ignoreM } let follower_recv_appendentries_delete_entries_if_conflict_with_new_entries = @@ -394,13 +394,13 @@ module AppendEntries = raft { do! addMember peer do! setCurrentTerm 1 - do! Raft.appendEntry (log (DiscoId.Create())) >>= ignoreM + do! appendEntry (log (DiscoId.Create())) >>= ignoreM let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should not be successful" true AppendResponse.failed response expect "Should have current index 1" (index 1) AppendResponse.currentIndex response - do! Raft.appendEntry (log (DiscoId.Create())) >>= ignoreM + do! appendEntry (log (DiscoId.Create())) >>= ignoreM let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should not be successful" true AppendResponse.failed response expect "Should have current index 2" (index 2) AppendResponse.currentIndex response diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index 768c6dd5..ef8983a7 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -42,11 +42,11 @@ module ServerTests = testCase "Raft server index should start at 1" <| fun _ -> raft { do! expectM "Should have default idx" (0) RaftState.currentIndex - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! expectM "Should have current idx" (1) RaftState.currentIndex - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! expectM "Should have current idx" (2) RaftState.currentIndex - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! expectM "Should have current idx" (3) RaftState.currentIndex } |> runWithDefaults @@ -161,14 +161,14 @@ module ServerTests = do! setState Candidate do! setCurrentTerm 5 - do! Raft.createEntry msg2 >>= ignoreM + do! createEntry msg2 >>= ignoreM let! entry = entryAt (index 1) match Option.get entry with | LogEntry(_,_,_,data,_) -> Expect.equal data msg2 "Should have correct contents" | _ -> failwith "Should be a Log" - do! Raft.createEntry msg3 >>= ignoreM + do! createEntry msg3 >>= ignoreM let! entry = entryAt (index 2) match Option.get entry with | LogEntry(_,_,_,data,_) -> @@ -216,7 +216,7 @@ module ServerTests = expect "Should not have incremented last applied index" 0 id lidx expect "Should not have incremented commit index" 0 id cidx - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! Raft.applyEntries () >>= ignoreM let! lidx = lastAppliedIndex() @@ -235,7 +235,7 @@ module ServerTests = do! setState Follower do! setCurrentTerm 1 do! setLastAppliedIndex (index 0) - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! setCommitIndex (index 1) do! Raft.periodic 1 let! lidx = lastAppliedIndex() @@ -248,7 +248,7 @@ module ServerTests = testCase "Raft applyEntry increments LastAppliedIndex" <| fun _ -> raft { do! setLastAppliedIndex (index 0) - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! setCommitIndex (index 1) do! Raft.applyEntries () let! lidx = lastAppliedIndex() @@ -419,22 +419,22 @@ module ServerTests = let server_votes_are_majority_is_true = testCase "Vote are majority is majority" <| fun _ -> - Raft.majority 3 1 + RaftState.majority 3 1 |> expect "1) Should not be a majority" false id - Raft.majority 3 2 + RaftState.majority 3 2 |> expect "2) Should be a majority" true id - Raft.majority 5 2 + RaftState.majority 5 2 |> expect "3) Should not be a majority" false id - Raft.majority 5 3 + RaftState.majority 5 3 |> expect "4) Should be a majority" true id - Raft.majority 1 2 + RaftState.majority 1 2 |> expect "5) Should not be a majority" false id - Raft.majority 4 2 + RaftState.majority 4 2 |> expect "6) Should not be a majority" false id let recv_requestvote_response_dont_increase_votes_for_me_when_not_granted = @@ -445,12 +445,12 @@ module ServerTests = do! addMember mem do! setCurrentTerm 1 do! setState Candidate - do! expectM "Votes for me should be zero" 0 Raft.numVotesForMe + do! expectM "Votes for me should be zero" 0 RaftState.numVotesForMe let! term = currentTerm () let response = { Term = term; Granted = false; Reason = Some OK } let! result = Raft.receiveVoteResponse mem.Id response - do! expectM "Votes for me should be zero" 0 Raft.numVotesForMe + do! expectM "Votes for me should be zero" 0 RaftState.numVotesForMe } |> runWithDefaults |> noError @@ -463,7 +463,7 @@ module ServerTests = do! addMember mem do! setCurrentTerm 3 do! setState Candidate - do! expectM "Should have zero votes for me" 0 Raft.numVotesForMe + do! expectM "Should have zero votes for me" 0 RaftState.numVotesForMe let response = { Term = term 2; Granted = true; Reason = None } return! Raft.receiveVoteResponse mem.Id response @@ -477,10 +477,10 @@ module ServerTests = raft { do! addMember mem do! setCurrentTerm 1 - do! expectM "Should have zero votes for me" 0 Raft.numVotesForMe + do! expectM "Should have zero votes for me" 0 RaftState.numVotesForMe do! Raft.becomeCandidate () do! Raft.receiveVoteResponse mem.Id { Term = term 2; Granted = true; Reason = None } - do! expectM "Should have two votes for me" 2 Raft.numVotesForMe + do! expectM "Should have two votes for me" 2 RaftState.numVotesForMe } |> runWithDefaults |> noError @@ -611,8 +611,8 @@ module ServerTests = do! setCurrentTerm 1 do! voteFor None do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! expectM "Should have currentIndex one" (index 2) RaftState.currentIndex let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res @@ -636,8 +636,8 @@ module ServerTests = do! setCurrentTerm 2 do! voteFor None do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM - do! Raft.createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM + do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! expectM "Should have currentIndex one" (index 2) RaftState.currentIndex let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res @@ -857,8 +857,8 @@ module ServerTests = raft { do! addMember peer do! setCurrentTerm 1 - do! Raft.appendEntry log1 >>= ignoreM - do! Raft.appendEntry log2 >>= ignoreM + do! appendEntry log1 >>= ignoreM + do! appendEntry log2 >>= ignoreM let! state = get let vote : VoteRequest = @@ -898,7 +898,7 @@ module ServerTests = do! expectM "Should have no VotedFor" None RaftState.votedFor do! Raft.becomeCandidate () do! expectM "Should have voted for myself" (Some raft'.Member.Id) RaftState.votedFor - do! expectM "Should have one vote for me" 1 Raft.numVotesForMe + do! expectM "Should have one vote for me" 1 RaftState.numVotesForMe } |> runWithDefaults |> noError @@ -1009,7 +1009,7 @@ module ServerTests = do! addMembers peers do! setState Candidate do! setCurrentTerm 5 - do! Raft.appendEntry log >>= ignoreM + do! appendEntry log >>= ignoreM let! request = Raft.sendVoteRequest peer1 @@ -1235,7 +1235,7 @@ module ServerTests = for n in 0 .. 9 do let l = LogEntry(DiscoId.Create(), index 0, term 1, DataSnapshot (State.Empty), None) - do! Raft.appendEntry l >>= ignoreM + do! appendEntry l >>= ignoreM do! setCommitIndex (index 10) do! Raft.sendAllAppendEntries () @@ -1271,7 +1271,7 @@ module ServerTests = let log = LogEntry(DiscoId.Create(),index 0,term 2,DataSnapshot (State.Empty),None) - do! Raft.appendEntry log >>= ignoreM + do! appendEntry log >>= ignoreM do! setNextIndex peer.Id (index 1) let! peer = getMember peer.Id >>= (Option.get >> returnM) @@ -1325,7 +1325,7 @@ module ServerTests = let log = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty), None) do! setNextIndex peer.Id (index 1) - do! Raft.appendEntry log >>= ignoreM + do! appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer (!sender.Outbox) @@ -1411,9 +1411,9 @@ module ServerTests = do! setCurrentTerm 1 do! setCommitIndex (index 0) do! setLastAppliedIndex (index 0) - do! Raft.appendEntry log1 >>= ignoreM - do! Raft.appendEntry log2 >>= ignoreM - do! Raft.appendEntry log3 >>= ignoreM + do! appendEntry log1 >>= ignoreM + do! appendEntry log2 >>= ignoreM + do! appendEntry log3 >>= ignoreM // peer 1 let! request = Raft.sendAppendEntry peer1 @@ -1472,9 +1472,9 @@ module ServerTests = do! setCurrentTerm 1 do! setCommitIndex (index 0) do! setLastAppliedIndex (index 0) - do! Raft.appendEntry log1 >>= ignoreM - do! Raft.appendEntry log2 >>= ignoreM - do! Raft.appendEntry log3 >>= ignoreM + do! appendEntry log1 >>= ignoreM + do! appendEntry log2 >>= ignoreM + do! appendEntry log3 >>= ignoreM do! Raft.sendAllAppendEntries () do! Raft.receiveAppendEntriesResponse peer1.Id response do! Raft.receiveAppendEntriesResponse peer2.Id response @@ -1515,9 +1515,9 @@ module ServerTests = do! setCurrentTerm 2 do! setCommitIndex (index 0) do! setLastAppliedIndex (index 0) - do! Raft.appendEntry log1 >>= ignoreM - do! Raft.appendEntry log2 >>= ignoreM - do! Raft.appendEntry log3 >>= ignoreM + do! appendEntry log1 >>= ignoreM + do! appendEntry log2 >>= ignoreM + do! appendEntry log3 >>= ignoreM let! request = Raft.sendAppendEntry peer1 @@ -1599,10 +1599,10 @@ module ServerTests = do! setCurrentTerm 2 do! setCommitIndex (index 0) do! setLastAppliedIndex (index 0) - do! Raft.appendEntry log1 >>= ignoreM - do! Raft.appendEntry log2 >>= ignoreM - do! Raft.appendEntry log3 >>= ignoreM - do! Raft.appendEntry log4 >>= ignoreM + do! appendEntry log1 >>= ignoreM + do! appendEntry log2 >>= ignoreM + do! appendEntry log3 >>= ignoreM + do! appendEntry log4 >>= ignoreM do! Raft.becomeLeader () do! expectM "Should have nextIdx 5" (index 5) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) @@ -1661,7 +1661,7 @@ module ServerTests = for n in 1 .. 4 do do! LogEntry(DiscoId.Create(),0,term n,DataSnapshot(State.Empty),None) - |> Raft.appendEntry + |> appendEntry >>= ignoreM ci := 0 @@ -1732,7 +1732,7 @@ module ServerTests = do! setState Leader do! setLastAppliedIndex (index 0) - do! Raft.appendEntry log >>= ignoreM + do! appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer1 @@ -1848,7 +1848,7 @@ module ServerTests = do! setCurrentTerm 1 do! setCommitIndex (index 0) do! setNextIndex peer.Id (index 1) - do! Raft.appendEntry log >>= ignoreM + do! appendEntry log >>= ignoreM let! response = Raft.receiveEntry log !sender.Outbox @@ -1881,7 +1881,7 @@ module ServerTests = do! setState Leader do! setCurrentTerm 1 do! setCommitIndex (index 0) - do! Raft.appendEntry log >>= ignoreM + do! appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer @@ -2179,7 +2179,7 @@ module ServerTests = do! setCurrentTerm trm for n in 0 .. depth do - do! Raft.appendEntry (Log.make trm defSM) >>= ignoreM + do! appendEntry (Log.make trm defSM) >>= ignoreM do! setLeader (Some me.Id) do! expectM "Should have correct number of entries" (depth + 1) RaftState.numLogs @@ -2248,7 +2248,7 @@ module ServerTests = raft { do! setCurrentTerm trm for n in 0 .. (int idx + num) do - do! Raft.appendEntry (Log.make trm (DataSnapshot (State.Empty))) >>= ignoreM + do! appendEntry (Log.make trm (DataSnapshot (State.Empty))) >>= ignoreM do! Raft.applyEntries () @@ -2282,13 +2282,13 @@ module ServerTests = do! setState Leader - do! Raft.appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberAdded(mem)|] ,None)) >>= ignoreM + do! appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberAdded(mem)|] ,None)) >>= ignoreM do! setCommitIndex (index 1) do! Raft.applyEntries () expect "Should have count 1" 1 id !count - do! Raft.appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberRemoved mem |] ,None)) >>= ignoreM + do! appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberRemoved mem |] ,None)) >>= ignoreM do! setCommitIndex (index 3) do! Raft.applyEntries () @@ -2321,9 +2321,9 @@ module ServerTests = do! setState Leader - do! Raft.appendEntry log1 >>= ignoreM - do! Raft.appendEntry log2 >>= ignoreM - do! Raft.appendEntry log3 >>= ignoreM + do! appendEntry log1 >>= ignoreM + do! appendEntry log2 >>= ignoreM + do! appendEntry log3 >>= ignoreM expect "should have correct ids" ids id !count } @@ -2352,17 +2352,17 @@ module ServerTests = raft { do! setState Leader - do! Raft.appendEntry log1 >>= ignoreM - do! Raft.appendEntry log2 >>= ignoreM - do! Raft.appendEntry log3 >>= ignoreM + do! appendEntry log1 >>= ignoreM + do! appendEntry log2 >>= ignoreM + do! appendEntry log3 >>= ignoreM - do! Raft.removeEntry 3 + do! removeEntry 3 do! expectM "Should have only 2 entries" 2 RaftState.numLogs - do! Raft.removeEntry 2 + do! removeEntry 2 do! expectM "Should have only 1 entry" 1 RaftState.numLogs - do! Raft.removeEntry 1 + do! removeEntry 1 do! expectM "Should have zero entries" 0 RaftState.numLogs expect "should have deleted all logs" List.empty id !count From 9ca41e624c5716a792eae1bfbd8d8dc922cc2182 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Thu, 8 Feb 2018 17:58:34 +0100 Subject: [PATCH 10/27] index N -> N --- src/Disco/Disco/Core/Project.fs | 4 +- src/Disco/Disco/Raft/Log.fs | 2 +- src/Disco/Disco/Raft/Member.fs | 4 +- src/Disco/Disco/Raft/Raft.fs | 26 +- src/Disco/Disco/Raft/RaftState.fs | 6 +- src/Disco/Disco/Tests/Core/ApiTests.fs | 2 +- .../Disco/Tests/Raft/AppendEntriesTests.fs | 88 ++--- .../Disco/Tests/Raft/JointConsensusTests.fs | 34 +- src/Disco/Disco/Tests/Raft/LogTests.fs | 56 +-- src/Disco/Disco/Tests/Raft/ServerTests.fs | 352 +++++++++--------- src/Disco/Disco/Tests/TestUtilities.fs | 10 +- 11 files changed, 292 insertions(+), 292 deletions(-) diff --git a/src/Disco/Disco/Core/Project.fs b/src/Disco/Disco/Core/Project.fs index 33f1fb13..7ec53b8f 100644 --- a/src/Disco/Disco/Core/Project.fs +++ b/src/Disco/Disco/Core/Project.fs @@ -777,8 +777,8 @@ module ClusterMember = State = mem.State Voting = true VotedForMe = false - NextIndex = index 1 - MatchIndex = index 0 } + NextIndex = 1 + MatchIndex = 0 } // * ClusterConfig diff --git a/src/Disco/Disco/Raft/Log.fs b/src/Disco/Disco/Raft/Log.fs index fb16817f..d8b81f54 100644 --- a/src/Disco/Disco/Raft/Log.fs +++ b/src/Disco/Disco/Raft/Log.fs @@ -106,7 +106,7 @@ type Log = | _ -> return { Data = None Depth = 0 - Index = index 0 } + Index = 0 } } // * Log Module diff --git a/src/Disco/Disco/Raft/Member.fs b/src/Disco/Disco/Raft/Member.fs index 171699e9..3adfc384 100644 --- a/src/Disco/Disco/Raft/Member.fs +++ b/src/Disco/Disco/Raft/Member.fs @@ -517,8 +517,8 @@ module Member = State = Follower Voting = true VotedForMe = false - NextIndex = index 1 - MatchIndex = index 0 } + NextIndex = 1 + MatchIndex = 0 } // ** isVoting diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index b561952b..01c8545d 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -165,7 +165,7 @@ module rec Raft = let ldridx = msg.LeaderCommit if cmmtidx < ldridx then let! current = currentIndex () - let lastLogIdx = max current (index 1) + let lastLogIdx = max current 1 let newIndex = min lastLogIdx msg.LeaderCommit do! setCommitIndex newIndex } @@ -223,7 +223,7 @@ module rec Raft = let notVoting = not (Member.isVoting peer) let notLogs = not (Member.hasSufficientLogs peer) - let idxOk = current <= resp.CurrentIndex + index 1 + let idxOk = current <= resp.CurrentIndex + 1 if notVoting && idxOk && notLogs then let updated = Member.setHasSufficientLogs peer @@ -334,7 +334,7 @@ module rec Raft = |> Error.asRaftError (tag "receiveAppendEntriesResponse") |> failM | Some peer -> - if resp.CurrentIndex <> index 0 && resp.CurrentIndex < peer.MatchIndex then + if resp.CurrentIndex <> 0 && resp.CurrentIndex < peer.MatchIndex then do! sprintf "Failed: peer not up to date yet (ci: %d) (match idx: %d)" resp.CurrentIndex peer.MatchIndex @@ -374,14 +374,14 @@ module rec Raft = do! setNextIndex peer.Id nextIndex do! setMatchIndex peer.Id (nextIndex - 1) else - let nextIndex = peer.NextIndex - index 1 + let nextIndex = peer.NextIndex - 1 do! nextIndex |> sprintf "Failed: cidx >= nxtidx. setting nextIndex for %O to %d" peer.Id |> error "receiveAppendEntriesResponse" do! setNextIndex peer.Id nextIndex - do! setMatchIndex peer.Id (nextIndex - index 1) + do! setMatchIndex peer.Id (nextIndex - 1) else do! updateMemberIndices resp peer do! responseSetCommitIndex resp @@ -401,12 +401,12 @@ module rec Raft = let request: AppendEntries = { Term = state.CurrentTerm - PrevLogIdx = index 0 + PrevLogIdx = 0 PrevLogTerm = term 0 LeaderCommit = state.CommitIndex Entries = entries } - if peer.NextIndex > index 1 then + if peer.NextIndex > 1 then let! result = entryAt (peer.NextIndex - 1) let request = { request with @@ -569,15 +569,15 @@ module rec Raft = match entry with | LogEntry(id,_,_,data,_) -> - let log = LogEntry(id, index 0, term, data, None) + let log = LogEntry(id, 0, term, data, None) return! handleLog log response | Configuration(id,_,_,mems,_) -> - let log = Configuration(id, index 0, term, mems, None) + let log = Configuration(id, 0, term, mems, None) return! handleLog log response | JointConsensus(id,_,_,changes,_) -> - let log = JointConsensus(id, index 0, term, changes, None) + let log = JointConsensus(id, 0, term, changes, None) return! handleLog log response | _ -> @@ -826,7 +826,7 @@ module rec Raft = let! current = currentIndex () do! setState Leader do! setLeader (Some state.Member.Id) - do! maybeSetIndex state.Member.Id (current + 1) (index 0) + do! maybeSetIndex state.Member.Id (current + 1) 0 do! sendAllAppendEntries () } @@ -1053,7 +1053,7 @@ module rec Raft = let private validateCurrentIdx state = let err = RaftError (tag "shouldGrantVote","Invalid Current Index") - (RaftState.currentIndex state = index 0, err) + (RaftState.currentIndex state = 0, err) // ** validateCandiate @@ -1226,7 +1226,7 @@ module rec Raft = let! term = currentTerm () let response = EntryResponse.create term 0 let! mems = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) - let log = Configuration(response.Id, index 0, term, mems, None) + let log = Configuration(response.Id, 0, term, mems, None) do! handleLog log response >>= ignoreM else do! sendAllAppendEntries () diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index a2a283e5..4640666c 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -303,8 +303,8 @@ ConfigChangeEntry = %s NumMembers = 0 VotedFor = votedfor Log = Log.empty - CommitIndex = index 0 - LastAppliedIdx = index 0 + CommitIndex = 0 + LastAppliedIdx = 0 TimeoutElapsed = 0 ElectionTimeout = yaml.ElectionTimeout * 1 RequestTimeout = yaml.RequestTimeout * 1 @@ -523,7 +523,7 @@ module RaftState = let setNextIndex (nid : MemberId) idx (state: RaftState) = let mem = getMember nid state - let nextIdx = if idx < index 1 then index 1 else idx + let nextIdx = if idx < 1 then 1 else idx match mem with | Some mem -> mem diff --git a/src/Disco/Disco/Tests/Core/ApiTests.fs b/src/Disco/Disco/Tests/Core/ApiTests.fs index a4aac73b..d6e18938 100644 --- a/src/Disco/Disco/Tests/Core/ApiTests.fs +++ b/src/Disco/Disco/Tests/Core/ApiTests.fs @@ -316,7 +316,7 @@ module ApiTests = expect "Server should have one cuelist" 1 len store.State.CueLists expect "Client should have one cuelist" 1 len client.State.CueLists - client.UpdatePin (Pin.setSlice (BoolSlice(index 0, false, false)) pin) + client.UpdatePin (Pin.setSlice (BoolSlice(0, false, false)) pin) do! waitFor "clientUpdate" clientUpdate diff --git a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs index 86e4d8f4..4d7643d3 100644 --- a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs +++ b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs @@ -36,9 +36,9 @@ module AppendEntries = let msg = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 0 - ; LeaderCommit = index 0 + ; LeaderCommit = 0 ; Entries = None } let! result = Raft.receiveAppendEntries (Some peer.Id) msg @@ -54,9 +54,9 @@ module AppendEntries = do! addMember (Member.create (DiscoId.Create())) let msg = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 0 - ; LeaderCommit = index 1 + ; LeaderCommit = 1 ; Entries = None } let! response = Raft.receiveAppendEntries None msg @@ -75,9 +75,9 @@ module AppendEntries = do! expectM "Should not have a leader" None RaftState.currentLeader let msg = { Term = term 2 - PrevLogIdx = index 0 + PrevLogIdx = 0 PrevLogTerm = term 0 - LeaderCommit = index 0 + LeaderCommit = 0 Entries = None } @@ -101,9 +101,9 @@ module AppendEntries = do! expectM "Should have 0 log entries" 0 RaftState.numLogs let msg = { Term = term 1 - ; PrevLogIdx = index 1 + ; PrevLogIdx = 1 ; PrevLogTerm = term 4 - ; LeaderCommit = index 5 + ; LeaderCommit = 5 ; Entries = None } let! response = Raft.receiveAppendEntries (Some peer.Id) msg @@ -121,15 +121,15 @@ module AppendEntries = do! expectM "Should log count 0" 0 RaftState.numLogs let msg = { Term = term 3 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 1 - ; LeaderCommit = index 5 + ; LeaderCommit = 5 ; Entries = Log.make (term 2) defSM |> Some } let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should be a success" true AppendResponse.succeeded response do! expectM "Should have log count 1" 1 RaftState.numLogs - let! entry = entryAt (index 1) + let! entry = entryAt 1 expect "Should have term 2" (term 2) (Option.get >> LogEntry.term) entry } |> runWithDefaults @@ -144,9 +144,9 @@ module AppendEntries = let msg = { Term = term 2 - ; PrevLogIdx = index 1 + ; PrevLogIdx = 1 ; PrevLogTerm = term 1 - ; LeaderCommit = index 5 + ; LeaderCommit = 5 ; Entries = Log.make (term 0) defSM |> Some } let! response = Raft.receiveAppendEntries (Some peer.Id) msg @@ -196,9 +196,9 @@ module AppendEntries = let newer = { Term = term 2 - PrevLogIdx = index 1 + PrevLogIdx = 1 PrevLogTerm = term 1 - LeaderCommit = index 5 + LeaderCommit = 5 Entries = Log.make (term 2) addCue |> Some } @@ -207,8 +207,8 @@ module AppendEntries = do! expectM "Should have 2 entries" 2 RaftState.numLogs - do! expectM "First should have 'one' value" (data.[0]) (getNth (index 1)) - do! expectM "second should have 'four' value" (addCue) (getNth (index 2)) + do! expectM "First should have 'one' value" (data.[0]) (getNth 1) + do! expectM "second should have 'four' value" (addCue) (getNth 2) } |> runWithRaft raft' cbs |> ignore @@ -240,16 +240,16 @@ module AppendEntries = let newer = { Term = term 2 - ; PrevLogIdx = index 1 + ; PrevLogIdx = 1 ; PrevLogTerm = term 1 - ; LeaderCommit = index 5 + ; LeaderCommit = 5 ; Entries = None } let! response = Raft.receiveAppendEntries (Some peer.Id) newer expect "Should have succeeded" true AppendResponse.succeeded response do! expectM "Should have 1 log entry" 1 RaftState.numLogs - let! entry = getNth (index 1) + let! entry = getNth 1 expect "Should have correct value" (Some data.[0]) id entry } |> runWithRaft raft' cbs @@ -260,8 +260,8 @@ module AppendEntries = let peer = Member.create (DiscoId.Create()) let log = - LogEntry((DiscoId.Create()), index 2, term 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), index 2, term 1, DataSnapshot (State.Empty), None)) + LogEntry((DiscoId.Create()), 2, 1, DataSnapshot (State.Empty), + Some <| LogEntry((DiscoId.Create()), 2, 1, DataSnapshot (State.Empty), None)) raft { do! addMember peer @@ -269,9 +269,9 @@ module AppendEntries = let newer = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 1 - ; LeaderCommit = index 5 + ; LeaderCommit = 5 ; Entries = Some log } @@ -286,14 +286,14 @@ module AppendEntries = testCase "follower recv appendentries does not add dupe entries already in log" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let entry = LogEntry((DiscoId.Create()), index 2, term 1, DataSnapshot (State.Empty), None) + let entry = LogEntry((DiscoId.Create()), 2, 1, DataSnapshot (State.Empty), None) let log = Log.fromEntries entry let next = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 1 - ; LeaderCommit = index 5 + ; LeaderCommit = 5 ; Entries = Some entry } @@ -325,16 +325,16 @@ module AppendEntries = let peer = Member.create (DiscoId.Create()) let log = - LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), None)))) + LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), None)))) let msg = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 1 - ; LeaderCommit = index 5 + ; LeaderCommit = 5 ; Entries = Some log } @@ -342,7 +342,7 @@ module AppendEntries = do! addMember peer let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should have been successful" true AppendResponse.succeeded response - expect "Should have correct CurrentIndex" (index 4) AppendResponse.currentIndex response + expect "Should have correct CurrentIndex" 4 AppendResponse.currentIndex response do! expectM "Should have commit index 4" (index 4) RaftState.commitIndex } |> runWithDefaults @@ -360,18 +360,18 @@ module AppendEntries = let msg = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 1 - ; LeaderCommit = index 0 + ; LeaderCommit = 0 ; Entries = Some log } raft { do! addMember peer let! response1 = Raft.receiveAppendEntries (Some peer.Id) msg - let! response2 = Raft.receiveAppendEntries (Some peer.Id) { msg with PrevLogIdx = index 3; LeaderCommit = index 3; Entries = None } + let! response2 = Raft.receiveAppendEntries (Some peer.Id) { msg with PrevLogIdx = 3; LeaderCommit = 3; Entries = None } expect "Should have been successful" true AppendResponse.succeeded response2 - do! expectM "Should have commit index 3" (index 3) RaftState.commitIndex + do! expectM "Should have commit index 3" 3 RaftState.commitIndex } |> runWithDefaults |> ignore @@ -385,9 +385,9 @@ module AppendEntries = let msg = { Term = term 0 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 0 - ; LeaderCommit = index 0 + ; LeaderCommit = 0 ; Entries = None } @@ -398,12 +398,12 @@ module AppendEntries = let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should not be successful" true AppendResponse.failed response - expect "Should have current index 1" (index 1) AppendResponse.currentIndex response + expect "Should have current index 1" 1 AppendResponse.currentIndex response do! appendEntry (log (DiscoId.Create())) >>= ignoreM let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should not be successful" true AppendResponse.failed response - expect "Should have current index 2" (index 2) AppendResponse.currentIndex response + expect "Should have current index 2" 2 AppendResponse.currentIndex response } |> runWithDefaults |> ignore @@ -414,9 +414,9 @@ module AppendEntries = let msg = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 0 - ; LeaderCommit = index 0 + ; LeaderCommit = 0 ; Entries = None } diff --git a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs index fbaf7fdd..8b20620a 100644 --- a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs +++ b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs @@ -31,9 +31,9 @@ module JointConsensus = let mem2 = Member.create (DiscoId.Create()) let log = - JointConsensus(DiscoId.Create(), index 3, term 0, [| MemberAdded mem2 |], - Some <| JointConsensus(DiscoId.Create(), index 2, term 0, [| MemberRemoved mem1 |], - Some <| JointConsensus(DiscoId.Create(), index 1, term 0, [| MemberAdded mem1 |], None))) + JointConsensus(DiscoId.Create(), 3, 0, [| MemberAdded mem2 |], + Some <| JointConsensus(DiscoId.Create(),2,0, [| MemberRemoved mem1 |], + Some <| JointConsensus(DiscoId.Create(),1,0, [| MemberAdded mem1 |], None))) let getstuff r = Map.toList r.Peers @@ -59,12 +59,12 @@ module JointConsensus = let mem = Member.create nid2 let mkjc term = - JointConsensus(DiscoId.Create(), index 1, term, [| MemberAdded(mem) |] , None) + JointConsensus(DiscoId.Create(),1, term, [| MemberAdded(mem) |] , None) let mkcnf term mems = - Configuration(DiscoId.Create(), index 1, term, mems , None) + Configuration(DiscoId.Create(),1, term, mems , None) - let ci = ref (index 0) + let ci = ref 0 let state = defaultServer() let cbs = Callbacks.Create (ref defSM) :> IRaftCallbacks @@ -72,12 +72,12 @@ module JointConsensus = { Term = term 0 Success = true CurrentIndex = !ci - FirstIndex = index 1 } + FirstIndex = 1 } raft { do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex + do! expectM "Should have commit idx of zero" 0 RaftState.commitIndex do! expectM "Should have mem count of one" 1 RaftState.numMembers let! term = currentTerm () @@ -155,7 +155,7 @@ module JointConsensus = // call periodic to ensure these are applied let! idx = currentIndex () - ci := idx + index 1 + ci := idx + 1 do! Raft.periodic 1000 let! peers = getMembers () >>= (Map.toArray >> Array.map snd >> returnM) @@ -189,7 +189,7 @@ module JointConsensus = let nid = DiscoId.Create() yield (nid, Member.create nid) |] // create mem in the Raft state - let ci = ref (index 0) + let ci = ref 0 let trm = ref (term 1) let lokk = new System.Object() @@ -201,7 +201,7 @@ module JointConsensus = { Term = !trm Success = true CurrentIndex = !ci - FirstIndex = index 1 } + FirstIndex = 1 } raft { let me = snd mems.[0] @@ -516,7 +516,7 @@ module JointConsensus = testCase "should revert to follower state on config change removal" <| fun _ -> let n = 10 // we want ten mems overall - let ci = ref (index 0) + let ci = ref 0 let trm = ref (term 1) let lokk = new System.Object() @@ -533,7 +533,7 @@ module JointConsensus = { Term = !trm Success = true CurrentIndex = !ci - FirstIndex = index 1 } + FirstIndex = 1 } raft { let self = snd mems.[0] // @@ -649,14 +649,14 @@ module JointConsensus = testCase "should send appendentries to all servers in joint consensus" <| fun _ -> let lokk = new System.Object() let count = ref 0 - let ci = ref (index 0) + let ci = ref 0 let trm = ref (term 1) let init = defaultServer() let cbs = { Callbacks.Create (ref defSM) with SendAppendEntries = fun _ _ -> lock lokk <| fun _ -> count := 1 + !count } :> IRaftCallbacks - // let response = Some { Success = true; Term = !trm; CurrentIndex = !ci; FirstIndex = index 1 } } + // let response = Some { Success = true; Term = !trm; CurrentIndex = !ci; FirstIndex = 1 } } let n = 10 // we want ten mems overall @@ -795,7 +795,7 @@ module JointConsensus = let self = snd mems.[0] let lokk = new System.Object() - let ci = ref (index 0) + let ci = ref 0 let trm = ref (term 1) let count = ref 0 let init = RaftState.create self @@ -808,7 +808,7 @@ module JointConsensus = { Success = true Term = !trm CurrentIndex = !ci - FirstIndex = index 1 } + FirstIndex = 1 } raft { do! setPeers (mems |> Map.ofArray) diff --git a/src/Disco/Disco/Tests/Raft/LogTests.fs b/src/Disco/Disco/Tests/Raft/LogTests.fs index 469d155b..5e1c19d3 100644 --- a/src/Disco/Disco/Tests/Raft/LogTests.fs +++ b/src/Disco/Disco/Tests/Raft/LogTests.fs @@ -44,17 +44,17 @@ module Log = testCase "When I add an entry, it should have the correct index" <| fun _ -> Log.empty |> Log.append (Log.make (term 1) defSM) - |> assume "Should have currentIndex 1" (index 1) Log.index + |> assume "Should have currentIndex 1" 1 Log.index |> assume "Should have currentTerm 1" (term 1) Log.term |> assume "Should have no lastTerm" None Log.prevTerm |> assume "Should have no lastIndex" None Log.prevIndex |> Log.append (Log.make (term 1) defSM) - |> assume "Should have currentIndex 2" (index 2) Log.index + |> assume "Should have currentIndex 2" 2 Log.index |> assume "Should have currentTerm 1" (term 1) Log.term |> assume "Should have lastTerm 1" (Some (term 1)) Log.prevTerm - |> assume "Should have lastIndex 1" (Some (index 1)) Log.prevIndex + |> assume "Should have lastIndex 1" (Some 1) Log.prevIndex |> ignore @@ -66,23 +66,23 @@ module Log = let log = Log.empty - |> Log.append (LogEntry(id1, index 0, term 1, defSM, None)) - |> Log.append (LogEntry(id2, index 0, term 1, defSM, None)) - |> Log.append (LogEntry(id3, index 0, term 1, defSM, None)) + |> Log.append (LogEntry(id1, 0, term 1, defSM, None)) + |> Log.append (LogEntry(id2, 0, term 1, defSM, None)) + |> Log.append (LogEntry(id3, 0, term 1, defSM, None)) - Log.at (index 1) log + Log.at 1 log |> assume "Should be correct one" id1 (LogEntry.id << Option.get) |> ignore - Log.at (index 2) log + Log.at 2 log |> assume "Should also be correct one" id2 (LogEntry.id << Option.get) |> ignore - Log.at (index 3) log + Log.at 3 log |> assume "Should also be correct one" id3 (LogEntry.id << Option.get) |> ignore - expect "Should find none at invalid index" None (Log.at (index 8)) log + expect "Should find none at invalid index" None (Log.at 8) log let log_find_by_id = testCase "When I get an entry by index, it should be equal" <| fun _ -> @@ -92,9 +92,9 @@ module Log = let log = Log.empty - |> Log.append (LogEntry(id1, index 0, term 1, defSM, None)) - |> Log.append (LogEntry(id2, index 0, term 1, defSM, None)) - |> Log.append (LogEntry(id3, index 0, term 1, defSM, None)) + |> Log.append (LogEntry(id1, 0, term 1, defSM, None)) + |> Log.append (LogEntry(id2, 0, term 1, defSM, None)) + |> Log.append (LogEntry(id3, 0, term 1, defSM, None)) Log.find id1 log |> assume "Should be correct one" id1 (LogEntry.id << Option.get) @@ -165,8 +165,8 @@ module Log = let isMonotonic log = let __mono (last,ret) _log = let i = LogEntry.index _log - if ret then (i, i = (last + index 1)) else (i, ret) - Log.foldLogR __mono (index 0,true) log + if ret then (i, i = (last + 1)) else (i, ret) + Log.foldLogR __mono (0,true) log let log = Log.empty @@ -202,7 +202,7 @@ module Log = |> Log.append (Log.make (term 1) (AddCue cues.[3])) |> Log.append (Log.make (term 1) (AddCue cues.[4])) |> Log.append (Log.make (term 1) (AddCue cues.[5])) - |> Log.until (index 4) + |> Log.until 4 |> assume "Should have 3 logs" 3 (Option.get >> LogEntry.depth) |> assume "Should have log with these values" [AddCue cues.[5]; AddCue cues.[4]; AddCue cues.[3]] (Option.get >> getData) |> ignore @@ -214,8 +214,8 @@ module Log = let term = term 1 - let idx1 = index 1 - let idx2 = index 2 + let idx1 = 1 + let idx2 = 2 let entries = LogEntry(id2,idx2,term,DataSnapshot (State.Empty), @@ -232,8 +232,8 @@ module Log = let id2 = DiscoId.Create() let term = term 1 - let idx1 = index 1 - let idx2 = index 2 + let idx1 = 1 + let idx2 = 2 let entries = LogEntry(id2,idx2,term,DataSnapshot(State.Empty), @@ -251,9 +251,9 @@ module Log = let id3 = DiscoId.Create() let term = term 1 - let idx1 = index 1 - let idx2 = index 2 - let idx3 = index 3 + let idx1 = 1 + let idx2 = 2 + let idx3 = 3 let entires = LogEntry(id2,idx2,term,DataSnapshot(State.Empty), @@ -302,16 +302,16 @@ module Log = } ] |> List.fold (fun m s -> Log.append (Log.make (term 0) s) m) Log.empty |> assume "Should be at correct index" num Log.length - |> assume "Should pick correct item" (index 16) (Log.untilExcluding (index 15) >> Option.get >> LogEntry.last >> LogEntry.index) - |> assume "Should have correct index" (AddCue { Id = id; Name = name "16"; Slices = [| |] } |> Some) (Log.untilExcluding (index 15) >> Option.get >> LogEntry.last >> LogEntry.data) - |> assume "Should have correct index" (AddCue { Id = id; Name = name "15"; Slices = [| |] } |> Some) (Log.until (index 15) >> Option.get >> LogEntry.last >> LogEntry.data) + |> assume "Should pick correct item" 16 (Log.untilExcluding 15 >> Option.get >> LogEntry.last >> LogEntry.index) + |> assume "Should have correct index" (AddCue { Id = id; Name = name "16"; Slices = [| |] } |> Some) (Log.untilExcluding 15 >> Option.get >> LogEntry.last >> LogEntry.data) + |> assume "Should have correct index" (AddCue { Id = id; Name = name "15"; Slices = [| |] } |> Some) (Log.until 15 >> Option.get >> LogEntry.last >> LogEntry.data) |> ignore let log_append_should_work_with_snapshots_too = testCase "append should work with snapshots too" <| fun _ -> let log = Log.empty - |> Log.append (Snapshot(DiscoId.Create(), index 0, term 0, index 9, term 1, Array.empty, DataSnapshot(State.Empty))) + |> Log.append (Snapshot(DiscoId.Create(), 0, 0, 9, 1, Array.empty, DataSnapshot(State.Empty))) expect "Log should be size 1" 1 Log.length log @@ -324,7 +324,7 @@ module Log = let combine a b = (a, b) - let def = LogEntry(DiscoId.Create(),index 0,term 0,defSM,None) + let def = LogEntry(DiscoId.Create(),0,0,defSM,None) let folder log (id,term,index) = LogEntry(id,index,term,defSM,Some log) diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index ef8983a7..d00f78a6 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -162,14 +162,14 @@ module ServerTests = do! setCurrentTerm 5 do! createEntry msg2 >>= ignoreM - let! entry = entryAt (index 1) + let! entry = entryAt 1 match Option.get entry with | LogEntry(_,_,_,data,_) -> Expect.equal data msg2 "Should have correct contents" | _ -> failwith "Should be a Log" do! createEntry msg3 >>= ignoreM - let! entry = entryAt (index 2) + let! entry = entryAt 2 match Option.get entry with | LogEntry(_,_,_,data,_) -> Expect.equal data msg3 "Should have correct contents" @@ -181,8 +181,8 @@ module ServerTests = let server_wont_apply_entry_if_we_dont_have_entry_to_apply = testCase "Raft won't apply entry if we don't have entry to apply" <| fun _ -> raft { - do! setCommitIndex (index 0) - do! setLastAppliedIndex (index 0) + do! setCommitIndex 0 + do! setLastAppliedIndex 0 do! Raft.applyEntries () let! lidx = lastAppliedIndex() @@ -205,8 +205,8 @@ module ServerTests = |> Map.ofArray raft { - do! setCommitIndex (index 0) - do! setLastAppliedIndex (index 0) + do! setCommitIndex 0 + do! setLastAppliedIndex 0 do! addMembers mems do! Raft.applyEntries () @@ -234,9 +234,9 @@ module ServerTests = raft { do! setState Follower do! setCurrentTerm 1 - do! setLastAppliedIndex (index 0) + do! setLastAppliedIndex 0 do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM - do! setCommitIndex (index 1) + do! setCommitIndex 1 do! Raft.periodic 1 let! lidx = lastAppliedIndex() expect "Should have last applied index 1" 1 id lidx @@ -247,9 +247,9 @@ module ServerTests = let server_apply_entry_increments_last_applied_idx = testCase "Raft applyEntry increments LastAppliedIndex" <| fun _ -> raft { - do! setLastAppliedIndex (index 0) + do! setLastAppliedIndex 0 do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM - do! setCommitIndex (index 1) + do! setCommitIndex 1 do! Raft.applyEntries () let! lidx = lastAppliedIndex() expect "Should have last applied index 1" 1 id lidx @@ -283,16 +283,16 @@ module ServerTests = let server_recv_entry_auto_commits_if_we_are_the_only_mem = testCase "Receive entry auto-commits if we are the only mem" <| fun _ -> - let entry = LogEntry(DiscoId.Create(),index 0,term 0,DataSnapshot (State.Empty),None) + let entry = LogEntry(DiscoId.Create(),0,0,DataSnapshot (State.Empty),None) raft { do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx 0" (index 0) RaftState.commitIndex + do! expectM "Should have commit idx 0" 0 RaftState.commitIndex let! result = Raft.receiveEntry entry do! expectM "Should have log count 1" 1 RaftState.numLogs - do! expectM "Should have commit idx 1" (index 1) RaftState.commitIndex + do! expectM "Should have commit idx 1" 1 RaftState.commitIndex } |> runWithDefaults |> noError @@ -301,12 +301,12 @@ module ServerTests = testCase "Receive entry fails if there is already a voting change" <| fun _ -> let mem = Member.create (DiscoId.Create()) let mklog term = - JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberAdded(mem) |] , None) + JointConsensus(DiscoId.Create(), 1, term, [| ConfigChange.MemberAdded(mem) |] , None) raft { do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex + do! expectM "Should have commit idx of zero" 0 RaftState.commitIndex let! term = currentTerm () let! result = Raft.receiveEntry (mklog term) @@ -326,12 +326,12 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) let mklog term = - JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberAdded(mem) |] , None) + JointConsensus(DiscoId.Create(), 1, term, [| ConfigChange.MemberAdded(mem) |] , None) raft { do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex + do! expectM "Should have commit idx of zero" 0 RaftState.commitIndex do! expectM "Should have mem count of one" 1 RaftState.numMembers let! term = currentTerm () let! result = Raft.receiveEntry (mklog term) @@ -346,12 +346,12 @@ module ServerTests = let nid = DiscoId.Create() let mem = Member.create nid let mklog term = - JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberAdded(mem) |] , None) + JointConsensus(DiscoId.Create(), 1, term, [| ConfigChange.MemberAdded(mem) |] , None) raft { do! setElectionTimeout 1000 do! Raft.becomeLeader () - do! expectM "Should have commit idx of zero" (index 0) RaftState.commitIndex + do! expectM "Should have commit idx of zero" 0 RaftState.commitIndex do! expectM "Should have mem count of one" 1 RaftState.numMembers let! term = currentTerm () @@ -367,11 +367,11 @@ module ServerTests = let server_recv_entry_removes_mem_on_removemem = testCase "recv entry removes mem on removemem" <| fun _ -> let term = ref (term 0) - let ci = ref (index 0) + let ci = ref 0 let mem = Member.create (DiscoId.Create()) let mklog term = - JointConsensus(DiscoId.Create(), index 1, term, [| ConfigChange.MemberRemoved mem |] , None) + JointConsensus(DiscoId.Create(), 1, term, [| ConfigChange.MemberRemoved mem |] , None) raft { do! setElectionTimeout 1000 @@ -387,7 +387,7 @@ module ServerTests = Term = !term Success = true CurrentIndex = !ci - FirstIndex = index 1 + FirstIndex = 1 } ci := 2 @@ -539,7 +539,7 @@ module ServerTests = let vote = { Term = term 1 ; Candidate = mem - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } @@ -559,7 +559,7 @@ module ServerTests = let vote = { Term = term 2 ; Candidate = mem - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } @@ -579,7 +579,7 @@ module ServerTests = let vote = { Term = term 1 ; Candidate = mem - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } @@ -587,7 +587,7 @@ module ServerTests = do! addMember mem do! setCurrentTerm 1 do! voteFor None - do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex + do! expectM "Should have currentIndex zero" 0 RaftState.currentIndex do! expectM "Should have voted for nobody" None RaftState.votedFor let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res @@ -602,7 +602,7 @@ module ServerTests = let vote = { Term = term 2 ; Candidate = mem - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 2 } @@ -610,10 +610,10 @@ module ServerTests = do! addMember mem do! setCurrentTerm 1 do! voteFor None - do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex + do! expectM "Should have currentIndex zero" 0 RaftState.currentIndex do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM - do! expectM "Should have currentIndex one" (index 2) RaftState.currentIndex + do! expectM "Should have currentIndex one" 2 RaftState.currentIndex let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res } @@ -627,7 +627,7 @@ module ServerTests = let vote = { Term = term 2 ; Candidate = mem - ; LastLogIndex = index 3 + ; LastLogIndex = 3 ; LastLogTerm = term 2 } @@ -635,10 +635,10 @@ module ServerTests = do! addMember mem do! setCurrentTerm 2 do! voteFor None - do! expectM "Should have currentIndex zero" (index 0) RaftState.currentIndex + do! expectM "Should have currentIndex zero" 0 RaftState.currentIndex do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM do! createEntry (DataSnapshot (State.Empty)) >>= ignoreM - do! expectM "Should have currentIndex one" (index 2) RaftState.currentIndex + do! expectM "Should have currentIndex one" 2 RaftState.currentIndex let! (res,_) = Raft.shouldGrantVote vote expect "Should grant vote" true id res } @@ -658,7 +658,7 @@ module ServerTests = let request = { Term = term 1 ; Candidate = peer - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request @@ -678,7 +678,7 @@ module ServerTests = let request = { Term = term 2 ; Candidate = peer - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request @@ -699,7 +699,7 @@ module ServerTests = let request = { Term = term 2 ; Candidate = peer - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request @@ -722,7 +722,7 @@ module ServerTests = let request = { Term = term 2 ; Candidate = peer - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest peer.Id request @@ -746,7 +746,7 @@ module ServerTests = let request = { Term = term 2 ; Candidate = other - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } let! resp = Raft.receiveVoteRequest other.Id request @@ -763,7 +763,7 @@ module ServerTests = let request = { Term = term 1 ; Candidate = peer1 - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } @@ -851,8 +851,8 @@ module ServerTests = let follower_dont_grant_vote_if_candidate_has_a_less_complete_log = testCase "follower dont grant vote if candidate has a less complete log" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let log1 = LogEntry(DiscoId.Create(), index 0, term 1, (DataSnapshot (State.Empty)), None) - let log2 = LogEntry(DiscoId.Create(), index 0, term 2, (DataSnapshot (State.Empty)), None) + let log1 = LogEntry(DiscoId.Create(), 0, 1, (DataSnapshot (State.Empty)), None) + let log2 = LogEntry(DiscoId.Create(), 0, 2, (DataSnapshot (State.Empty)), None) raft { do! addMember peer @@ -864,7 +864,7 @@ module ServerTests = let vote : VoteRequest = { Term = term 1 ; Candidate = state.Member - ; LastLogIndex = index 1 + ; LastLogIndex = 1 ; LastLogTerm = term 1 } @@ -971,7 +971,7 @@ module ServerTests = let vote : VoteRequest = { Term = term 0 // term must be equal or lower that raft's Candidate = raft'.Member // term for this to work - LastLogIndex = index 0 + LastLogIndex = 0 LastLogTerm = term 0 } do! addMember peer do! voteFor (Some raft'.Member) @@ -1002,9 +1002,9 @@ module ServerTests = |> Map.ofArray let log = - LogEntry(DiscoId.Create(),index 0, term 3, DataSnapshot (State.Empty), - Some <| LogEntry(DiscoId.Create(),index 0, term 1, DataSnapshot (State.Empty), - Some <| LogEntry(DiscoId.Create(),index 0, term 1, DataSnapshot (State.Empty), None))) + LogEntry(DiscoId.Create(),0, 3, DataSnapshot (State.Empty), + Some <| LogEntry(DiscoId.Create(),0, 1, DataSnapshot (State.Empty), + Some <| LogEntry(DiscoId.Create(),0, 1, DataSnapshot (State.Empty), None))) do! addMembers peers do! setState Candidate @@ -1017,7 +1017,7 @@ module ServerTests = let vote = List.head (!sender.Outbox) |> getVote - expect "should have last log index be 3" (index 3) VoteRequest.lastLogIndex vote + expect "should have last log index be 3" 3 VoteRequest.lastLogIndex vote expect "should have last term be 5" (term 5) VoteRequest.term vote expect "should have last log term be 3" (term 3) VoteRequest.lastLogTerm vote expect "should have candidate id be me" self VoteRequest.candidate vote @@ -1051,9 +1051,9 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) let ae : AppendEntries = { Term = term 1 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 0 - ; LeaderCommit = index 0 + ; LeaderCommit = 0 ; Entries = None } @@ -1078,9 +1078,9 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) let ae : AppendEntries = { Term = term 2 - ; PrevLogIdx = index 1 + ; PrevLogIdx = 1 ; PrevLogTerm = term 1 - ; LeaderCommit = index 0 + ; LeaderCommit = 0 ; Entries = None } @@ -1127,7 +1127,7 @@ module ServerTests = do! setState Candidate do! Raft.becomeLeader () let! raft' = get - let cidx = RaftState.currentIndex raft' + index 1 + let cidx = RaftState.currentIndex raft' + 1 for peer in raft'.Peers do if peer.Value.Id <> raft'.Member.Id then @@ -1163,7 +1163,7 @@ module ServerTests = let leader_responds_to_entry_msg_when_entry_is_committed = testCase "leader responds to entry msg when entry is committed" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let log = LogEntry(DiscoId.Create(),index 0,term 0,DataSnapshot (State.Empty),None) + let log = LogEntry(DiscoId.Create(),0,0,DataSnapshot (State.Empty),None) raft { do! addMember peer @@ -1172,7 +1172,7 @@ module ServerTests = let! resp = Raft.receiveEntry log do! expectM "Should have log count 1" 1 RaftState.numLogs do! Raft.applyEntries () - let response = { Term = term 0; Success = true; CurrentIndex = index 1; FirstIndex = index 1 } + let response = { Term = 0; Success = true; CurrentIndex = 1; FirstIndex = 1 } do! Raft.receiveAppendEntriesResponse peer.Id response let! committed = Raft.responseCommitted resp expect "Should be committed" true id committed @@ -1184,7 +1184,7 @@ module ServerTests = let non_leader_recv_entry_msg_fails = testCase "non leader recv entry msg fails" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let log = LogEntry(DiscoId.Create(),index 0,term 0,DataSnapshot (State.Empty),None) + let log = LogEntry(DiscoId.Create(),0,0,DataSnapshot (State.Empty),None) let err = "Not Leader" @@ -1201,10 +1201,10 @@ module ServerTests = let leader_sends_appendentries_with_NextIdx_when_PrevIdx_gt_NextIdx = testCase "leader sends appendentries with NextIdx when PrevIdx gt NextIdx" <| fun _ -> - let peer = { Member.create (DiscoId.Create()) with NextIndex = index 4 } + let peer = { Member.create (DiscoId.Create()) with NextIndex = 4 } let raft' : RaftState = defaultServer () let sender = Sender.create - let log = LogEntry(DiscoId.Create(),index 0, term 1, DataSnapshot (State.Empty), None) + let log = LogEntry(DiscoId.Create(),0, 1, DataSnapshot (State.Empty), None) let cbs = { Callbacks.Create (ref (DataSnapshot (State.Empty))) with SendAppendEntries = senderAppendEntries sender None } @@ -1221,7 +1221,7 @@ module ServerTests = let leader_sends_appendentries_with_leader_commit = testCase "leader sends appendentries with leader commit" <| fun _ -> - let peer = { Member.create (DiscoId.Create()) with NextIndex = index 4 } + let peer = { Member.create (DiscoId.Create()) with NextIndex = 4 } let raft' = defaultServer () let sender = Sender.create let cbs = @@ -1234,16 +1234,16 @@ module ServerTests = do! setState Leader for n in 0 .. 9 do - let l = LogEntry(DiscoId.Create(), index 0, term 1, DataSnapshot (State.Empty), None) + let l = LogEntry(DiscoId.Create(), 0, 1, DataSnapshot (State.Empty), None) do! appendEntry l >>= ignoreM - do! setCommitIndex (index 10) + do! setCommitIndex 10 do! Raft.sendAllAppendEntries () (!sender.Outbox) |> List.head |> getAppendEntries - |> expect "Should have leader commit 10" (index 10) (fun ae -> ae.LeaderCommit) + |> expect "Should have leader commit 10" 10 (fun ae -> ae.LeaderCommit) } |> runWithRaft raft' cbs |> noError @@ -1267,12 +1267,12 @@ module ServerTests = (!sender.Outbox) |> List.head |> getAppendEntries - |> expect "Should have PrevLogIndex 0" (index 0) (fun ae -> ae.PrevLogIdx) + |> expect "Should have PrevLogIndex 0" 0 (fun ae -> ae.PrevLogIdx) - let log = LogEntry(DiscoId.Create(),index 0,term 2,DataSnapshot (State.Empty),None) + let log = LogEntry(DiscoId.Create(),0,2,DataSnapshot (State.Empty),None) do! appendEntry log >>= ignoreM - do! setNextIndex peer.Id (index 1) + do! setNextIndex peer.Id 1 let! peer = getMember peer.Id >>= (Option.get >> returnM) @@ -1281,21 +1281,21 @@ module ServerTests = (!sender.Outbox) |> List.head |> getAppendEntries - |> assume "Should have PrevLogIdx 0" (index 0) (fun ae -> ae.PrevLogIdx) + |> assume "Should have PrevLogIdx 0" 0 (fun ae -> ae.PrevLogIdx) |> assume "Should have one entry" 1 (fun ae -> ae.Entries |> Option.get |> LogEntry.depth) |> assume "Should have entry with correct id" (LogEntry.id log) (fun ae -> ae.Entries |> Option.get |> LogEntry.id) |> expect "Should have entry with term" (term 2) (fun ae -> ae.Entries |> Option.get |> LogEntry.term) sender.Outbox := List.empty // reset outbox - do! setNextIndex peer.Id (index 2) + do! setNextIndex peer.Id 2 let! peer = getMember peer.Id >>= (Option.get >> returnM) let! request = Raft.sendAppendEntry peer (!sender.Outbox) |> List.head |> getAppendEntries - |> expect "Should have PrevLogIdx 1" (index 1) (fun ae -> ae.PrevLogIdx) + |> expect "Should have PrevLogIdx 1" 1 (fun ae -> ae.PrevLogIdx) } |> runWithRaft raft' cbs |> noError @@ -1318,20 +1318,20 @@ module ServerTests = (!sender.Outbox) |> List.head |> getAppendEntries - |> expect "Should have PrevLogIdx 0" (index 0) (fun ae -> ae.PrevLogIdx) + |> expect "Should have PrevLogIdx 0" 0 (fun ae -> ae.PrevLogIdx) sender.Outbox := List.empty // reset outbox - let log = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty), None) + let log = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty), None) - do! setNextIndex peer.Id (index 1) + do! setNextIndex peer.Id 1 do! appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer (!sender.Outbox) |> List.head |> getAppendEntries - |> expect "Should have PrevLogIdx 0" (index 0) (fun ae -> ae.PrevLogIdx) + |> expect "Should have PrevLogIdx 0" 0 (fun ae -> ae.PrevLogIdx) } |> runWithRaft raft' cbs |> noError @@ -1360,7 +1360,7 @@ module ServerTests = let leader_append_entry_to_log_increases_idxno = testCase "leader append entry to log increases idxno" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let log = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) + let log = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) let raft' = defaultServer () let sender = Sender.create let cbs = Callbacks.Create (ref (DataSnapshot (State.Empty))) :> IRaftCallbacks @@ -1389,15 +1389,15 @@ module ServerTests = with SendAppendEntries = senderAppendEntries sender None } :> IRaftCallbacks - let log1 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) - let log2 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) - let log3 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) + let log1 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) + let log2 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) + let log3 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) let response = { Term = term 1 ; Success = true - ; CurrentIndex = index 3 - ; FirstIndex = index 1 + ; CurrentIndex = 3 + ; FirstIndex = 1 } let peers = @@ -1409,8 +1409,8 @@ module ServerTests = do! addMembers peers do! setState Leader do! setCurrentTerm 1 - do! setCommitIndex (index 0) - do! setLastAppliedIndex (index 0) + do! setCommitIndex 0 + do! setLastAppliedIndex 0 do! appendEntry log1 >>= ignoreM do! appendEntry log2 >>= ignoreM do! appendEntry log3 >>= ignoreM @@ -1423,11 +1423,11 @@ module ServerTests = do! Raft.receiveAppendEntriesResponse peer1.Id response // first response, no majority yet, will not set commit idx - do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex + do! expectM "Should have commit index 0" 0 RaftState.commitIndex do! Raft.receiveAppendEntriesResponse peer2.Id response // leader will now have majority followers who have appended this log - do! expectM "Should have commit index 3" (index 3) RaftState.commitIndex + do! expectM "Should have commit index 3" 3 RaftState.commitIndex let! lidx = lastAppliedIndex() expect "Should have last applied index 0" 0 id lidx @@ -1449,17 +1449,17 @@ module ServerTests = let response = { Term = term 1 ; Success = true - ; CurrentIndex = index 1 - ; FirstIndex = index 1 + ; CurrentIndex = 1 + ; FirstIndex = 1 } let raft' = defaultServer () let sender = Sender.create let cbs = Callbacks.Create (ref (DataSnapshot (State.Empty))) :> IRaftCallbacks - let log1 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) - let log2 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) - let log3 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) + let log1 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) + let log2 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) + let log3 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) let peers = [| peer1; peer2; |] @@ -1470,17 +1470,17 @@ module ServerTests = do! addMembers peers do! setState Leader do! setCurrentTerm 1 - do! setCommitIndex (index 0) - do! setLastAppliedIndex (index 0) + do! setCommitIndex 0 + do! setLastAppliedIndex 0 do! appendEntry log1 >>= ignoreM do! appendEntry log2 >>= ignoreM do! appendEntry log3 >>= ignoreM do! Raft.sendAllAppendEntries () do! Raft.receiveAppendEntriesResponse peer1.Id response do! Raft.receiveAppendEntriesResponse peer2.Id response - do! expectM "Should have matchIdx 1" (index 1) (RaftState.getMember peer1.Id >> Option.get >> Member.matchIndex) + do! expectM "Should have matchIdx 1" 1 (RaftState.getMember peer1.Id >> Option.get >> Member.matchIndex) do! Raft.receiveAppendEntriesResponse peer1.Id response - do! expectM "Should still have matchIdx 1" (index 1) (RaftState.getMember peer1.Id >> Option.get >> Member.matchIndex) + do! expectM "Should still have matchIdx 1" 1 (RaftState.getMember peer1.Id >> Option.get >> Member.matchIndex) } |> runWithRaft raft' cbs |> noError @@ -1495,14 +1495,14 @@ module ServerTests = let response = { Term = term 1 ; Success = true - ; CurrentIndex = index 1 - ; FirstIndex = index 1 } + ; CurrentIndex = 1 + ; FirstIndex = 1 } let cbs = Callbacks.Create (ref (DataSnapshot (State.Empty))) :> IRaftCallbacks - let log1 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) - let log2 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) - let log3 = LogEntry(DiscoId.Create(),index 0,term 2,DataSnapshot (State.Empty),None) + let log1 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) + let log2 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) + let log3 = LogEntry(DiscoId.Create(),0,2,DataSnapshot (State.Empty),None) let peers = [| peer1; peer2; peer3; peer4 |] @@ -1513,8 +1513,8 @@ module ServerTests = do! addMembers peers do! setState Leader do! setCurrentTerm 2 - do! setCommitIndex (index 0) - do! setLastAppliedIndex (index 0) + do! setCommitIndex 0 + do! setLastAppliedIndex 0 do! appendEntry log1 >>= ignoreM do! appendEntry log2 >>= ignoreM do! appendEntry log3 >>= ignoreM @@ -1524,10 +1524,10 @@ module ServerTests = let! request = Raft.sendAppendEntry peer2 do! Raft.receiveAppendEntriesResponse peer1.Id response - do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex + do! expectM "Should have commit index 0" 0 RaftState.commitIndex do! Raft.receiveAppendEntriesResponse peer2.Id response - do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex + do! expectM "Should have commit index 0" 0 RaftState.commitIndex do! Raft.periodic 1 @@ -1538,11 +1538,11 @@ module ServerTests = let! request = Raft.sendAppendEntry peer2 - do! Raft.receiveAppendEntriesResponse peer1.Id { response with CurrentIndex = index 2; FirstIndex = index 2 } - do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex + do! Raft.receiveAppendEntriesResponse peer1.Id { response with CurrentIndex = 2; FirstIndex = 2 } + do! expectM "Should have commit index 0" 0 RaftState.commitIndex - do! Raft.receiveAppendEntriesResponse peer2.Id { response with CurrentIndex = index 2; FirstIndex = index 2 } - do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex + do! Raft.receiveAppendEntriesResponse peer2.Id { response with CurrentIndex = 2; FirstIndex = 2 } + do! expectM "Should have commit index 0" 0 RaftState.commitIndex do! Raft.periodic 1 @@ -1553,11 +1553,11 @@ module ServerTests = let! request = Raft.sendAppendEntry peer2 - do! Raft.receiveAppendEntriesResponse peer1.Id { response with Term = term 2; CurrentIndex = index 3; FirstIndex = index 3 } - do! expectM "Should have commit index 0" (index 0) RaftState.commitIndex + do! Raft.receiveAppendEntriesResponse peer1.Id { response with Term = 2; CurrentIndex = 3; FirstIndex = 3 } + do! expectM "Should have commit index 0" 0 RaftState.commitIndex - do! Raft.receiveAppendEntriesResponse peer2.Id { response with Term = term 2; CurrentIndex = index 3; FirstIndex = index 3 } - do! expectM "Should have commit index 3" (index 3) RaftState.commitIndex + do! Raft.receiveAppendEntriesResponse peer2.Id { response with Term = 2; CurrentIndex = 3; FirstIndex = 3 } + do! expectM "Should have commit index 3" 3 RaftState.commitIndex do! Raft.periodic 1 @@ -1582,30 +1582,30 @@ module ServerTests = appendReq := Some ae } :> IRaftCallbacks - let log1 = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) - let log2 = LogEntry(DiscoId.Create(),index 0,term 2,DataSnapshot (State.Empty),None) - let log3 = LogEntry(DiscoId.Create(),index 0,term 3,DataSnapshot (State.Empty),None) - let log4 = LogEntry(DiscoId.Create(),index 0,term 4,DataSnapshot (State.Empty),None) + let log1 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) + let log2 = LogEntry(DiscoId.Create(),0,2,DataSnapshot (State.Empty),None) + let log3 = LogEntry(DiscoId.Create(),0,3,DataSnapshot (State.Empty),None) + let log4 = LogEntry(DiscoId.Create(),0,4,DataSnapshot (State.Empty),None) let response = { Term = term 1 ; Success = true - ; CurrentIndex = index 1 - ; FirstIndex = index 1 } + ; CurrentIndex = 1 + ; FirstIndex = 1 } raft { do! addMember peer do! setState Leader do! setCurrentTerm 2 - do! setCommitIndex (index 0) - do! setLastAppliedIndex (index 0) + do! setCommitIndex 0 + do! setLastAppliedIndex 0 do! appendEntry log1 >>= ignoreM do! appendEntry log2 >>= ignoreM do! appendEntry log3 >>= ignoreM do! appendEntry log4 >>= ignoreM do! Raft.becomeLeader () - do! expectM "Should have nextIdx 5" (index 5) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 5" 5 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! expectM "Should have a msg 1" 1 (konst !count) // need to get an up-to-date version of the peer, because its nextIdx @@ -1614,19 +1614,19 @@ module ServerTests = do! Raft.sendAllAppendEntries () - expect "Should have prevLogIdx 4" (index 4) AppendEntries.prevLogIdx (!appendReq |> Option.get) + expect "Should have prevLogIdx 4" 4 AppendEntries.prevLogIdx (!appendReq |> Option.get) expect "Should have prevLogTerm 4" (term 4) AppendEntries.prevLogTerm (!appendReq |> Option.get) let! trm = currentTerm () - do! Raft.receiveAppendEntriesResponse peer.Id { response with Term = trm; Success = false; CurrentIndex = index 1 } + do! Raft.receiveAppendEntriesResponse peer.Id { response with Term = trm; Success = false; CurrentIndex = 1 } - do! expectM "Should have NextIdx 2" (index 2) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) - do! expectM "Should have MatchIdx 2" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) + do! expectM "Should have NextIdx 2" 2 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have MatchIdx 2" 1 (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) do! expectM "Should have 2 msgs" 2 (konst !count) do! Raft.sendAllAppendEntries () - expect "Should have prevLogIdx 1" (index 1) AppendEntries.prevLogIdx (!appendReq |> Option.get) + expect "Should have prevLogIdx 1" 1 AppendEntries.prevLogIdx (!appendReq |> Option.get) expect "Should have prevLogTerm 1" (term 1) AppendEntries.prevLogTerm (!appendReq |> Option.get) } |> runWithCBS cbs @@ -1638,7 +1638,7 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) let lokk = new System.Object() - let ci = ref (index 0) + let ci = ref 0 let trm = ref (term 2) let result = ref false let count = ref 0 @@ -1652,12 +1652,12 @@ module ServerTests = { Term = !trm Success = !result CurrentIndex = !ci - FirstIndex = index 0 } + FirstIndex = 0 } raft { do! addMember peer do! setCurrentTerm !trm - do! setCommitIndex (index 0) + do! setCommitIndex 0 for n in 1 .. 4 do do! LogEntry(DiscoId.Create(),0,term n,DataSnapshot(State.Empty),None) @@ -1670,8 +1670,8 @@ module ServerTests = do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should have correct NextIndex" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) - do! expectM "Should have correct MatchIndex" (index 0) (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) + do! expectM "Should have correct NextIndex" 1 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have correct MatchIndex" 0 (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) do! expectM "Should have been called once" 1 (konst !count) // need to get updated peer, because nextIdx will be bumped when @@ -1681,15 +1681,15 @@ module ServerTests = // we pretend that the follower `peer` has now successfully appended those logs let! t = currentTerm () trm := t - ci := (index 4) + ci := 4 result := true // send again and process responses do! Raft.sendAllAppendEntries () do! makeResponse() |> Raft.receiveAppendEntriesResponse peer.Id - do! expectM "Should finally have NextIndex 5" (index 5) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) - do! expectM "Should finally have MatchIndex 4" (index 4) (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) + do! expectM "Should finally have NextIndex 5" 5 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should finally have MatchIndex 4" 4 (RaftState.getMember peer.Id >> Option.get >> Member.matchIndex) do! expectM "Should have been called twice" 2 (konst !count) } |> runWithCBS cbs @@ -1707,13 +1707,13 @@ module ServerTests = with SendAppendEntries = senderAppendEntries sender None } :> IRaftCallbacks - let log = LogEntry(DiscoId.Create(),index 0,term 1,DataSnapshot (State.Empty),None) + let log = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) let response = { Term = term 1 ; Success = true - ; CurrentIndex = index 1 - ; FirstIndex = index 1 + ; CurrentIndex = 1 + ; FirstIndex = 1 } let err = @@ -1728,9 +1728,9 @@ module ServerTests = raft { do! addMembers peers do! setCurrentTerm 1 - do! setCommitIndex (index 0) + do! setCommitIndex 0 do! setState Leader - do! setLastAppliedIndex (index 0) + do! setLastAppliedIndex 0 do! appendEntry log >>= ignoreM @@ -1747,7 +1747,7 @@ module ServerTests = let leader_recv_entry_resets_election_timeout = testCase "leader recv entry resets election timeout" <| fun _ -> - let log = LogEntry(DiscoId.Create(), index 0, term 1, DataSnapshot (State.Empty), None) + let log = LogEntry(DiscoId.Create(), 0, 1, DataSnapshot (State.Empty), None) raft { do! setElectionTimeout 1000 do! setState Leader @@ -1761,18 +1761,18 @@ module ServerTests = let leader_recv_entry_is_committed_returns_0_if_not_committed = testCase "leader recv entry is committed returns 0 if not committed" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let log = LogEntry(DiscoId.Create(), index 0, term 1, DataSnapshot (State.Empty), None) + let log = LogEntry(DiscoId.Create(), 0, 1, DataSnapshot (State.Empty), None) raft { do! addMember peer do! setState Leader - do! setCommitIndex (index 0) + do! setCommitIndex 0 let! response = Raft.receiveEntry log let! committed = Raft.responseCommitted response expect "Should not have committed" false id committed - do! setCommitIndex (index 1) + do! setCommitIndex 1 let! response = Raft.receiveEntry log let! committed = Raft.responseCommitted response expect "Should have committed" true id committed @@ -1786,9 +1786,9 @@ module ServerTests = let log = Log.make (term 1) (DataSnapshot (State.Empty)) let ae = - { LeaderCommit = index 1 + { LeaderCommit = 1 ; Term = term 2 - ; PrevLogIdx = index 0 + ; PrevLogIdx = 0 ; PrevLogTerm = term 0 ; Entries = Log.make (term 2) defSM |> Some } @@ -1800,27 +1800,27 @@ module ServerTests = raft { do! addMember peer do! setState Leader - do! setCommitIndex (index 0) + do! setCommitIndex 0 do! setCurrentTerm 1 - do! expectM "Should have current idx 0" (index 0) RaftState.currentIndex + do! expectM "Should have current idx 0" 0 RaftState.currentIndex let! response = Raft.receiveEntry log let! committed = Raft.responseCommitted response expect "Should not have committed entry" false id committed expect "Should have term 1" (term 1) EntryResponse.term response - expect "Should have index 1" (index 1) EntryResponse.index response + expect "Should have index 1" 1 EntryResponse.index response - do! expectM "(1) Should have current idx 1" (index 1) RaftState.currentIndex - do! expectM "Should have commit idx 0" (index 0) RaftState.commitIndex + do! expectM "(1) Should have current idx 1" 1 RaftState.currentIndex + do! expectM "Should have commit idx 0" 0 RaftState.commitIndex let! resp = Raft.receiveAppendEntries (Some peer.Id) ae expect "Should have succeeded" true AppendResponse.succeeded resp - do! expectM "(2) Should have current idx 1" (index 1) RaftState.currentIndex - do! expectM "Should have commit idx 1" (index 1) RaftState.commitIndex + do! expectM "(2) Should have current idx 1" 1 RaftState.currentIndex + do! expectM "Should have commit idx 1" 1 RaftState.commitIndex return! Raft.responseCommitted response } @@ -1846,8 +1846,8 @@ module ServerTests = do! addMember peer do! setState Leader do! setCurrentTerm 1 - do! setCommitIndex (index 0) - do! setNextIndex peer.Id (index 1) + do! setCommitIndex 0 + do! setNextIndex peer.Id 1 do! appendEntry log >>= ignoreM let! response = Raft.receiveEntry log @@ -1872,23 +1872,23 @@ module ServerTests = let resp = { Term = term 1 ; Success = false - ; CurrentIndex = index 0 - ; FirstIndex = index 0 + ; CurrentIndex = 0 + ; FirstIndex = 0 } raft { do! addMember peer do! setState Leader do! setCurrentTerm 1 - do! setCommitIndex (index 0) + do! setCommitIndex 0 do! appendEntry log >>= ignoreM let! request = Raft.sendAppendEntry peer do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx Works 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx Works 1" 1 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx Dont work 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx Dont work 1" 1 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) } |> runWithRaft raft' cbs |> noError @@ -1906,17 +1906,17 @@ module ServerTests = let resp = { Term = term 1 ; Success = true - ; CurrentIndex = index 0 - ; FirstIndex = index 0 + ; CurrentIndex = 0 + ; FirstIndex = 0 } raft { do! addMember peer do! setState Leader do! setCurrentTerm 1 - do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 1" 1 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 1" 1 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) } |> runWithRaft raft' cbs |> noError @@ -1935,16 +1935,16 @@ module ServerTests = let resp = { Term = term 1 ; Success = true - ; CurrentIndex = index 1 - ; FirstIndex = index 1 + ; CurrentIndex = 1 + ; FirstIndex = 1 } raft { do! addMember peer do! setState Leader do! setCurrentTerm 2 - do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 1" 1 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) do! Raft.receiveAppendEntriesResponse peer.Id resp - do! expectM "Should have nextIdx 1" (index 1) (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) + do! expectM "Should have nextIdx 1" 1 (RaftState.getMember peer.Id >> Option.get >> Member.nextIndex) } |> runWithRaft raft' cbs |> noError @@ -1954,9 +1954,9 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) let ae = { Term = term 6 - PrevLogIdx = index 6 + PrevLogIdx = 6 PrevLogTerm = term 5 - LeaderCommit = index 0 + LeaderCommit = 0 Entries = None } raft { @@ -1981,9 +1981,9 @@ module ServerTests = let peer = Member.create (DiscoId.Create()) let resp = { Term = term 6 - ; PrevLogIdx = index 5 + ; PrevLogIdx = 5 ; PrevLogTerm = term 5 - ; LeaderCommit = index 0 + ; LeaderCommit = 0 ; Entries = None } raft { @@ -2009,8 +2009,8 @@ module ServerTests = let response = ref { Term = term 0 Success = true - CurrentIndex = index 1 - FirstIndex = index 1 } + CurrentIndex = 1 + FirstIndex = 1 } let cbs = { Callbacks.Create (ref defSM) @@ -2037,7 +2037,7 @@ module ServerTests = let! mem1 = getMember peer1.Id response := { !response with - CurrentIndex = Option.get mem1 |> Member.nextIndex |> ((+) (index 1)) } + CurrentIndex = Option.get mem1 |> Member.nextIndex |> ((+) 1) } do! Raft.periodic 501 @@ -2056,7 +2056,7 @@ module ServerTests = let vote = { Term = term 1 ; Candidate = peer2 - ; LastLogIndex = index 0 + ; LastLogIndex = 0 ; LastLogTerm = term 0 } let peers = @@ -2090,7 +2090,7 @@ module ServerTests = let vote = { Term = term 2 ; Candidate = peer2 - ; LastLogIndex = index 0 + ; LastLogIndex = 0 ; LastLogTerm = term 0 } let peers = @@ -2191,7 +2191,7 @@ module ServerTests = let server_should_apply_each_log_when_receiving_a_snapshot = testCase "should apply each log when receiving a snapshot" <| fun _ -> - let idx = index 9 + let idx = 9 let trm = term 1 let count = ref 0 @@ -2223,7 +2223,7 @@ module ServerTests = let server_should_merge_snaphot_and_existing_log_when_receiving_a_snapshot = testCase "should merge snaphot and existing log when receiving a snapshot" <| fun _ -> - let idx = index 9 + let idx = 9 let num = 5 let trm = term 1 let count = ref 0 @@ -2282,14 +2282,14 @@ module ServerTests = do! setState Leader - do! appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberAdded(mem)|] ,None)) >>= ignoreM - do! setCommitIndex (index 1) + do! appendEntry (JointConsensus(DiscoId.Create(), 0, 0, [| ConfigChange.MemberAdded(mem)|] ,None)) >>= ignoreM + do! setCommitIndex 1 do! Raft.applyEntries () expect "Should have count 1" 1 id !count - do! appendEntry (JointConsensus(DiscoId.Create(), index 0, term 0, [| ConfigChange.MemberRemoved mem |] ,None)) >>= ignoreM - do! setCommitIndex (index 3) + do! appendEntry (JointConsensus(DiscoId.Create(), 0, 0, [| ConfigChange.MemberRemoved mem |] ,None)) >>= ignoreM + do! setCommitIndex 3 do! Raft.applyEntries () expect "Should have count 2" 2 id !count diff --git a/src/Disco/Disco/Tests/TestUtilities.fs b/src/Disco/Disco/Tests/TestUtilities.fs index 6d4affac..3426fa06 100644 --- a/src/Disco/Disco/Tests/TestUtilities.fs +++ b/src/Disco/Disco/Tests/TestUtilities.fs @@ -403,11 +403,11 @@ module TestData = either { let! state = mkTmpDir() |> mkState return - LogEntry(DiscoId.Create(), index 7, term 1, DataSnapshot(state), - Some <| LogEntry(DiscoId.Create(), index 6, term 1, DataSnapshot(state), - Some <| Configuration(DiscoId.Create(), index 5, term 1, [| mkMember () |], - Some <| JointConsensus(DiscoId.Create(), index 4, term 1, mkChanges (), - Some <| Snapshot(DiscoId.Create(), index 3, term 1, index 2, term 1, mkMembers (), DataSnapshot(state)))))) + LogEntry(DiscoId.Create(),7,1, DataSnapshot(state), + Some <| LogEntry(DiscoId.Create(),6,1, DataSnapshot(state), + Some <| Configuration(DiscoId.Create(),5,1, [| mkMember () |], + Some <| JointConsensus(DiscoId.Create(), 4, 1, mkChanges (), + Some <| Snapshot(DiscoId.Create(), 3, 1, 2, 1, mkMembers (), DataSnapshot(state)))))) |> Log.fromEntries } From 64e147ab9c5be68ea6508f9593fe0d4190b5ee09 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Fri, 9 Feb 2018 10:45:22 +0100 Subject: [PATCH 11/27] term N -> N --- src/Disco/Disco/Core/Aliases.fs | 2 - src/Disco/Disco/Core/CuePlayer.fs | 4 +- src/Disco/Disco/Core/Pin.fs | 36 ++-- src/Disco/Disco/Raft/Log.fs | 2 +- src/Disco/Disco/Raft/LogEntry.fs | 23 ++- src/Disco/Disco/Raft/Member.fs | 4 +- src/Disco/Disco/Raft/Raft.fs | 8 +- src/Disco/Disco/Raft/RaftState.fs | 2 +- src/Disco/Disco/Raft/Types.fs | 32 +-- src/Disco/Disco/Service/RaftServer.fs | 2 +- src/Disco/Disco/Tests/Core/Generators.fs | 4 +- .../Disco/Tests/Raft/AppendEntriesTests.fs | 160 +++++++-------- .../Disco/Tests/Raft/JointConsensusTests.fs | 22 +- src/Disco/Disco/Tests/Raft/LogTests.fs | 98 ++++----- src/Disco/Disco/Tests/Raft/ServerTests.fs | 194 +++++++++--------- src/Disco/Disco/Tests/TestUtilities.fs | 2 +- 16 files changed, 291 insertions(+), 304 deletions(-) diff --git a/src/Disco/Disco/Core/Aliases.fs b/src/Disco/Disco/Core/Aliases.fs index 6a55f656..3686cac8 100644 --- a/src/Disco/Disco/Core/Aliases.fs +++ b/src/Disco/Disco/Core/Aliases.fs @@ -101,8 +101,6 @@ module Measure = let email e: Email = UoM.wrap e let port p: Port = UoM.wrap p let checksum t: Hash = UoM.wrap t - let index i: Index = i * 1 - let term t: Term = t * 1 let version v: Version = UoM.wrap v let astag t: Tag = UoM.wrap t let url t: Url = UoM.wrap t diff --git a/src/Disco/Disco/Core/CuePlayer.fs b/src/Disco/Disco/Core/CuePlayer.fs index 6605188f..aa02f2c9 100644 --- a/src/Disco/Disco/Core/CuePlayer.fs +++ b/src/Disco/Disco/Core/CuePlayer.fs @@ -83,7 +83,7 @@ type CuePlayerYaml() = Locked = yaml.Locked Active = yaml.Active CueListId = str2opt yaml.CueListId - Selected = index yaml.Selected + Selected = 1 * yaml.Selected CallId = call NextId = next PreviousId = previous @@ -235,7 +235,7 @@ type CuePlayer = Name = name fb.Name Locked = fb.Locked Active = fb.Active - Selected = index fb.Selected + Selected = 1 * fb.Selected RemainingWait = fb.RemainingWait CueListId = cuelist CallId = call diff --git a/src/Disco/Disco/Core/Pin.fs b/src/Disco/Disco/Core/Pin.fs index e9c30686..41462a4d 100644 --- a/src/Disco/Disco/Core/Pin.fs +++ b/src/Disco/Disco/Core/Pin.fs @@ -2868,7 +2868,7 @@ type Slice = let slice = fb.Slice() if slice.HasValue then let value = slice.Value - StringSlice(index fb.Index, value.Value) + StringSlice(1 * fb.Index, value.Value) |> Either.succeed else "Could not parse StringSlice" @@ -2879,7 +2879,7 @@ type Slice = let slice = fb.Slice() if slice.HasValue then let value = slice.Value - NumberSlice(index fb.Index,value.Value) + NumberSlice(fb.Index * 1,value.Value) |> Either.succeed else "Could not parse NumberSlice" @@ -2890,7 +2890,7 @@ type Slice = let slice = fb.Slice() if slice.HasValue then let value = slice.Value - BoolSlice(index fb.Index, value.Trigger, value.Value) + BoolSlice(fb.Index * 1, value.Trigger, value.Value) |> Either.succeed else "Could not parse BoolSlice" @@ -2901,7 +2901,7 @@ type Slice = let slice = fb.Slice() if slice.HasValue then let value = slice.Value - ByteSlice(index fb.Index, String.decodeBase64 value.Value) + ByteSlice(fb.Index * 1, String.decodeBase64 value.Value) |> Either.succeed else "Could not parse ByteSlice" @@ -2914,7 +2914,7 @@ type Slice = either { let value = slice.Value let! prop = Property.FromFB value - return EnumSlice(index fb.Index, prop) + return EnumSlice(fb.Index * 1, prop) } else "Could not parse EnumSlice" @@ -2927,7 +2927,7 @@ type Slice = either { let value = slice.Value let! color = ColorSpace.FromFB value - return ColorSlice(index fb.Index, color) + return ColorSlice(fb.Index * 1, color) } else "Could not parse ColorSlice" @@ -3102,12 +3102,12 @@ type Slices = member self.Map (f: Slice -> 'a) : 'a array = match self with - | StringSlices (_,_,arr) -> Array.mapi (fun i el -> StringSlice (index i, el) |> f) arr - | NumberSlices (_,_,arr) -> Array.mapi (fun i el -> NumberSlice (index i, el) |> f) arr - | BoolSlices (_,_,t,arr) -> Array.mapi (fun i el -> BoolSlice (index i, t, el) |> f) arr - | ByteSlices (_,_,arr) -> Array.mapi (fun i el -> ByteSlice (index i, el) |> f) arr - | EnumSlices (_,_,arr) -> Array.mapi (fun i el -> EnumSlice (index i, el) |> f) arr - | ColorSlices (_,_,arr) -> Array.mapi (fun i el -> ColorSlice (index i, el) |> f) arr + | StringSlices (_,_,arr) -> Array.mapi (fun i el -> StringSlice (1 * i, el) |> f) arr + | NumberSlices (_,_,arr) -> Array.mapi (fun i el -> NumberSlice (1 * i, el) |> f) arr + | BoolSlices (_,_,t,arr) -> Array.mapi (fun i el -> BoolSlice (1 * i, t, el) |> f) arr + | ByteSlices (_,_,arr) -> Array.mapi (fun i el -> ByteSlice (1 * i, el) |> f) arr + | EnumSlices (_,_,arr) -> Array.mapi (fun i el -> EnumSlice (1 * i, el) |> f) arr + | ColorSlices (_,_,arr) -> Array.mapi (fun i el -> ColorSlice (1 * i, el) |> f) arr #if !FABLE_COMPILER @@ -3733,7 +3733,7 @@ module SliceYaml = match str with | null -> null | _ -> str :?> String - StringSlice(index yml.Index, parse yml.Value) + StringSlice(1 * yml.Index, parse yml.Value) | "NumberSlice" -> Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Number)") <| fun _ -> let parse (value: obj) = @@ -3750,21 +3750,21 @@ module SliceYaml = |> sprintf "normalizing to 0.0. offending value: %A reason: %s" value |> Logger.err "toSlices (Number)" 0.0 - NumberSlice(index yml.Index, parse yml.Value) + NumberSlice(1 * yml.Index, parse yml.Value) | "BoolSlice" -> Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Bool)") <| fun _ -> - BoolSlice(index yml.Index, yml.Trigger, yml.Value :?> bool) + BoolSlice(1 * yml.Index, yml.Trigger, yml.Value :?> bool) | "ByteSlice" -> Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Byte)") <| fun _ -> - ByteSlice(index yml.Index, yml.Value |> string |> Convert.FromBase64String) + ByteSlice(1 * yml.Index, yml.Value |> string |> Convert.FromBase64String) | "EnumSlice" -> Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Enum)") <| fun _ -> let pyml = yml.Value :?> PropertyYaml - EnumSlice(index yml.Index, { Key = pyml.Key; Value = pyml.Value }) + EnumSlice(1 * yml.Index, { Key = pyml.Key; Value = pyml.Value }) | "ColorSlice" -> either { let! color = Yaml.fromYaml(yml.Value :?> ColorYaml) - return ColorSlice(index yml.Index, color) + return ColorSlice(1 * yml.Index, color) } | unknown -> sprintf "Could not de-serialize unknown type: %A" unknown diff --git a/src/Disco/Disco/Raft/Log.fs b/src/Disco/Disco/Raft/Log.fs index d8b81f54..3785d01d 100644 --- a/src/Disco/Disco/Raft/Log.fs +++ b/src/Disco/Disco/Raft/Log.fs @@ -200,7 +200,7 @@ module Log = let term log = match log.Data with | Some entries -> LogEntry.term entries - | _ -> term 0 + | _ -> 0 // ** prevTerm diff --git a/src/Disco/Disco/Raft/LogEntry.fs b/src/Disco/Disco/Raft/LogEntry.fs index 64982694..b0ea8940 100644 --- a/src/Disco/Disco/Raft/LogEntry.fs +++ b/src/Disco/Disco/Raft/LogEntry.fs @@ -423,7 +423,7 @@ type LogEntry = let! id = Id.decodeId logentry // successfully parsed this LogEntry, so return it wrapped in an option - return (id, index logentry.Index, term logentry.Term, mems, previous) + return (id, 1 * logentry.Index, 1 * logentry.Term, mems, previous) |> Configuration |> Some else @@ -463,7 +463,7 @@ type LogEntry = arr |> Either.map snd let! id = Id.decodeId logentry - return (id, index logentry.Index, term logentry.Term, changes, previous) + return (id, 1 * logentry.Index, 1 * logentry.Term, changes, previous) |> JointConsensus |> Some else @@ -484,7 +484,7 @@ type LogEntry = if data.HasValue then let! command = StateMachine.FromFB data.Value let! id = Id.decodeId logentry - return(id, index logentry.Index, term logentry.Term, command, previous) + return(id, 1 * logentry.Index, 1 * logentry.Term, command, previous) |> LogEntry |> Some else @@ -533,14 +533,15 @@ type LogEntry = arr |> Either.map snd - return Snapshot(id, - index logentry.Index, - term logentry.Term, - index logentry.LastIndex, - term logentry.LastTerm, - mems, - state) - |> Some + return + Some $ Snapshot( + id, + 1 * logentry.Index, + 1 * logentry.Term, + 1 * logentry.LastIndex, + 1 * logentry.LastTerm, + mems, + state) else return! "Could not parse empty StateMachineFB" diff --git a/src/Disco/Disco/Raft/Member.fs b/src/Disco/Disco/Raft/Member.fs index 3adfc384..5fe3267b 100644 --- a/src/Disco/Disco/Raft/Member.fs +++ b/src/Disco/Disco/Raft/Member.fs @@ -331,8 +331,8 @@ type RaftMember = RaftPort = port fb.RaftPort Voting = fb.Voting VotedForMe = fb.VotedForMe - NextIndex = index fb.NextIndex - MatchIndex = index fb.MatchIndex + NextIndex = 1 * fb.NextIndex + MatchIndex = 1 * fb.MatchIndex } } diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index 01c8545d..eb54d9c2 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -145,7 +145,7 @@ module rec Raft = let fidx = match fst with | Some fidx -> fidx - | _ -> msg.PrevLogIdx + (log |> LogEntry.depth |> int |> index) + | _ -> msg.PrevLogIdx + ((log |> LogEntry.depth |> int) * 1) return resp |> AppendResponse.setCurrentIndex (LogEntry.index log) @@ -309,8 +309,6 @@ module rec Raft = do! msg.PrevLogIdx |> String.format "Failed. No log at (prev-log-idx: {0})" |> error "receiveAppendEntries" - let! state = get - do printfn "state: %A" state return resp else return! processEntry nid msg resp @@ -402,7 +400,7 @@ module rec Raft = let request: AppendEntries = { Term = state.CurrentTerm PrevLogIdx = 0 - PrevLogTerm = term 0 + PrevLogTerm = 0 LeaderCommit = state.CommitIndex Entries = entries } @@ -519,7 +517,7 @@ module rec Raft = let d = cidx - nxtidx if d < 0 then 0 else d - if difference <= (index (int maxDepth) + 1) then + if difference <= (1 * (int maxDepth) + 1) then // Only send new entries. Don't send the entry to peers who are // behind, to prevent them from becoming congested. do! sendAppendEntry mem diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index 4640666c..6901c8e8 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -366,7 +366,7 @@ module RaftState = let create (self: RaftMember) = { Member = self State = Follower - CurrentTerm = term 0 + CurrentTerm = 0 CurrentLeader = None Peers = Map.ofList [(self.Id, self)] OldPeers = None diff --git a/src/Disco/Disco/Raft/Types.fs b/src/Disco/Disco/Raft/Types.fs index e9ec1168..76a6d041 100644 --- a/src/Disco/Disco/Raft/Types.fs +++ b/src/Disco/Disco/Raft/Types.fs @@ -50,8 +50,8 @@ type EntryResponse = let! id = Id.decodeId fb return { Id = id - Term = term fb.Term - Index = index fb.Index + Term = 1 * fb.Term + Index = 1 * fb.Index } } @@ -127,10 +127,10 @@ type VoteRequest = let candidate = fb.Candidate if candidate.HasValue then let! mem = RaftMember.FromFB candidate.Value - return { Term = term fb.Term + return { Term = 1 * fb.Term Candidate = mem - LastLogIndex = index fb.LastLogIndex - LastLogTerm = term fb.LastLogTerm } + LastLogIndex = 1 * fb.LastLogIndex + LastLogTerm = 1 * fb.LastLogTerm } else return! "Could not parse empty MemberFB" @@ -199,7 +199,7 @@ type VoteResponse = else Right None return { - Term = term fb.Term + Term = 1 * fb.Term Granted = fb.Granted Reason = reason } @@ -310,10 +310,10 @@ type AppendEntries = raw.[i] <- entry.Value LogEntry.FromFB raw - return { Term = term fb.Term - PrevLogIdx = index fb.PrevLogIdx - PrevLogTerm = term fb.PrevLogTerm - LeaderCommit = index fb.LeaderCommit + return { Term = 1 * fb.Term + PrevLogIdx = 1 * fb.PrevLogIdx + PrevLogTerm = 1 * fb.PrevLogTerm + LeaderCommit = 1 * fb.LeaderCommit Entries = entries } } @@ -405,10 +405,10 @@ type AppendResponse = static member FromFB (fb: AppendResponseFB) = Either.succeed { - Term = term fb.Term + Term = 1 * fb.Term Success = fb.Success - CurrentIndex = index fb.CurrentIndex - FirstIndex = index fb.FirstIndex + CurrentIndex = 1 * fb.CurrentIndex + FirstIndex = 1 * fb.FirstIndex } // ** ToOffset @@ -519,10 +519,10 @@ type InstallSnapshot = | Some entries -> let! leaderId = Id.decodeLeaderId fb return { - Term = term fb.Term + Term = 1 * fb.Term LeaderId = leaderId - LastIndex = index fb.LastIndex - LastTerm = term fb.LastTerm + LastIndex = 1 * fb.LastIndex + LastTerm = 1 * fb.LastTerm Data = entries } | _ -> diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index d526e35a..56123aad 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -1308,7 +1308,7 @@ module rec RaftServer = let private initializeRaft (callbacks: IRaftCallbacks) (state: RaftState) = let rand = System.Random() raft { - let term = term 0 + let term = 0 do! setCurrentTerm term let! num = RaftMonad.numMembers () diff --git a/src/Disco/Disco/Tests/Core/Generators.fs b/src/Disco/Disco/Tests/Core/Generators.fs index 2adfbe81..6b4fecde 100644 --- a/src/Disco/Disco/Tests/Core/Generators.fs +++ b/src/Disco/Disco/Tests/Core/Generators.fs @@ -80,8 +80,8 @@ module Generators = let uint32Gen = Arb.generate let uint64Gen = Arb.generate - let indexGen = Gen.map index intGen - let termGen = Gen.map term intGen + let indexGen = Gen.map ((*) 1) intGen + let termGen = Gen.map ((*) 1) intGen let nameGen = Gen.map name stringGen let emailGen = Gen.map email stringGen let hashGen = Gen.map checksum stringGen diff --git a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs index 4d7643d3..949f815a 100644 --- a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs +++ b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs @@ -35,11 +35,11 @@ module AppendEntries = do! setCurrentTerm 5 let msg = - { Term = term 1 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 0 - ; LeaderCommit = 0 - ; Entries = None } + { Term = 1 + PrevLogIdx = 0 + PrevLogTerm = 0 + LeaderCommit = 0 + Entries = None } let! result = Raft.receiveAppendEntries (Some peer.Id) msg expect "Request should have failed" true AppendResponse.failed result @@ -53,11 +53,11 @@ module AppendEntries = raft { do! addMember (Member.create (DiscoId.Create())) let msg = - { Term = term 1 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 0 - ; LeaderCommit = 1 - ; Entries = None } + { Term = 1 + PrevLogIdx = 0 + PrevLogTerm = 0 + LeaderCommit = 1 + Entries = None } let! response = Raft.receiveAppendEntries None msg expect "Request should be success" true AppendResponse.succeeded response @@ -74,9 +74,9 @@ module AppendEntries = do! setCurrentTerm 1 do! expectM "Should not have a leader" None RaftState.currentLeader let msg = { - Term = term 2 + Term = 2 PrevLogIdx = 0 - PrevLogTerm = term 0 + PrevLogTerm = 0 LeaderCommit = 0 Entries = None } @@ -84,9 +84,9 @@ module AppendEntries = let! (response: AppendResponse) = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should be successful" true AppendResponse.succeeded response - expect "Response should have term 2" (term 2) AppendResponse.term response + expect "Response should have term 2" 2 AppendResponse.term response - do! expectM "Raft should have term 2" (term 2) RaftState.currentTerm + do! expectM "Raft should have term 2" 2 RaftState.currentTerm do! expectM "should have leader" (Some peer.Id) RaftState.currentLeader } |> runWithDefaults @@ -100,12 +100,11 @@ module AppendEntries = do! setState Follower do! expectM "Should have 0 log entries" 0 RaftState.numLogs let msg = - { Term = term 1 - ; PrevLogIdx = 1 - ; PrevLogTerm = term 4 - ; LeaderCommit = 5 - ; Entries = None - } + { Term = 1 + PrevLogIdx = 1 + PrevLogTerm = 4 + LeaderCommit = 5 + Entries = None } let! response = Raft.receiveAppendEntries (Some peer.Id) msg do! expectM "Should still have 0 log entries" 0 RaftState.numLogs } @@ -120,17 +119,16 @@ module AppendEntries = do! setState Follower do! expectM "Should log count 0" 0 RaftState.numLogs let msg = - { Term = term 3 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 1 - ; LeaderCommit = 5 - ; Entries = Log.make (term 2) defSM |> Some - } + { Term = 3 + PrevLogIdx = 0 + PrevLogTerm = 1 + LeaderCommit = 5 + Entries = Log.make 2 defSM |> Some } let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should be a success" true AppendResponse.succeeded response do! expectM "Should have log count 1" 1 RaftState.numLogs let! entry = entryAt 1 - expect "Should have term 2" (term 2) (Option.get >> LogEntry.term) entry + expect "Should have term 2" 2 (Option.get >> LogEntry.term) entry } |> runWithDefaults |> ignore @@ -143,12 +141,11 @@ module AppendEntries = do! setCurrentTerm 2 let msg = - { Term = term 2 - ; PrevLogIdx = 1 - ; PrevLogTerm = term 1 - ; LeaderCommit = 5 - ; Entries = Log.make (term 0) defSM |> Some - } + { Term = 2 + PrevLogIdx = 1 + PrevLogTerm = 1 + LeaderCommit = 5 + Entries = Log.make 0 defSM |> Some } let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should not have succeeded" true AppendResponse.failed response } @@ -195,11 +192,11 @@ module AppendEntries = } let newer = { - Term = term 2 + Term = 2 PrevLogIdx = 1 - PrevLogTerm = term 1 + PrevLogTerm = 1 LeaderCommit = 5 - Entries = Log.make (term 2) addCue |> Some + Entries = Log.make 2 addCue |> Some } let! response = Raft.receiveAppendEntries (Some peer.Id) newer @@ -239,12 +236,11 @@ module AppendEntries = do! _entries_for_conflict_tests data // add some log entries let newer = - { Term = term 2 - ; PrevLogIdx = 1 - ; PrevLogTerm = term 1 - ; LeaderCommit = 5 - ; Entries = None - } + { Term = 2 + PrevLogIdx = 1 + PrevLogTerm = 1 + LeaderCommit = 5 + Entries = None } let! response = Raft.receiveAppendEntries (Some peer.Id) newer expect "Should have succeeded" true AppendResponse.succeeded response @@ -268,12 +264,11 @@ module AppendEntries = do! setCurrentTerm 1 let newer = - { Term = term 1 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 1 - ; LeaderCommit = 5 - ; Entries = Some log - } + { Term = 1 + PrevLogIdx = 0 + PrevLogTerm = 1 + LeaderCommit = 5 + Entries = Some log } let! response = Raft.receiveAppendEntries (Some peer.Id) newer expect "Should be a success" true AppendResponse.succeeded response @@ -290,12 +285,11 @@ module AppendEntries = let log = Log.fromEntries entry let next = - { Term = term 1 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 1 - ; LeaderCommit = 5 - ; Entries = Some entry - } + { Term = 1 + PrevLogIdx = 0 + PrevLogTerm = 1 + LeaderCommit = 5 + Entries = Some entry } let raft' = defaultServer () let cbs = Callbacks.Create (ref defSM) :> IRaftCallbacks @@ -310,7 +304,7 @@ module AppendEntries = expect "Should still be a success" true AppendResponse.succeeded response do! expectM "Should have log count 1" 1 RaftState.numLogs - let log'' = Log.append (Log.make (term 1) (DataSnapshot (State.Empty))) log + let log'' = Log.append (Log.make 1 (DataSnapshot (State.Empty))) log let msg = { next with Entries = log''.Data } let! response = Raft.receiveAppendEntries (Some peer.Id) msg @@ -331,19 +325,18 @@ module AppendEntries = Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), None)))) let msg = - { Term = term 1 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 1 - ; LeaderCommit = 5 - ; Entries = Some log - } + { Term = 1 + PrevLogIdx = 0 + PrevLogTerm = 1 + LeaderCommit = 5 + Entries = Some log } raft { do! addMember peer let! response = Raft.receiveAppendEntries (Some peer.Id) msg expect "Should have been successful" true AppendResponse.succeeded response expect "Should have correct CurrentIndex" 4 AppendResponse.currentIndex response - do! expectM "Should have commit index 4" (index 4) RaftState.commitIndex + do! expectM "Should have commit index 4" 4 RaftState.commitIndex } |> runWithDefaults |> ignore @@ -353,18 +346,17 @@ module AppendEntries = let peer = Member.create (DiscoId.Create()) let log = - LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), index 0, term 1, DataSnapshot (State.Empty), None)))) + LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), None)))) let msg = - { Term = term 1 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 1 - ; LeaderCommit = 0 - ; Entries = Some log - } + { Term = 1 + PrevLogIdx = 0 + PrevLogTerm = 1 + LeaderCommit = 0 + Entries = Some log } raft { do! addMember peer @@ -381,15 +373,14 @@ module AppendEntries = testCase "follower recv appendentries failure includes current idx" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let log id = LogEntry(id, index 0, term 1, DataSnapshot (State.Empty), None) + let log id = LogEntry(id, 0, 1, DataSnapshot (State.Empty), None) let msg = - { Term = term 0 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 0 - ; LeaderCommit = 0 - ; Entries = None - } + { Term = 0 + PrevLogIdx = 0 + PrevLogTerm = 0 + LeaderCommit = 0 + Entries = None } raft { do! addMember peer @@ -413,12 +404,11 @@ module AppendEntries = let peer = Member.create (DiscoId.Create()) let msg = - { Term = term 1 - ; PrevLogIdx = 0 - ; PrevLogTerm = term 0 - ; LeaderCommit = 0 - ; Entries = None - } + { Term = 1 + PrevLogIdx = 0 + PrevLogTerm = 0 + LeaderCommit = 0 + Entries = None } raft { do! setElectionTimeout 1000 diff --git a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs index 8b20620a..5dec6e22 100644 --- a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs +++ b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs @@ -23,7 +23,7 @@ module JointConsensus = let server_periodic_executes_all_cfg_changes = testCase "periodic executes all cfg changes" <| fun _ -> - let trm = term 1 + let trm = 1 let response = { Term = trm; Granted = true; Reason = None } @@ -69,7 +69,7 @@ module JointConsensus = let cbs = Callbacks.Create (ref defSM) :> IRaftCallbacks let makeResponse() = - { Term = term 0 + { Term = 0 Success = true CurrentIndex = !ci FirstIndex = 1 } @@ -190,7 +190,7 @@ module JointConsensus = yield (nid, Member.create nid) |] // create mem in the Raft state let ci = ref 0 - let trm = ref (term 1) + let trm = ref 1 let lokk = new System.Object() let vote = { Granted = true; Term = !trm; Reason = None } @@ -250,7 +250,7 @@ module JointConsensus = |> Array.take (n / 2) |> Array.map snd |> Log.calculateChanges peers - |> Log.mkConfigChange (term 1) + |> Log.mkConfigChange 1 let! idx = currentIndex () ci := idx @@ -400,7 +400,7 @@ module JointConsensus = mems |> Array.map snd |> Log.calculateChanges peers - |> Log.mkConfigChange (term 1) + |> Log.mkConfigChange 1 let! idx = currentIndex () ci := idx @@ -517,7 +517,7 @@ module JointConsensus = let n = 10 // we want ten mems overall let ci = ref 0 - let trm = ref (term 1) + let trm = ref 1 let lokk = new System.Object() let mems = @@ -650,7 +650,7 @@ module JointConsensus = let lokk = new System.Object() let count = ref 0 let ci = ref 0 - let trm = ref (term 1) + let trm = ref 1 let init = defaultServer() let cbs = { Callbacks.Create (ref defSM) with SendAppendEntries = fun _ _ -> lock lokk <| fun _ -> count := 1 + !count } @@ -723,7 +723,7 @@ module JointConsensus = testCase "should send appendentries to all servers in joint consensus" <| fun _ -> let lokk = new System.Object() let count = ref 0 - let trm = ref (term 1) + let trm = ref 1 let init = defaultServer() let cbs = { Callbacks.Create (ref defSM) with SendRequestVote = fun _ _ -> lock lokk <| fun _ -> count := 1 + !count } @@ -760,7 +760,7 @@ module JointConsensus = |> Array.map snd |> Array.append [| self |] |> Log.calculateChanges peers - |> Log.mkConfigChange (term 1) + |> Log.mkConfigChange 1 let! response = Raft.receiveEntry entry @@ -796,7 +796,7 @@ module JointConsensus = let self = snd mems.[0] let lokk = new System.Object() let ci = ref 0 - let trm = ref (term 1) + let trm = ref 1 let count = ref 0 let init = RaftState.create self let cbs = @@ -922,7 +922,7 @@ module JointConsensus = |> Array.map snd |> Array.append [| self |] |> Log.calculateChanges peers - |> Log.mkConfigChange (term 1) + |> Log.mkConfigChange 1 let! response = Raft.receiveEntry entry diff --git a/src/Disco/Disco/Tests/Raft/LogTests.fs b/src/Disco/Disco/Tests/Raft/LogTests.fs index 5e1c19d3..b0fe6ab8 100644 --- a/src/Disco/Disco/Tests/Raft/LogTests.fs +++ b/src/Disco/Disco/Tests/Raft/LogTests.fs @@ -32,28 +32,28 @@ module Log = let log_is_non_empty = testCase "When create, a log should not be empty" <| fun _ -> Log.empty - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should be one" 1 Log.length - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should be two" 2 Log.length - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should be three" 3 Log.length |> ignore let log_have_correct_index = testCase "When I add an entry, it should have the correct index" <| fun _ -> Log.empty - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should have currentIndex 1" 1 Log.index - |> assume "Should have currentTerm 1" (term 1) Log.term + |> assume "Should have currentTerm 1" 1 Log.term |> assume "Should have no lastTerm" None Log.prevTerm |> assume "Should have no lastIndex" None Log.prevIndex - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should have currentIndex 2" 2 Log.index - |> assume "Should have currentTerm 1" (term 1) Log.term - |> assume "Should have lastTerm 1" (Some (term 1)) Log.prevTerm + |> assume "Should have currentTerm 1" 1 Log.term + |> assume "Should have lastTerm 1" (Some 1) Log.prevTerm |> assume "Should have lastIndex 1" (Some 1) Log.prevIndex |> ignore @@ -66,9 +66,9 @@ module Log = let log = Log.empty - |> Log.append (LogEntry(id1, 0, term 1, defSM, None)) - |> Log.append (LogEntry(id2, 0, term 1, defSM, None)) - |> Log.append (LogEntry(id3, 0, term 1, defSM, None)) + |> Log.append (LogEntry(id1, 0, 1, defSM, None)) + |> Log.append (LogEntry(id2, 0, 1, defSM, None)) + |> Log.append (LogEntry(id3, 0, 1, defSM, None)) Log.at 1 log |> assume "Should be correct one" id1 (LogEntry.id << Option.get) @@ -92,9 +92,9 @@ module Log = let log = Log.empty - |> Log.append (LogEntry(id1, 0, term 1, defSM, None)) - |> Log.append (LogEntry(id2, 0, term 1, defSM, None)) - |> Log.append (LogEntry(id3, 0, term 1, defSM, None)) + |> Log.append (LogEntry(id1, 0, 1, defSM, None)) + |> Log.append (LogEntry(id2, 0, 1, defSM, None)) + |> Log.append (LogEntry(id3, 0, 1, defSM, None)) Log.find id1 log |> assume "Should be correct one" id1 (LogEntry.id << Option.get) @@ -115,12 +115,12 @@ module Log = let log_depth_test = testCase "Should have the correct log depth" <| fun _ -> Log.empty - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should have length 3" 3 Log.length - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should have depth 5" 5 Log.length |> ignore @@ -129,9 +129,9 @@ module Log = let sm = AddCue { Id = DiscoId.Create(); Name = name "Wonderful"; Slices = [| |] } let log = Log.empty - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) sm) - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 sm) + |> Log.append (Log.make 1 defSM) let folder (m: int) (log: LogEntry) : Continue = let value = (LogEntry.data >> Option.get) log @@ -149,14 +149,14 @@ module Log = testCase "Should have correct length" <| fun _ -> let log = Log.empty - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) log - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should have length 6" 6 Log.length |> ignore @@ -170,14 +170,14 @@ module Log = let log = Log.empty - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) log - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) - |> Log.append (Log.make (term 1) defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) + |> Log.append (Log.make 1 defSM) |> assume "Should be monotonic" true (isMonotonic >> snd) |> ignore @@ -196,12 +196,12 @@ module Log = log Log.empty - |> Log.append (Log.make (term 1) (AddCue cues.[0])) - |> Log.append (Log.make (term 1) (AddCue cues.[1])) - |> Log.append (Log.make (term 1) (AddCue cues.[2])) - |> Log.append (Log.make (term 1) (AddCue cues.[3])) - |> Log.append (Log.make (term 1) (AddCue cues.[4])) - |> Log.append (Log.make (term 1) (AddCue cues.[5])) + |> Log.append (Log.make 1 (AddCue cues.[0])) + |> Log.append (Log.make 1 (AddCue cues.[1])) + |> Log.append (Log.make 1 (AddCue cues.[2])) + |> Log.append (Log.make 1 (AddCue cues.[3])) + |> Log.append (Log.make 1 (AddCue cues.[4])) + |> Log.append (Log.make 1 (AddCue cues.[5])) |> Log.until 4 |> assume "Should have 3 logs" 3 (Option.get >> LogEntry.depth) |> assume "Should have log with these values" [AddCue cues.[5]; AddCue cues.[4]; AddCue cues.[3]] (Option.get >> getData) @@ -212,7 +212,7 @@ module Log = let id1 = DiscoId.Create() let id2 = DiscoId.Create() - let term = term 1 + let term = 1 let idx1 = 1 let idx2 = 2 @@ -231,7 +231,7 @@ module Log = let id1 = DiscoId.Create() let id2 = DiscoId.Create() - let term = term 1 + let term = 1 let idx1 = 1 let idx2 = 2 @@ -250,7 +250,7 @@ module Log = let id2 = DiscoId.Create() let id3 = DiscoId.Create() - let term = term 1 + let term = 1 let idx1 = 1 let idx2 = 2 let idx3 = 3 @@ -273,7 +273,7 @@ module Log = let log_snapshot_remembers_last_state = testCase "snapshot remembers last state" <| fun _ -> - let term = term 8 + let term = 8 let data = [ for i in 0 .. 3 do yield DataSnapshot(State.Empty) ] @@ -300,7 +300,7 @@ module Log = Name = name (string n) Slices = Array.empty } ] - |> List.fold (fun m s -> Log.append (Log.make (term 0) s) m) Log.empty + |> List.fold (fun m s -> Log.append (Log.make 0 s) m) Log.empty |> assume "Should be at correct index" num Log.length |> assume "Should pick correct item" 16 (Log.untilExcluding 15 >> Option.get >> LogEntry.last >> LogEntry.index) |> assume "Should have correct index" (AddCue { Id = id; Name = name "16"; Slices = [| |] } |> Some) (Log.untilExcluding 15 >> Option.get >> LogEntry.last >> LogEntry.data) @@ -332,7 +332,7 @@ module Log = [ for trm in 1 .. 4 do let offset = random.Next(1,60) for idx in offset .. offset + random.Next(10,70) do - let (_,t,i) as result = (DiscoId.Create(), term trm, index idx) + let (_,t,i) as result = (DiscoId.Create(), 1 * trm, 1 * idx) if idx = offset then fidxs := (t,i) :: !fidxs yield result ] @@ -341,8 +341,8 @@ module Log = |> combine (!fidxs |> Map.ofList) for trm in 1 .. 4 do - let fidx = Log.firstIndex (term trm) log - let result = Map.tryFind (term trm) indices + let fidx = Log.firstIndex (1 * trm) log + let result = Map.tryFind (1 * trm) indices expect "Should be equal" result id fidx let log_getn_should_return_right_number_of_entries = @@ -352,7 +352,7 @@ module Log = let log = [ for n in 0 .. (n - 1) do yield DataSnapshot(State.Empty) ] - |> List.fold (fun m n -> Log.append (Log.make (term 0) n) m) Log.empty + |> List.fold (fun m n -> Log.append (Log.make 0 n) m) Log.empty expect "should have correct depth" n Log.length log diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index d00f78a6..f072528e 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -55,7 +55,7 @@ module ServerTests = let server_currentterm_defaults_to_zero = testCase "Raft server current Term should default to zero" <| fun _ -> raft { - do! expectM "Should be Zero" (term 0) RaftState.currentTerm // + do! expectM "Should be Zero" 0 RaftState.currentTerm // } |> runWithDefaults |> noError @@ -64,7 +64,7 @@ module ServerTests = testCase "Raft server set term sets term" <| fun _ -> raft { do! setCurrentTerm 5 - do! expectM "Should be correct term" (term 5) RaftState.currentTerm + do! expectM "Should be correct term" 5 RaftState.currentTerm } |> runWithDefaults |> noError @@ -125,7 +125,7 @@ module ServerTests = raft { do! setCurrentTerm 2 do! Raft.startElection () - do! expectM "Raft should have correct term" (term 3) RaftState.currentTerm + do! expectM "Raft should have correct term" 3 RaftState.currentTerm } |> runWithDefaults |> noError @@ -366,7 +366,7 @@ module ServerTests = let server_recv_entry_removes_mem_on_removemem = testCase "recv entry removes mem on removemem" <| fun _ -> - let term = ref (term 0) + let term = ref 0 let ci = ref 0 let mem = Member.create (DiscoId.Create()) @@ -465,7 +465,7 @@ module ServerTests = do! setState Candidate do! expectM "Should have zero votes for me" 0 RaftState.numVotesForMe - let response = { Term = term 2; Granted = true; Reason = None } + let response = { Term = 2; Granted = true; Reason = None } return! Raft.receiveVoteResponse mem.Id response } |> runWithDefaults @@ -479,7 +479,7 @@ module ServerTests = do! setCurrentTerm 1 do! expectM "Should have zero votes for me" 0 RaftState.numVotesForMe do! Raft.becomeCandidate () - do! Raft.receiveVoteResponse mem.Id { Term = term 2; Granted = true; Reason = None } + do! Raft.receiveVoteResponse mem.Id { Term = 2; Granted = true; Reason = None } do! expectM "Should have two votes for me" 2 RaftState.numVotesForMe } |> runWithDefaults @@ -496,7 +496,7 @@ module ServerTests = raft { do! addMember mem do! setCurrentTerm 1 - let response = { Term = term 1; Granted = true; Reason = None } + let response = { Term = 1; Granted = true; Reason = None } do! Raft.receiveVoteResponse mem.Id response } |> runWithDefaults @@ -515,11 +515,11 @@ module ServerTests = do! setCurrentTerm 3 do! Raft.becomeCandidate () let! response = Raft.receiveVoteResponse mem.Id { - Term = term 3 + Term = 3 Granted = true Reason = None } - do! expectM "Should have term 4" (term 4) RaftState.currentTerm + do! expectM "Should have term 4" 4 RaftState.currentTerm } |> runWithDefaults |> expectError err @@ -537,10 +537,10 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) let vote = - { Term = term 1 + { Term = 1 ; Candidate = mem ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } raft { @@ -557,10 +557,10 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) let vote = - { Term = term 2 + { Term = 2 ; Candidate = mem ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } raft { @@ -577,10 +577,10 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) let vote = - { Term = term 1 + { Term = 1 ; Candidate = mem ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } raft { @@ -600,10 +600,10 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) let vote = - { Term = term 2 + { Term = 2 ; Candidate = mem ; LastLogIndex = 1 - ; LastLogTerm = term 2 + ; LastLogTerm = 2 } raft { @@ -625,10 +625,10 @@ module ServerTests = let mem = Member.create (DiscoId.Create()) let vote = - { Term = term 2 + { Term = 2 ; Candidate = mem ; LastLogIndex = 3 - ; LastLogTerm = term 2 + ; LastLogTerm = 2 } raft { @@ -656,10 +656,10 @@ module ServerTests = do! Raft.becomeLeader () do! expectM "Should be leader" Leader RaftState.state let request = - { Term = term 1 + { Term = 1 ; Candidate = peer ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } let! resp = Raft.receiveVoteRequest peer.Id request do! expectM "Should be leader" Leader RaftState.state @@ -676,10 +676,10 @@ module ServerTests = do! addMember peer do! setCurrentTerm 1 let request = - { Term = term 2 + { Term = 2 ; Candidate = peer ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } let! resp = Raft.receiveVoteRequest peer.Id request expect "Should be granted" true VoteResponse.granted resp @@ -697,10 +697,10 @@ module ServerTests = do! setElectionTimeout 1000 do! Raft.periodic 900 let request = - { Term = term 2 + { Term = 2 ; Candidate = peer ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } let! resp = Raft.receiveVoteRequest peer.Id request expect "Vote should be granted" true VoteResponse.granted resp @@ -718,16 +718,16 @@ module ServerTests = do! Raft.becomeCandidate () do! setCurrentTerm 1 do! expectM "Should have voted for myself" true RaftState.votedForMyself - do! expectM "Should have term 1" (term 1) RaftState.currentTerm + do! expectM "Should have term 1" 1 RaftState.currentTerm let request = - { Term = term 2 + { Term = 2 ; Candidate = peer ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } let! resp = Raft.receiveVoteRequest peer.Id request do! expectM "Should now be Follower" Follower RaftState.state - do! expectM "Should have term 2" (term 2) RaftState.currentTerm + do! expectM "Should have term 2" 2 RaftState.currentTerm do! expectM "Should have voted for peer" peer.Id (RaftState.votedFor >> Option.get) } |> runWithDefaults @@ -744,10 +744,10 @@ module ServerTests = do! setCurrentTerm 1 do! expectM "Should have voted for myself" true RaftState.votedForMyself let request = - { Term = term 2 + { Term = 2 ; Candidate = other ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } let! resp = Raft.receiveVoteRequest other.Id request do! expectM "Should have added mem" None (RaftState.getMember other.Id) @@ -761,10 +761,10 @@ module ServerTests = let peer1 = Member.create (DiscoId.Create()) let peer2 = Member.create (DiscoId.Create()) let request = - { Term = term 1 + { Term = 1 ; Candidate = peer1 ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } raft { @@ -824,11 +824,11 @@ module ServerTests = raft { do! addMember peer do! setElectionTimeout 1000 - do! expectM "Should be at term zero" (term 0) RaftState.currentTerm + do! expectM "Should be at term zero" 0 RaftState.currentTerm do! Raft.becomeCandidate () - do! expectM "Should be at term one" (term 1) RaftState.currentTerm + do! expectM "Should be at term one" 1 RaftState.currentTerm do! Raft.periodic 1001 - do! expectM "Should be at term two" (term 2) RaftState.currentTerm + do! expectM "Should be at term two" 2 RaftState.currentTerm } |> runWithDefaults |> noError @@ -862,10 +862,10 @@ module ServerTests = let! state = get let vote : VoteRequest = - { Term = term 1 + { Term = 1 ; Candidate = state.Member ; LastLogIndex = 1 - ; LastLogTerm = term 1 + ; LastLogTerm = 1 } let! resp = Raft.receiveVoteRequest peer.Id vote @@ -873,7 +873,7 @@ module ServerTests = do! setCurrentTerm 2 - let! resp = Raft.receiveVoteRequest peer.Id { vote with Term = term 2; LastLogTerm = term 3; } + let! resp = Raft.receiveVoteRequest peer.Id { vote with Term = 2; LastLogTerm = 3; } expect "Should be granted" true VoteResponse.granted resp } |> runWithDefaults @@ -882,9 +882,9 @@ module ServerTests = let follower_becoming_candidate_increments_current_term = testCase "follower becoming candidate increments current term" <| fun _ -> raft { - do! expectM "Should have term 0" (term 0) RaftState.currentTerm + do! expectM "Should have term 0" 0 RaftState.currentTerm do! Raft.becomeCandidate () - do! expectM "Should have term 1" (term 1) RaftState.currentTerm + do! expectM "Should have term 1" 1 RaftState.currentTerm } |> runWithDefaults |> noError @@ -969,10 +969,10 @@ module ServerTests = let! raft' = get let peer = Member.create (DiscoId.Create()) let vote : VoteRequest = - { Term = term 0 // term must be equal or lower that raft's + { Term = 0 // term must be equal or lower that raft's Candidate = raft'.Member // term for this to work LastLogIndex = 0 - LastLogTerm = term 0 } + LastLogTerm = 0 } do! addMember peer do! voteFor (Some raft'.Member) let! resp = Raft.receiveVoteRequest peer.Id vote @@ -986,7 +986,7 @@ module ServerTests = let self = Member.create (DiscoId.Create()) let raft' = RaftState.create self let sender = Sender.create - let response = { Term = term 5; Granted = true; Reason = None } + let response = { Term = 5; Granted = true; Reason = None } let cbs = { Callbacks.Create (ref (DataSnapshot (State.Empty))) with SendRequestVote = senderRequestVote sender (Some response) } @@ -1018,8 +1018,8 @@ module ServerTests = let vote = List.head (!sender.Outbox) |> getVote expect "should have last log index be 3" 3 VoteRequest.lastLogIndex vote - expect "should have last term be 5" (term 5) VoteRequest.term vote - expect "should have last log term be 3" (term 3) VoteRequest.lastLogTerm vote + expect "should have last term be 5" 5 VoteRequest.term vote + expect "should have last log term be 3" 3 VoteRequest.lastLogTerm vote expect "should have candidate id be me" self VoteRequest.candidate vote } |> runWithRaft raft' cbs @@ -1029,17 +1029,17 @@ module ServerTests = testCase "candidate recv requestvote response becomes follower if current term is less than term" <| fun _ -> raft { let peer = Member.create (DiscoId.Create()) - let response = { Term = term 2 ; Granted = false; Reason = None } + let response = { Term = 2; Granted = false; Reason = None } do! addMember peer do! setCurrentTerm 1 do! setState Candidate do! voteFor None do! expectM "Should not be follower" false RaftState.isFollower do! expectM "Should not *have* a leader" None RaftState.currentLeader - do! expectM "Should have term 1" (term 1) RaftState.currentTerm + do! expectM "Should have term 1" 1 RaftState.currentTerm do! Raft.receiveVoteResponse peer.Id response do! expectM "Should be Follower" Follower RaftState.state - do! expectM "Should have term 2" (term 2) RaftState.currentTerm + do! expectM "Should have term 2" 2 RaftState.currentTerm do! expectM "Should have voted for nobody" None RaftState.votedFor } |> runWithDefaults @@ -1050,9 +1050,9 @@ module ServerTests = testCase "candidate recv appendentries frm leader results in follower" <| fun _ -> let peer = Member.create (DiscoId.Create()) let ae : AppendEntries = - { Term = term 1 + { Term = 1 ; PrevLogIdx = 0 - ; PrevLogTerm = term 0 + ; PrevLogTerm = 0 ; LeaderCommit = 0 ; Entries = None } @@ -1063,11 +1063,11 @@ module ServerTests = do! voteFor None do! expectM "Should not be follower" false RaftState.isFollower do! expectM "Should have no leader" None RaftState.currentLeader - do! expectM "Should have term 0" (term 0) RaftState.currentTerm + do! expectM "Should have term 0" 0 RaftState.currentTerm let! resp = Raft.receiveAppendEntries (Some peer.Id) ae do! expectM "Should be follower" Follower RaftState.state do! expectM "Should have peer as leader" (Some peer.Id) RaftState.currentLeader - do! expectM "Should have term 1" (term 1) RaftState.currentTerm + do! expectM "Should have term 1" 1 RaftState.currentTerm do! expectM "Should have voted for noone" None RaftState.votedFor } |> runWithDefaults @@ -1077,9 +1077,9 @@ module ServerTests = testCase "candidate recv appendentries from same term results in step down" <| fun _ -> let peer = Member.create (DiscoId.Create()) let ae : AppendEntries = - { Term = term 2 + { Term = 2 ; PrevLogIdx = 1 - ; PrevLogTerm = term 1 + ; PrevLogTerm = 1 ; LeaderCommit = 0 ; Entries = None } @@ -1284,7 +1284,7 @@ module ServerTests = |> assume "Should have PrevLogIdx 0" 0 (fun ae -> ae.PrevLogIdx) |> assume "Should have one entry" 1 (fun ae -> ae.Entries |> Option.get |> LogEntry.depth) |> assume "Should have entry with correct id" (LogEntry.id log) (fun ae -> ae.Entries |> Option.get |> LogEntry.id) - |> expect "Should have entry with term" (term 2) (fun ae -> ae.Entries |> Option.get |> LogEntry.term) + |> expect "Should have entry with term" 2 (fun ae -> ae.Entries |> Option.get |> LogEntry.term) sender.Outbox := List.empty // reset outbox @@ -1394,7 +1394,7 @@ module ServerTests = let log3 = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) let response = - { Term = term 1 + { Term = 1 ; Success = true ; CurrentIndex = 3 ; FirstIndex = 1 @@ -1447,7 +1447,7 @@ module ServerTests = let peer2 = Member.create (DiscoId.Create()) let response = - { Term = term 1 + { Term = 1 ; Success = true ; CurrentIndex = 1 ; FirstIndex = 1 @@ -1493,7 +1493,7 @@ module ServerTests = let peer4 = Member.create (DiscoId.Create()) let response = - { Term = term 1 + { Term = 1 ; Success = true ; CurrentIndex = 1 ; FirstIndex = 1 } @@ -1588,7 +1588,7 @@ module ServerTests = let log4 = LogEntry(DiscoId.Create(),0,4,DataSnapshot (State.Empty),None) let response = - { Term = term 1 + { Term = 1 ; Success = true ; CurrentIndex = 1 ; FirstIndex = 1 } @@ -1615,7 +1615,7 @@ module ServerTests = do! Raft.sendAllAppendEntries () expect "Should have prevLogIdx 4" 4 AppendEntries.prevLogIdx (!appendReq |> Option.get) - expect "Should have prevLogTerm 4" (term 4) AppendEntries.prevLogTerm (!appendReq |> Option.get) + expect "Should have prevLogTerm 4" 4 AppendEntries.prevLogTerm (!appendReq |> Option.get) let! trm = currentTerm () do! Raft.receiveAppendEntriesResponse peer.Id { response with Term = trm; Success = false; CurrentIndex = 1 } @@ -1627,7 +1627,7 @@ module ServerTests = do! Raft.sendAllAppendEntries () expect "Should have prevLogIdx 1" 1 AppendEntries.prevLogIdx (!appendReq |> Option.get) - expect "Should have prevLogTerm 1" (term 1) AppendEntries.prevLogTerm (!appendReq |> Option.get) + expect "Should have prevLogTerm 1" 1 AppendEntries.prevLogTerm (!appendReq |> Option.get) } |> runWithCBS cbs |> noError @@ -1639,7 +1639,7 @@ module ServerTests = let lokk = new System.Object() let ci = ref 0 - let trm = ref (term 2) + let trm = ref 2 let result = ref false let count = ref 0 @@ -1660,7 +1660,7 @@ module ServerTests = do! setCommitIndex 0 for n in 1 .. 4 do - do! LogEntry(DiscoId.Create(),0,term n,DataSnapshot(State.Empty),None) + do! LogEntry(DiscoId.Create(),0,1 * n,DataSnapshot(State.Empty),None) |> appendEntry >>= ignoreM @@ -1710,7 +1710,7 @@ module ServerTests = let log = LogEntry(DiscoId.Create(),0,1,DataSnapshot (State.Empty),None) let response = - { Term = term 1 + { Term = 1 ; Success = true ; CurrentIndex = 1 ; FirstIndex = 1 @@ -1783,14 +1783,14 @@ module ServerTests = let leader_recv_entry_is_committed_returns_neg_1_if_invalidated = testCase "leader recv entry is committed returns neg 1 if invalidated" <| fun _ -> let peer = Member.create (DiscoId.Create()) - let log = Log.make (term 1) (DataSnapshot (State.Empty)) + let log = Log.make 1 (DataSnapshot (State.Empty)) let ae = { LeaderCommit = 1 - ; Term = term 2 + ; Term = 2 ; PrevLogIdx = 0 - ; PrevLogTerm = term 0 - ; Entries = Log.make (term 2) defSM |> Some + ; PrevLogTerm = 0 + ; Entries = Log.make 2 defSM |> Some } let err = @@ -1809,7 +1809,7 @@ module ServerTests = let! committed = Raft.responseCommitted response expect "Should not have committed entry" false id committed - expect "Should have term 1" (term 1) EntryResponse.term response + expect "Should have term 1" 1 EntryResponse.term response expect "Should have index 1" 1 EntryResponse.index response do! expectM "(1) Should have current idx 1" 1 RaftState.currentIndex @@ -1840,7 +1840,7 @@ module ServerTests = SendAppendEntries = senderAppendEntries sender None } :> IRaftCallbacks - let log = Log.make (term 1) defSM + let log = Log.make 1 defSM raft { do! addMember peer @@ -1868,9 +1868,9 @@ module ServerTests = with SendAppendEntries = senderAppendEntries sender None } :> IRaftCallbacks - let log = Log.make (term 1) defSM + let log = Log.make 1 defSM let resp = - { Term = term 1 + { Term = 1 ; Success = false ; CurrentIndex = 0 ; FirstIndex = 0 @@ -1904,7 +1904,7 @@ module ServerTests = :> IRaftCallbacks let resp = - { Term = term 1 + { Term = 1 ; Success = true ; CurrentIndex = 0 ; FirstIndex = 0 @@ -1933,7 +1933,7 @@ module ServerTests = :> IRaftCallbacks let resp = - { Term = term 1 + { Term = 1 ; Success = true ; CurrentIndex = 1 ; FirstIndex = 1 @@ -1953,9 +1953,9 @@ module ServerTests = testCase "leader recv appendentries steps down if newer" <| fun _ -> let peer = Member.create (DiscoId.Create()) let ae = - { Term = term 6 + { Term = 6 PrevLogIdx = 6 - PrevLogTerm = term 5 + PrevLogTerm = 5 LeaderCommit = 0 Entries = None } @@ -1980,9 +1980,9 @@ module ServerTests = testCase "leader recv appendentries steps down if newer term" <| fun _ -> let peer = Member.create (DiscoId.Create()) let resp = - { Term = term 6 + { Term = 6 ; PrevLogIdx = 5 - ; PrevLogTerm = term 5 + ; PrevLogTerm = 5 ; LeaderCommit = 0 ; Entries = None } @@ -2007,7 +2007,7 @@ module ServerTests = let count = ref 0 let response = - ref { Term = term 0 + ref { Term = 0 Success = true CurrentIndex = 1 FirstIndex = 1 } @@ -2051,13 +2051,13 @@ module ServerTests = let peer1 = Member.create (DiscoId.Create()) let peer2 = Member.create (DiscoId.Create()) let sender = Sender.create - let resp = { Term = term 1; Granted = true; Reason = None } + let resp = { Term = 1; Granted = true; Reason = None } let vote = - { Term = term 1 + { Term = 1 ; Candidate = peer2 ; LastLogIndex = 0 - ; LastLogTerm = term 0 } + ; LastLogTerm = 0 } let peers = [| peer1; peer2 |] @@ -2085,13 +2085,13 @@ module ServerTests = let peer1 = Member.create (DiscoId.Create()) let peer2 = Member.create (DiscoId.Create()) let sender = Sender.create - let resp = { Term = term 1; Granted = true; Reason = None } + let resp = { Term = 1; Granted = true; Reason = None } let vote = - { Term = term 2 + { Term = 2 ; Candidate = peer2 ; LastLogIndex = 0 - ; LastLogTerm = term 0 } + ; LastLogTerm = 0 } let peers = [| peer1; peer2 |] @@ -2150,7 +2150,7 @@ module ServerTests = let mem3 = { Member.create (DiscoId.Create()) with Status = MemberStatus.Failed } let mem4 = { Member.create (DiscoId.Create()) with Status = MemberStatus.Failed } - let resp = { Term = term 1; Granted = true; Reason = None } + let resp = { Term = 1; Granted = true; Reason = None } let peers = [| mem1; mem2; mem3; mem4 |] @@ -2171,7 +2171,7 @@ module ServerTests = let server_periodic_should_trigger_snapshotting = testCase "periodic should trigger snapshotting when MaxLogDepth is reached" <| fun _ -> raft { - let trm = term 1 + let trm = 1 let depth = 40 let! me = self () @@ -2192,7 +2192,7 @@ module ServerTests = let server_should_apply_each_log_when_receiving_a_snapshot = testCase "should apply each log when receiving a snapshot" <| fun _ -> let idx = 9 - let trm = term 1 + let trm = 1 let count = ref 0 let init = defaultServer () @@ -2225,7 +2225,7 @@ module ServerTests = testCase "should merge snaphot and existing log when receiving a snapshot" <| fun _ -> let idx = 9 let num = 5 - let trm = term 1 + let trm = 1 let count = ref 0 let init = defaultServer () @@ -2311,9 +2311,9 @@ module ServerTests = } :> IRaftCallbacks raft { - let log1 = Log.make (term 0) defSM - let log2 = Log.make (term 0) defSM - let log3 = Log.make (term 0) defSM + let log1 = Log.make 0 defSM + let log2 = Log.make 0 defSM + let log3 = Log.make 0 defSM let ids = [ log3; log2; log1; ] @@ -2332,9 +2332,9 @@ module ServerTests = let server_should_call_delete_callback_for_each_deleted_log = testCase "should call delete callback for each deleted log" <| fun _ -> - let log1 = Log.make (term 0) defSM - let log2 = Log.make (term 0) defSM - let log3 = Log.make (term 0) defSM + let log1 = Log.make 0 defSM + let log2 = Log.make 0 defSM + let log3 = Log.make 0 defSM let count = ref [ log3; log2; log1; ] @@ -2410,7 +2410,7 @@ module ServerTests = let should_respond_to_appendentries_with_correct_next_idx = testCase "respond to appendentries with correct next idx" <| fun _ -> - let trm = term 1 + let trm = 1 raft { do! setCurrentTerm trm diff --git a/src/Disco/Disco/Tests/TestUtilities.fs b/src/Disco/Disco/Tests/TestUtilities.fs index 3426fa06..2b116e26 100644 --- a/src/Disco/Disco/Tests/TestUtilities.fs +++ b/src/Disco/Disco/Tests/TestUtilities.fs @@ -242,7 +242,7 @@ module TestData = Locked = rndbool () Active = rndbool () CueListId = rndopt() - Selected = index (rand.Next(0,1000)) + Selected = 1 * (rand.Next(0,1000)) CallId = DiscoId.Create() NextId = DiscoId.Create() PreviousId = DiscoId.Create() From 07a58da0e424c108c395ddcc0efa3ba46f835ccb Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Fri, 9 Feb 2018 15:09:31 +0100 Subject: [PATCH 12/27] fix some bugs --- src/Disco/Disco/Raft/Raft.fs | 96 +++++++++---------- src/Disco/Disco/Raft/RaftMonad.fs | 22 ++--- .../Disco/Tests/Raft/AppendEntriesTests.fs | 6 +- src/Disco/Disco/Tests/Raft/ServerTests.fs | 4 +- 4 files changed, 62 insertions(+), 66 deletions(-) diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index eb54d9c2..f0872574 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -65,7 +65,6 @@ module rec Raft = let! current = currentIndex () let! first = firstIndex term >>= (Option.defaultValue 0 >> returnM) - let resp: AppendResponse = { Term = term Success = false @@ -178,7 +177,7 @@ module rec Raft = let! response = applyRemainder msg resp do! requestSetCommitIndex msg do! setLeader nid - return AppendResponse.setSuccess true resp + return AppendResponse.setSuccess true response } // ** checkAndProcess @@ -193,7 +192,7 @@ module rec Raft = if current < msg.PrevLogIdx then do! msg.PrevLogIdx |> sprintf "Failed (ci: %d) < (prev log idx: %d)" current - |> error "receiveAppendEntries" + |> logError "receiveAppendEntries" return resp else let term = LogEntry.term entry @@ -203,7 +202,7 @@ module rec Raft = msg.PrevLogTerm current msg.PrevLogIdx - |> error "receiveAppendEntries" + |> logError "receiveAppendEntries" do! removeEntry msg.PrevLogIdx return AppendResponse.setCurrentIndex (msg.PrevLogIdx - 1) resp else @@ -293,7 +292,7 @@ module rec Raft = msg.PrevLogIdx msg.PrevLogTerm (Option.get msg.Entries |> LogEntry.depth) // let the world know - |> debug "receiveAppendEntries" + |> logDebug "receiveAppendEntries" let! result = createResponse nid msg // check terms et al match, fail otherwise @@ -308,7 +307,7 @@ module rec Raft = | _ -> do! msg.PrevLogIdx |> String.format "Failed. No log at (prev-log-idx: {0})" - |> error "receiveAppendEntries" + |> logError "receiveAppendEntries" return resp else return! processEntry nid msg resp @@ -322,10 +321,9 @@ module rec Raft = let! mem = getMember nid match mem with | None -> - do! string nid - |> sprintf "Failed: NoMember %s" - |> error "receiveAppendEntriesResponse" - + do! logError + "receiveAppendEntriesResponse" + ("Failed: NoMember " + string nid) return! string nid |> sprintf "Node not found: %s" @@ -336,7 +334,7 @@ module rec Raft = do! sprintf "Failed: peer not up to date yet (ci: %d) (match idx: %d)" resp.CurrentIndex peer.MatchIndex - |> error "receiveAppendEntriesResponse" + |> logError "receiveAppendEntriesResponse" // set to current index at follower and try again do! peer |> Member.setNextIndex (resp.CurrentIndex + 1) @@ -351,13 +349,13 @@ module rec Raft = // and convert to follower (§5.3) if term < resp.Term then let str = sprintf "Failed: (term: %d) < (resp.Term: %d)" term resp.Term - do! error "receiveAppendEntriesResponse" str + do! logError "receiveAppendEntriesResponse" str do! setCurrentTerm resp.Term do! setLeader (Some nid) do! becomeFollower () elif term <> resp.Term then let str = sprintf "Failed: (term: %d) != (resp.Term: %d)" term resp.Term - do! error "receiveAppendEntriesResponse" str + do! logError "receiveAppendEntriesResponse" str elif not resp.Success then // If AppendEntries fails because of log inconsistency: // decrement nextIndex and retry (§5.3) @@ -367,7 +365,7 @@ module rec Raft = do! nextIndex |> sprintf "Failed: cidx < nxtidx. setting nextIndex for %O to %d" peer.Id - |> error "receiveAppendEntriesResponse" + |> logError "receiveAppendEntriesResponse" do! setNextIndex peer.Id nextIndex do! setMatchIndex peer.Id (nextIndex - 1) @@ -376,7 +374,7 @@ module rec Raft = do! nextIndex |> sprintf "Failed: cidx >= nxtidx. setting nextIndex for %O to %d" peer.Id - |> error "receiveAppendEntriesResponse" + |> logError "receiveAppendEntriesResponse" do! setNextIndex peer.Id nextIndex do! setMatchIndex peer.Id (nextIndex - 1) @@ -548,7 +546,7 @@ module rec Raft = let! configChange = configChangeEntry() if LogEntry.isConfigChange entry && Option.isSome configChange then - do! debug "receiveEntry" "Error: UnexpectedVotingChange" + do! logDebug "receiveEntry" "Error: UnexpectedVotingChange" return! "Unexpected Voting Change" |> Error.asRaftError (tag "receiveEntry") @@ -561,7 +559,7 @@ module rec Raft = |> sprintf "(id: %A) (idx: %d) (term: %d)" (LogEntry.id entry) (idx + 1) - |> debug "receiveEntry" + |> logDebug "receiveEntry" let response = EntryResponse.create 0 0 @@ -627,7 +625,7 @@ module rec Raft = LogEntry.depth entries |> sprintf "applying %d entries to state machine" - do! RaftMonad.info "applyEntries" str + do! logInfo "applyEntries" str // Apply log chain in the order it arrived let state, change = @@ -657,7 +655,7 @@ module rec Raft = do! match change with | Some _ -> "setting ConfigChangeEntry to JointConsensus" | None -> "resetting ConfigChangeEntry" - |> debug "applyEntries" + |> logDebug "applyEntries" do! put { state with ConfigChangeEntry = change } @@ -669,7 +667,7 @@ module rec Raft = let str = string state.Member.Id |> sprintf "self (%s) not included in new configuration" - do! debug "applyEntries" str + do! logDebug "applyEntries" str do! setLeader None do! becomeFollower () /// snapshot now: @@ -682,16 +680,16 @@ module rec Raft = let! state = get if not (RaftState.isLeader state) && LogEntry.contains LogEntry.isConfiguration entries then - do! debug "applyEntries" "not leader and new configuration is applied. Updating mems." + do! logDebug "applyEntries" "not leader and new configuration is applied. Updating mems." for kv in state.Peers do if kv.Value.Status <> Running then do! updateMember { kv.Value with Status = Running; Voting = true } let idx = LogEntry.index entries - do! debug "applyEntries" <| sprintf "setting LastAppliedIndex to %d" idx + do! logDebug "applyEntries" <| sprintf "setting LastAppliedIndex to %d" idx do! setLastAppliedIndex idx | _ -> - do! debug "applyEntries" (sprintf "no log entries found for index %d" logIdx) + do! logDebug "applyEntries" (sprintf "no log entries found for index %d" logIdx) } // ** receiveInstallSnapshot @@ -819,12 +817,12 @@ module rec Raft = /// Become leader afer a successful election let becomeLeader _ = raft { - let! state = get - do! RaftMonad.info "becomeLeader" "becoming leader" + let! self = self() + do! logInfo "becomeLeader" "becoming leader" let! current = currentIndex () do! setState Leader - do! setLeader (Some state.Member.Id) - do! maybeSetIndex state.Member.Id (current + 1) 0 + do! setLeader (Some self.Id) + do! maybeSetIndex self.Id (current + 1) 0 do! sendAllAppendEntries () } @@ -832,7 +830,7 @@ module rec Raft = let becomeFollower _ = raft { - do! RaftMonad.info "becomeFollower" "becoming follower" + do! logInfo "becomeFollower" "becoming follower" do! setState Follower } @@ -852,10 +850,10 @@ module rec Raft = /// After timeout a Member must become Candidate let becomeCandidate () = raft { - do! RaftMonad.info "becomeCandidate" "becoming candidate" + do! logInfo "becomeCandidate" "becoming candidate" let! state = get let term = state.CurrentTerm + 1 - do! debug "becomeCandidate" <| sprintf "setting term to %d" term + do! logDebug "becomeCandidate" <| sprintf "setting term to %d" term do! setCurrentTerm term do! resetVotes () do! voteForMyself () @@ -863,7 +861,7 @@ module rec Raft = do! setState Candidate // 150–300ms see page 6 in https://raft.github.io/raft.pdf let elapsed = 1 * rand.Next(10, int state.ElectionTimeout) - do! debug "becomeCandidate" <| sprintf "setting timeoutElapsed to %d" elapsed + do! logDebug "becomeCandidate" <| sprintf "setting timeoutElapsed to %d" elapsed do! setTimeoutElapsed elapsed do! requestAllVotes () } @@ -885,7 +883,7 @@ module rec Raft = do! (if vote.Granted then "granted" else "not granted") |> sprintf "%O responded to vote request with: %s" nid - |> debug "receiveVoteResponse" + |> logDebug "receiveVoteResponse" /// The term must not be bigger than current raft term, /// otherwise set term to vote term become follower. @@ -894,7 +892,7 @@ module rec Raft = vote.Term state.CurrentTerm state.CurrentTerm - |> debug "receiveVoteResponse" + |> logDebug "receiveVoteResponse" do! setCurrentTerm vote.Term do! setLeader (Some nid) do! becomeFollower () @@ -905,7 +903,7 @@ module rec Raft = do! sprintf "Failed: (vote term: %d) < (current term: %d). VoteTermMismatch." vote.Term state.CurrentTerm - |> debug "receiveVoteResponse" + |> logDebug "receiveVoteResponse" return! "Vote Term Mismatch" |> Error.asRaftError (tag "receiveVoteResponse") @@ -917,7 +915,7 @@ module rec Raft = | Leader -> return () | Follower -> /// ...otherwise we respond with the respective RaftError. - do! debug "receiveVoteResponse" "Failed: NotCandidate" + do! logDebug "receiveVoteResponse" "Failed: NotCandidate" return! "Not Candidate" |> Error.asRaftError (tag "receiveVoteResponse") @@ -928,7 +926,7 @@ module rec Raft = match mem with // Could not find the mem in current configuration(s) | None -> - do! debug "receiveVoteResponse" "Failed: vote granted but NoMember" + do! logDebug "receiveVoteResponse" "Failed: vote granted but NoMember" return! "No Node" |> Error.asRaftError (tag "receiveVoteResponse") @@ -954,7 +952,7 @@ module rec Raft = do! sprintf "In JointConsensus (majority new config: %b) (majority old config: %b)" newConfig oldConfig - |> debug "receiveVoteResponse" + |> logDebug "receiveVoteResponse" // and finally, become leader if we have a majority in either // configuration @@ -972,7 +970,7 @@ module rec Raft = let! majority = numVotesForMe () >>= regularMajority do! sprintf "(majority for config: %b)" majority - |> debug "receiveVoteResponse" + |> logDebug "receiveVoteResponse" if majority then do! becomeLeader () @@ -989,7 +987,7 @@ module rec Raft = let! cbs = read do! mem.Status |> sprintf "(to: %s) (state: %A)" (string mem.Id) - |> debug "sendVoteRequest" + |> logDebug "sendVoteRequest" do cbs.SendRequestVote mem { Term = term Candidate = self @@ -1004,7 +1002,7 @@ module rec Raft = raft { let! self = self () let! peers = logicalPeers () - do! RaftMonad.info "requestAllVotes" "requesting all votes" + do! logInfo "requestAllVotes" "requesting all votes" for peer in peers do if self.Id <> peer.Value.Id then do! sendVoteRequest peer.Value @@ -1080,11 +1078,11 @@ module rec Raft = if fst result then do! vote.Candidate.Id |> sprintf "granted vote to %O" - |> debug "shouldGrantVote" + |> logDebug "shouldGrantVote" else do! snd result |> sprintf "did not grant vote to %O. reason: %A" vote.Candidate.Id - |> debug "shouldGrantVote" + |> logDebug "shouldGrantVote" return result } @@ -1103,7 +1101,7 @@ module rec Raft = raft { let! term = currentTerm () if term < vote.Term then - do! debug "maybeResetFollower" "current term < vote Term, resetting to follower state" + do! logDebug "maybeResetFollower" "current term < vote Term, resetting to follower state" do! setCurrentTerm vote.Term do! setLeader (Some nid) do! becomeFollower () @@ -1129,7 +1127,7 @@ module rec Raft = Reason = None } else - do! debug "processVoteRequest" "vote request denied: NotVotingState" + do! logDebug "processVoteRequest" "vote request denied: NotVotingState" return! "Not Voting State" |> Error.asRaftError (tag "processVoteRequest") @@ -1156,10 +1154,10 @@ module rec Raft = let str = sprintf "mem %s requested vote. granted: %b" (string nid) result.Granted - do! RaftMonad.info "receiveVoteRequest" str + do! logInfo "receiveVoteRequest" str return result | _ -> - do! RaftMonad.info "receiveVoteRequest" <| sprintf "requested denied. NoMember %s" (string nid) + do! logInfo "receiveVoteRequest" <| sprintf "requested denied. NoMember %s" (string nid) let! trm = currentTerm () let err = RaftError (tag "processVoteRequest", "Not Voting State") @@ -1192,7 +1190,7 @@ module rec Raft = electionTimeout, currentTerm, currentIndex) - do! debug "startElection" str + do! logDebug "startElection" str do! becomeCandidate () } @@ -1231,13 +1229,11 @@ module rec Raft = // the regular case is we need to ping our followers so as to not provoke an election elif timedout then do! sendAllAppendEntries () - | _ -> // have to double check the code here to ensure new elections are really only called when // not enough votes could be garnered let! num = numMembers () let! timedout = electionTimedOut () - if timedout && num > 1 then do! startElection () elif timedout && num = 1 then @@ -1247,9 +1243,7 @@ module rec Raft = let! coi = commitIndex () let! lai = lastAppliedIndex () - if lai < coi then do! applyEntries () - do! maybeSnapshot () } diff --git a/src/Disco/Disco/Raft/RaftMonad.fs b/src/Disco/Disco/Raft/RaftMonad.fs index ca347702..63ebdea2 100644 --- a/src/Disco/Disco/Raft/RaftMonad.fs +++ b/src/Disco/Disco/Raft/RaftMonad.fs @@ -206,21 +206,21 @@ module RaftMonad = |> Logger.log level (tag site) |> returnM - // ** debug + // ** logDebug - let debug site str = logMsg site Debug str + let logDebug site str = logMsg site Debug str - // ** info + // ** logInfo - let info site str = logMsg site Info str + let logInfo site str = logMsg site Info str - // ** warn + // ** logWarn - let warn site str = logMsg site Warn str + let logWarn site str = logMsg site Warn str - // ** error + // ** logError - let error site str = logMsg site Err str + let logError site str = logMsg site Err str // ** currentIndex @@ -426,7 +426,7 @@ module RaftMonad = let setVoting (mem: RaftMember) (vote: bool) = raft { let msg = String.Format("setting mem {0} voting to {1}", mem.Id, vote) - do! debug "setVoting" msg + do! logDebug "setVoting" msg let! state = get let update, state = RaftState.setVoting mem vote state do! put state @@ -457,7 +457,7 @@ module RaftMonad = request.LeaderCommit request.PrevLogIdx request.PrevLogTerm - do! debug "sendAppendEntries" msg + do! logDebug "sendAppendEntries" msg do cbs.SendAppendEntries mem request } @@ -606,7 +606,7 @@ module RaftMonad = // ** setElectionTimeout - let setElectionTimeout timeout = modify (RaftState.setRequestTimeout timeout) + let setElectionTimeout timeout = modify (RaftState.setElectionTimeout timeout) // ** lastAppliedIndex diff --git a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs index 949f815a..d94c768e 100644 --- a/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs +++ b/src/Disco/Disco/Tests/Raft/AppendEntriesTests.fs @@ -320,9 +320,9 @@ module AppendEntries = let log = LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), - Some <| LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), None)))) + Some $ LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some $ LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), + Some $ LogEntry((DiscoId.Create()), 0, 1, DataSnapshot (State.Empty), None)))) let msg = { Term = 1 diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index f072528e..7a9353e4 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -906,7 +906,9 @@ module ServerTests = let follower_becoming_candidate_resets_election_timeout = testCase "follower becoming candidate resets election timeout" <| fun _ -> raft { - do! setElectionTimeout 1000 + let electionAfter = 1000 + do! setElectionTimeout electionAfter + do! expectM "Should have correct election timeout" electionAfter RaftState.electionTimeout do! expectM "Should have zero elapsed timout" 0 RaftState.timeoutElapsed do! Raft.periodic 900 do! expectM "Should have 900 elapsed timout" 900 RaftState.timeoutElapsed From 21ca67c5f150e9af85720495c81718d9858c4add Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Fri, 9 Feb 2018 16:18:17 +0100 Subject: [PATCH 13/27] fix peer counting by always using Map.count --- src/Disco/Disco/Raft/Raft.fs | 2 -- src/Disco/Disco/Raft/RaftMonad.fs | 9 ++---- src/Disco/Disco/Raft/RaftState.fs | 42 ++++++++++---------------- src/Disco/Disco/Service/Persistence.fs | 1 - src/Disco/Disco/Tests/Raft/Tests.fs | 3 +- 5 files changed, 19 insertions(+), 38 deletions(-) diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index f0872574..cdefc4c1 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -1238,8 +1238,6 @@ module rec Raft = do! startElection () elif timedout && num = 1 then do! becomeLeader () - else - do! recountPeers () let! coi = commitIndex () let! lai = lastAppliedIndex () diff --git a/src/Disco/Disco/Raft/RaftMonad.fs b/src/Disco/Disco/Raft/RaftMonad.fs index 63ebdea2..c0140e86 100644 --- a/src/Disco/Disco/Raft/RaftMonad.fs +++ b/src/Disco/Disco/Raft/RaftMonad.fs @@ -266,10 +266,6 @@ module RaftMonad = let numLogicalPeers () = zoom RaftState.numLogicalPeers - // ** recountPeers - - let recountPeers () = modify RaftState.recountPeers - // ** hasMember let hasMember nid = zoom (RaftState.hasMember nid) @@ -331,11 +327,11 @@ module RaftMonad = // ** setPeers - let setPeers peers = modify (RaftState.setPeers peers >> RaftState.recountPeers) + let setPeers peers = modify (RaftState.setPeers peers) // ** setOldPeers - let setOldPeers peers = modify (RaftState.setOldPeers peers >> RaftState.recountPeers) + let setOldPeers peers = modify (RaftState.setOldPeers peers) // ** peers @@ -348,7 +344,6 @@ module RaftMonad = let! state = get let updated, state = RaftState.updateMember mem state do! put state - do! recountPeers () if updated then let! cbs = read // if the mems has structurally changed fire the callback diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index 6901c8e8..f513b1ee 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -123,8 +123,6 @@ type RaftState = Peers : Map /// map of the previous cluster configuration. set if currently in a configuration change OldPeers : Map option - /// count of all members in the cluster - NumMembers : int /// the candidate this server voted for in its current term or None if it hasn't voted for any /// other member yet VotedFor : MemberId option @@ -171,10 +169,6 @@ type RaftState = (fun (rs:RaftState) -> rs.OldPeers), (fun oldPeers (rs:RaftState) -> { rs with OldPeers = oldPeers }) - static member NumMembers_ = - (fun (rs:RaftState) -> rs.NumMembers), - (fun numMembers (rs:RaftState) -> { rs with NumMembers = numMembers }) - static member VotedFor_ = (fun (rs:RaftState) -> rs.VotedFor), (fun votedFor (rs:RaftState) -> { rs with VotedFor = votedFor }) @@ -220,7 +214,8 @@ type RaftState = State = %A CurrentTerm = %A CurrentLeader = %A -NumMembers = %A +NumMembers = %A +NumOldMembers = %A VotedFor = %A MaxLogDepth = %A CommitIndex = %A @@ -234,7 +229,8 @@ ConfigChangeEntry = %s self.State self.CurrentTerm self.CurrentLeader - self.NumMembers + (Map.count self.Peers) + (Option.map Map.count self.OldPeers) self.VotedFor self.MaxLogDepth self.CommitIndex @@ -300,7 +296,6 @@ ConfigChangeEntry = %s CurrentLeader = leader Peers = Map.empty OldPeers = None - NumMembers = 0 VotedFor = votedfor Log = Log.empty CommitIndex = 0 @@ -331,7 +326,6 @@ module RaftState = let currentLeader = Optic.get RaftState.CurrentLeader_ let peers = Optic.get RaftState.Peers_ let oldPeers = Optic.get RaftState.OldPeers_ - let numMembers = Optic.get RaftState.NumMembers_ let votedFor = Optic.get RaftState.VotedFor_ let log = Optic.get RaftState.Log_ let commitIndex = Optic.get RaftState.CommitIndex_ @@ -350,7 +344,6 @@ module RaftState = let setCurrentLeader = Optic.set RaftState.CurrentLeader_ let setPeers = Optic.set RaftState.Peers_ let setOldPeers = Optic.set RaftState.OldPeers_ - let setNumMembers = Optic.set RaftState.NumMembers_ let setVotedFor = Optic.set RaftState.VotedFor_ let setLog = Optic.set RaftState.Log_ let setCommitIndex = Optic.set RaftState.CommitIndex_ @@ -370,7 +363,6 @@ module RaftState = CurrentLeader = None Peers = Map.ofList [(self.Id, self)] OldPeers = None - NumMembers = 1 VotedFor = None Log = Log.empty CommitIndex = 0 @@ -381,6 +373,17 @@ module RaftState = MaxLogDepth = Constants.RAFT_MAX_LOGDEPTH ConfigChangeEntry = None } + // ** numMembers + + let numMembers = Optic.get RaftState.Peers_ >> Map.count + + // ** numOldMembers + + let numOldMembers = + Optic.get RaftState.OldPeers_ + >> Option.map Map.count + >> Option.defaultValue 0 + // ** currentIndex let currentIndex = Optic.get RaftState.CurrentIndex_ @@ -440,10 +443,6 @@ module RaftState = let numLogicalPeers: RaftState -> int = logicalPeers >> countMembers - // ** recountPeers - - let recountPeers state = setNumMembers (numLogicalPeers state) state - // ** hasMember let hasMember nid = peers >> Map.containsKey nid @@ -578,13 +577,6 @@ module RaftState = |> Member.setVotedForMe vote |> updateMember - // ** numOldMembers - - let numOldMembers (state: RaftState) = - match state.OldPeers with - | Some peers -> Map.count peers - | _ -> 0 - // ** addMember /// Adds a mem to the list of known Members and increments NumMembers counter @@ -594,7 +586,6 @@ module RaftState = |> peers |> Map.add mem.Id mem |> flip setPeers state - |> recountPeers // ** addNonVotingMember @@ -611,7 +602,6 @@ module RaftState = |> peers |> Map.remove mem.Id |> flip setPeers state - |> recountPeers // ** applyChanges @@ -714,7 +704,7 @@ module RaftState = let updateCommitIndex (state: RaftState) = setCommitIndex - $ if state.NumMembers = 1 + $ if numMembers state = 1 then currentIndex state else commitIndex state $ state diff --git a/src/Disco/Disco/Service/Persistence.fs b/src/Disco/Disco/Service/Persistence.fs index 2b8fb0f3..7eb375d5 100644 --- a/src/Disco/Disco/Service/Persistence.fs +++ b/src/Disco/Disco/Service/Persistence.fs @@ -77,7 +77,6 @@ module Persistence = return { state with Member = ClusterMember.toRaftMember mem - NumMembers = count Peers = Map.map (fun _ -> ClusterMember.toRaftMember) mems MaxLogDepth = options.Raft.MaxLogDepth RequestTimeout = options.Raft.RequestTimeout diff --git a/src/Disco/Disco/Tests/Raft/Tests.fs b/src/Disco/Disco/Tests/Raft/Tests.fs index 762f8bf7..a477db5c 100644 --- a/src/Disco/Disco/Tests/Raft/Tests.fs +++ b/src/Disco/Disco/Tests/Raft/Tests.fs @@ -16,8 +16,7 @@ module RaftTests = [] let raftTests = testList "Raft tests" - [ - // Continue + [ // Continue validation_dsl_validation // Node From 84d3992e17d62b513c3f3f7bd5ec06ad5b1cf2c5 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Fri, 9 Feb 2018 16:42:13 +0100 Subject: [PATCH 14/27] fix frontend --- src/Disco/Disco/Core/Pin.fs | 21 +++++++++---------- src/Frontend/src/Frontend/Elmish/PinView.fs | 10 ++++----- .../src/Frontend/Elmish/ProjectView.fs | 2 +- src/Frontend/src/Frontend/Main.fs | 2 +- .../src/Tests.Frontend/SerializationTests.fs | 2 +- 5 files changed, 18 insertions(+), 19 deletions(-) diff --git a/src/Disco/Disco/Core/Pin.fs b/src/Disco/Disco/Core/Pin.fs index 41462a4d..c441d90a 100644 --- a/src/Disco/Disco/Core/Pin.fs +++ b/src/Disco/Disco/Core/Pin.fs @@ -2825,36 +2825,36 @@ type Slice = #if FABLE_COMPILER | x when x = SliceTypeFB.StringFB -> let slice = StringFB.Create() |> fb.Slice - StringSlice(index fb.Index, slice.Value) + StringSlice(1 * fb.Index, slice.Value) |> Either.succeed | x when x = SliceTypeFB.DoubleFB -> let slice = DoubleFB.Create() |> fb.Slice - NumberSlice(index fb.Index, slice.Value) + NumberSlice(1 * fb.Index, slice.Value) |> Either.succeed | x when x = SliceTypeFB.BoolFB -> let slice = BoolFB.Create() |> fb.Slice - BoolSlice(index fb.Index, slice.Trigger, slice.Value) + BoolSlice(1 * fb.Index, slice.Trigger, slice.Value) |> Either.succeed | x when x = SliceTypeFB.ByteFB -> let slice = ByteFB.Create() |> fb.Slice - ByteSlice(index fb.Index,String.decodeBase64 slice.Value) + ByteSlice(1 * fb.Index,String.decodeBase64 slice.Value) |> Either.succeed | x when x = SliceTypeFB.KeyValueFB -> either { let slice = KeyValueFB.Create() |> fb.Slice let! prop = Property.FromFB slice - return EnumSlice(index fb.Index,prop) + return EnumSlice(1 * fb.Index,prop) } | x when x = SliceTypeFB.ColorSpaceFB -> either { let slice = ColorSpaceFB.Create() |> fb.Slice let! color = ColorSpace.FromFB slice - return ColorSlice(index fb.Index, color) + return ColorSlice(1 * fb.Index, color) } | x -> @@ -4356,10 +4356,9 @@ module PinYaml = |> Error.asParseError "PynYml.FromYaml" |> Either.fail - with - | exn -> - sprintf "Could not parse PinYml: %s" exn.Message - |> Error.asParseError "PynYml.FromYaml" - |> Either.fail + with exn -> + sprintf "Could not parse PinYml: %s" exn.Message + |> Error.asParseError "PynYml.FromYaml" + |> Either.fail #endif diff --git a/src/Frontend/src/Frontend/Elmish/PinView.fs b/src/Frontend/src/Frontend/Elmish/PinView.fs index b399fceb..369c217d 100644 --- a/src/Frontend/src/Frontend/Elmish/PinView.fs +++ b/src/Frontend/src/Frontend/Elmish/PinView.fs @@ -58,8 +58,8 @@ type PinView(props) = member this.valueAt(i) = match this.props.slices with - | Some slices -> slices.[index i].Value - | None -> this.props.pin.Slices.[index i].Value + | Some slices -> slices.[i].Value + | None -> this.props.pin.Slices.[i].Value // ** renderRows @@ -112,11 +112,11 @@ type PinView(props) = } if rowCount > 1 then td [ClassName "disco-flex-row"] [ - createElement("div", options, this.valueAt(0)) + createElement("div", options, this.valueAt(0)) this.renderArrow() ] else - td [] [createElement("div", options, this.valueAt(0))] + td [] [createElement("div", options, this.valueAt(0))] let head = tr [ClassName "disco-pin-child"] [ td [ @@ -175,7 +175,7 @@ type PinView(props) = } yield tr [Key (string i); ClassName "disco-pin-child"] [ td [] [str label] - td [] [createElement("div", options, this.valueAt(i))] + td [] [createElement("div", options, this.valueAt(1 * i))] ] ] else tbody [] [head] diff --git a/src/Frontend/src/Frontend/Elmish/ProjectView.fs b/src/Frontend/src/Frontend/Elmish/ProjectView.fs index 93ba82c4..ab7c1c96 100644 --- a/src/Frontend/src/Frontend/Elmish/ProjectView.fs +++ b/src/Frontend/src/Frontend/Elmish/ProjectView.fs @@ -47,7 +47,7 @@ let project2tree (p: DiscoProject) = ; obj2tree "Raft" c.Raft ; obj2tree "Timing" c.Timing ; leaf ("ActiveSite" + string c.ActiveSite) - ; arr2tree "Sites" (Map.map (snd >> box) c.Sites) + ; arr2tree "Sites" (c.Sites |> Map.toArray |> Array.map (snd >> box)) |] |> node "Config" [| leaf ("Id: " + string p.Id) ; leaf ("Name: " + unwrap p.Name) diff --git a/src/Frontend/src/Frontend/Main.fs b/src/Frontend/src/Frontend/Main.fs index a4aec330..d8dd5353 100644 --- a/src/Frontend/src/Frontend/Main.fs +++ b/src/Frontend/src/Frontend/Main.fs @@ -32,7 +32,7 @@ let findPinByName(model: Model, name: string) = if unwrap p.Name = pinName then Some p else None))) let getPinValueAt(pin: Pin, idx: int): obj = - let slice = pin.Slices.At(index idx) + let slice = pin.Slices.At(1 * idx) slice.Value let renderWidget(id, name, headFn, bodyFn, dispatch, model): React.ReactElement = diff --git a/src/Frontend/src/Tests.Frontend/SerializationTests.fs b/src/Frontend/src/Tests.Frontend/SerializationTests.fs index aa304506..95df4d3a 100644 --- a/src/Frontend/src/Tests.Frontend/SerializationTests.fs +++ b/src/Frontend/src/Tests.Frontend/SerializationTests.fs @@ -211,7 +211,7 @@ module SerializationTests = Name = rndname () Locked = false Active = false - Selected = index (rand.Next(0,1000)) + Selected = 1 * (rand.Next(0,1000)) RemainingWait = rand.Next(0,1000) CueListId = rndopt () CallId = DiscoId.Create() From 14dbb5a42a970d56598bebef6693a7675a03bebb Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Fri, 9 Feb 2018 18:38:31 +0100 Subject: [PATCH 15/27] remove custom Either type in favor of built-in Result --- src/Disco/Disco/Client/ApiClient.fs | 20 +- src/Disco/Disco/Client/ApiRequest.fs | 268 ++++----- src/Disco/Disco/Client/Interfaces.fs | 4 +- src/Disco/Disco/Core/Aliases.fs | 38 +- src/Disco/Disco/Core/Asset.fs | 78 +-- src/Disco/Disco/Core/Client.fs | 12 +- src/Disco/Disco/Core/Color.fs | 44 +- src/Disco/Disco/Core/Commands.fs | 2 +- src/Disco/Disco/Core/Cue.fs | 30 +- src/Disco/Disco/Core/CueGroup.fs | 14 +- src/Disco/Disco/Core/CueList.fs | 26 +- src/Disco/Disco/Core/CuePlayer.fs | 28 +- src/Disco/Disco/Core/CueReference.fs | 10 +- src/Disco/Disco/Core/Discovery.fs | 84 +-- src/Disco/Disco/Core/Either.fs | 262 +++------ src/Disco/Disco/Core/Error.fs | 54 +- src/Disco/Disco/Core/FileSystem.fs | 104 ++-- src/Disco/Disco/Core/Git.fs | 132 ++--- src/Disco/Disco/Core/Id.fs | 6 +- src/Disco/Disco/Core/IpAddress.fs | 12 +- src/Disco/Disco/Core/LogLevel.fs | 2 +- src/Disco/Disco/Core/Logging.fs | 22 +- src/Disco/Disco/Core/Machine.fs | 40 +- src/Disco/Disco/Core/Metrics.fs | 10 +- src/Disco/Disco/Core/Network.fs | 12 +- src/Disco/Disco/Core/Pin.fs | 539 +++++++++--------- src/Disco/Disco/Core/PinGroup.fs | 76 +-- src/Disco/Disco/Core/PinMapping.fs | 12 +- src/Disco/Disco/Core/PinWidget.fs | 10 +- src/Disco/Disco/Core/Platform.fs | 10 +- src/Disco/Disco/Core/Project.fs | 278 ++++----- src/Disco/Disco/Core/Property.fs | 8 +- src/Disco/Disco/Core/Serialization.fs | 32 +- src/Disco/Disco/Core/Session.fs | 8 +- src/Disco/Disco/Core/StateMachine.fs | 432 +++++++------- src/Disco/Disco/Core/User.fs | 12 +- src/Disco/Disco/Core/Util.fs | 4 +- src/Disco/Disco/MockClient/Main.fs | 6 +- src/Disco/Disco/Net/Core.fs | 4 +- src/Disco/Disco/Net/PubSub.fs | 4 +- src/Disco/Disco/Net/TcpServer.fs | 4 +- src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs | 8 +- src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs | 8 +- src/Disco/Disco/Nodes/Nodes/GraphNode.fs | 108 ++-- src/Disco/Disco/Nodes/Nodes/LoggingNode.fs | 2 +- src/Disco/Disco/Raft/Log.fs | 6 +- src/Disco/Disco/Raft/LogEntry.fs | 60 +- src/Disco/Disco/Raft/Member.fs | 62 +- src/Disco/Disco/Raft/Raft.fs | 12 +- src/Disco/Disco/Raft/RaftMonad.fs | 26 +- src/Disco/Disco/Raft/RaftState.fs | 12 +- src/Disco/Disco/Raft/Types.fs | 30 +- src/Disco/Disco/RaspberryPi/Main.fs | 4 +- src/Disco/Disco/Service/ApiServer.fs | 46 +- src/Disco/Disco/Service/AssetService.fs | 10 +- src/Disco/Disco/Service/CommandActions.fs | 52 +- src/Disco/Disco/Service/CommandLine.fs | 8 +- src/Disco/Disco/Service/Disco.fs | 28 +- src/Disco/Disco/Service/DiscoService.fs | 62 +- src/Disco/Disco/Service/DiscoveryService.fs | 26 +- src/Disco/Disco/Service/GitServer.fs | 2 +- src/Disco/Disco/Service/HttpServer.fs | 12 +- src/Disco/Disco/Service/Interfaces.fs | 30 +- src/Disco/Disco/Service/Main.fs | 14 +- src/Disco/Disco/Service/NetUtils.fs | 2 +- src/Disco/Disco/Service/Persistence.fs | 44 +- src/Disco/Disco/Service/RaftRequest.fs | 90 +-- src/Disco/Disco/Service/RaftServer.fs | 186 +++--- src/Disco/Disco/Service/WebSocket.fs | 52 +- src/Disco/Disco/Tests/Core/ApiTests.fs | 16 +- .../Disco/Tests/Core/AssetServiceTests.fs | 10 +- src/Disco/Disco/Tests/Core/AssetTests.fs | 12 +- src/Disco/Disco/Tests/Core/ConfigTests.fs | 4 +- .../Core/Disco/AddPreviousMemberShouldPull.fs | 2 +- .../Tests/Core/Disco/ClonesFromLeader.fs | 2 +- src/Disco/Disco/Tests/Core/Disco/Common.fs | 12 +- .../Tests/Core/Disco/CorrectPinPersistance.fs | 2 +- .../Core/Disco/EnsureClientCommandForward.fs | 4 +- .../Core/Disco/EnsureClientUpdateNoLoop.fs | 2 +- .../Core/Disco/EnsureClientsReplicated.fs | 2 +- .../Tests/Core/Disco/EnsureCueResolver.fs | 2 +- .../Tests/Core/Disco/EnsureMappingResolver.fs | 2 +- .../Disco/Tests/Core/Disco/PinBecomesDirty.fs | 2 +- .../Disco/PinBecomesOnlineOnClientConnect.fs | 2 +- .../Disco/RemoveMemberShouldSplitCluster.fs | 2 +- .../StateShouldBeCleanedOnClientRemove.fs | 2 +- src/Disco/Disco/Tests/Core/FsTests.fs | 6 +- src/Disco/Disco/Tests/Core/GitTests.fs | 14 +- src/Disco/Disco/Tests/Core/NetTests.fs | 12 +- .../Disco/Tests/Core/PersistenceTests.fs | 44 +- src/Disco/Disco/Tests/Core/ProjectTests.fs | 36 +- .../Disco/Tests/Core/RaftIntegrationTests.fs | 14 +- src/Disco/Disco/Tests/Core/StateTests.fs | 6 +- src/Disco/Disco/Tests/Core/Synchronization.fs | 2 +- src/Disco/Disco/Tests/Core/UtilTests.fs | 2 +- src/Disco/Disco/Tests/Raft/RaftTestUtils.fs | 8 +- src/Disco/Disco/Tests/TestUtilities.fs | 32 +- src/Disco/Projects/Sdk/Sdk.fsproj | 2 +- src/Frontend/lib/react-ui-tree/node.js | 2 +- .../lib/react-ui-tree/react-ui-tree.js | 2 +- .../src/Frontend/Elmish/ClusterView.fs | 4 +- .../src/Frontend/Elmish/Cues/CuePlayerView.fs | 4 +- .../src/Frontend/Elmish/PlayerListView.fs | 4 +- src/Frontend/src/Frontend/Lib.fs | 2 +- src/Frontend/src/Frontend/Worker.fs | 4 +- .../src/Tests.Frontend/SerializationTests.fs | 26 +- src/Unity/Main.fs | 4 +- 107 files changed, 1994 insertions(+), 2071 deletions(-) diff --git a/src/Disco/Disco/Client/ApiClient.fs b/src/Disco/Disco/Client/ApiClient.fs index c622132a..8452f21c 100644 --- a/src/Disco/Disco/Client/ApiClient.fs +++ b/src/Disco/Disco/Client/ApiClient.fs @@ -189,7 +189,7 @@ module ApiClient = let private handleServerRequest (state: ClientState) (req: Request) (agent: ApiAgent) = match req.Body |> Binary.decode with - | Right (ApiRequest.Snapshot snapshot) -> + | Ok (ApiRequest.Snapshot snapshot) -> state.Socket.Status |> String.format "received snapshot (status: {0})" |> Logger.info (tag "handleServerResponse") @@ -197,12 +197,12 @@ module ApiClient = |> Msg.SetState |> agent.Post - | Right (ApiRequest.Update sm) -> + | Ok (ApiRequest.Update sm) -> sm |> Msg.Update |> agent.Post - | Right other -> + | Ok other -> string other |> ApiError.UnknownCommand |> ApiResponse.NOK @@ -210,7 +210,7 @@ module ApiClient = |> Response.fromRequest req |> state.Socket.Respond - | Left error -> + | Error error -> error |> string |> ApiError.MalformedRequest @@ -230,7 +230,7 @@ module ApiClient = // | _ < __/ (_| | \__ \ || __/ | | __/ (_| | // |_| \_\___|\__, |_|___/\__\___|_| \___|\__,_| // |___/ - | Right ApiResponse.Registered -> + | Ok ApiResponse.Registered -> Logger.info (tag "handleClientResponse") "registration successful" ClientEvent.Registered |> Msg.Notify |> agent.Post @@ -240,7 +240,7 @@ module ApiClient = // | |_| | | | | _ < __/ (_| | \__ \ || __/ | | __/ (_| | // \___/|_| |_|_| \_\___|\__, |_|___/\__\___|_| \___|\__,_| // |___/ - | Right ApiResponse.Unregistered -> + | Ok ApiResponse.Unregistered -> Logger.info (tag "handleClientResponse") "un-registration successful" ClientEvent.UnRegistered |> Msg.Notify |> agent.Post agent.Post Msg.Dispose @@ -250,14 +250,14 @@ module ApiClient = // | \| | | | | ' / // | |\ | |_| | . \ // |_| \_|\___/|_|\_\ - | Right (ApiResponse.NOK error) -> error |> string |> Logger.err (tag "handleClientResponse") + | Ok (ApiResponse.NOK error) -> error |> string |> Logger.err (tag "handleClientResponse") // ____ _ _____ // | _ \ ___ ___ ___ __| | ___ | ____|_ __ _ __ ___ _ __ // | | | |/ _ \/ __/ _ \ / _` |/ _ \ | _| | '__| '__/ _ \| '__| // | |_| | __/ (_| (_) | (_| | __/ | |___| | | | | (_) | | // |____/ \___|\___\___/ \__,_|\___| |_____|_| |_| \___/|_| - | Left error -> error |> string |> Logger.err (tag "handleClientResponse") + | Error error -> error |> string |> Logger.err (tag "handleClientResponse") state // ** handleSocketEvent @@ -376,7 +376,7 @@ module ApiClient = // **** Start member self.Start () = - either { + result { server.Port |> sprintf "Connecting to server on %O:%O" server.IpAddress |> Logger.info (tag "start") @@ -387,7 +387,7 @@ module ApiClient = // **** Restart member self.Restart(server: DiscoServer) = - server |> Msg.Restart |> agent.Post |> Either.succeed + server |> Msg.Restart |> agent.Post |> Result.succeed // **** State diff --git a/src/Disco/Disco/Client/ApiRequest.fs b/src/Disco/Disco/Client/ApiRequest.fs index 69d11dd7..589725df 100644 --- a/src/Disco/Disco/Client/ApiRequest.fs +++ b/src/Disco/Disco/Client/ApiRequest.fs @@ -56,17 +56,17 @@ type ApiError = match fb.Type with | ApiErrorTypeFB.InternalFB -> Internal fb.Data - |> Either.succeed + |> Result.succeed | ApiErrorTypeFB.UnknownCommandFB -> UnknownCommand fb.Data - |> Either.succeed + |> Result.succeed | ApiErrorTypeFB.MalformedRequestFB -> MalformedRequest fb.Data - |> Either.succeed + |> Result.succeed | x -> sprintf "Unknown ApiErrorFB: %A" x |> Error.asClientError "ApiErrorFB.FromFB" - |> Either.fail + |> Result.fail // * ApiRequest @@ -315,7 +315,7 @@ type ApiRequest = // |____/|_| |_|\__,_| .__/|___/_| |_|\___/ \__| // |_| | ApiCommandFB.SnapshotFB, ParameterFB.StateFB -> - either { + result { let! state = let statish = fb.Parameter() if statish.HasValue then @@ -324,12 +324,12 @@ type ApiRequest = else "Empty StateFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return Snapshot state } | ApiCommandFB.DataSnapshotFB, ParameterFB.StateFB -> - either { + result { let! state = let statish = fb.Parameter() if statish.HasValue then @@ -338,7 +338,7 @@ type ApiRequest = else "Empty StateFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update(DataSnapshot state) } @@ -350,7 +350,7 @@ type ApiRequest = | ApiCommandFB.RegisterFB, ParameterFB.DiscoClientFB -> let clientish = fb.Parameter() if clientish.HasValue then - either { + result { let value = clientish.Value let! client = DiscoClient.FromFB(value) return Register client @@ -358,12 +358,12 @@ type ApiRequest = else "Empty DiscoClientFB Parameter in ApiRequest" |> Error.asClientError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail | ApiCommandFB.UnRegisterFB, ParameterFB.DiscoClientFB -> let clientish = fb.Parameter() if clientish.HasValue then - either { + result { let value = clientish.Value let! client = DiscoClient.FromFB(value) return UnRegister client @@ -371,7 +371,7 @@ type ApiRequest = else "Empty DiscoClientFB Parameter in ApiRequest" |> Error.asClientError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail // ____ _ _ // | _ \ _ __ ___ (_) ___ ___| |_ @@ -382,9 +382,9 @@ type ApiRequest = | ApiCommandFB.UnloadFB, _ -> UnloadProject |> ApiRequest.Update - |> Either.succeed + |> Result.succeed | ApiCommandFB.UpdateFB, ParameterFB.ProjectFB -> - either { + result { let! project = let projectish = fb.Parameter() if projectish.HasValue then @@ -393,7 +393,7 @@ type ApiRequest = else "Empty DiscoProjectFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateProject project) } @@ -403,7 +403,7 @@ type ApiRequest = // | |__| (_) | | | | | | | | | | | (_| | | | | (_| | |_) | (_| | || (__| | | | // \____\___/|_| |_| |_|_| |_| |_|\__,_|_| |_|\__,_|____/ \__,_|\__\___|_| |_| | ApiCommandFB.BatchFB, ParameterFB.TransactionFB -> - either { + result { let! commands = let batchish = fb.Parameter() if batchish.HasValue then @@ -412,7 +412,7 @@ type ApiRequest = else "Empty CommandBatchFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (CommandBatch commands) } @@ -423,7 +423,7 @@ type ApiRequest = // \____\__,_|\___|_| |_|\__,_|\__, |\___|_| // |___/ | ApiCommandFB.AddFB, ParameterFB.CuePlayerFB -> - either { + result { let! player = let playerish = fb.Parameter() if playerish.HasValue then @@ -432,11 +432,11 @@ type ApiRequest = else "Empty CuePlayer payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddCuePlayer player) } | ApiCommandFB.UpdateFB, ParameterFB.CuePlayerFB -> - either { + result { let! player = let playerish = fb.Parameter() if playerish.HasValue then @@ -445,11 +445,11 @@ type ApiRequest = else "Empty CuePlayer payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateCuePlayer player) } | ApiCommandFB.RemoveFB, ParameterFB.CuePlayerFB -> - either { + result { let! player = let playerish = fb.Parameter() if playerish.HasValue then @@ -458,7 +458,7 @@ type ApiRequest = else "Empty CuePlayer payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveCuePlayer player) } @@ -468,7 +468,7 @@ type ApiRequest = // | |___| | | __/ | | | |_ // \____|_|_|\___|_| |_|\__| | ApiCommandFB.AddFB, ParameterFB.DiscoClientFB -> - either { + result { let! client = let clientish = fb.Parameter() if clientish.HasValue then @@ -477,11 +477,11 @@ type ApiRequest = else "Empty DiscoClientFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddClient client) } | ApiCommandFB.UpdateFB, ParameterFB.DiscoClientFB -> - either { + result { let! client = let clientish = fb.Parameter() if clientish.HasValue then @@ -490,11 +490,11 @@ type ApiRequest = else "Empty DiscoClientFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateClient client) } | ApiCommandFB.RemoveFB, ParameterFB.DiscoClientFB -> - either { + result { let! client = let clientish = fb.Parameter() if clientish.HasValue then @@ -503,7 +503,7 @@ type ApiRequest = else "Empty DiscoClientFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveClient client) } @@ -513,7 +513,7 @@ type ApiRequest = // | | | | __/ | | | | | |_) | __/ | // |_| |_|\___|_| |_| |_|_.__/ \___|_| | ApiCommandFB.AddFB, ParameterFB.RaftMemberFB -> - either { + result { let! mem = let memish = fb.Parameter() if memish.HasValue then @@ -522,11 +522,11 @@ type ApiRequest = else "Empty RaftMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddMachine mem) } | ApiCommandFB.UpdateFB, ParameterFB.RaftMemberFB -> - either { + result { let! mem = let memish = fb.Parameter() if memish.HasValue then @@ -535,11 +535,11 @@ type ApiRequest = else "Empty RaftMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateMachine mem) } | ApiCommandFB.RemoveFB, ParameterFB.RaftMemberFB -> - either { + result { let! mem = let memish = fb.Parameter() if memish.HasValue then @@ -548,7 +548,7 @@ type ApiRequest = else "Empty RaftMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveMachine mem) } @@ -558,7 +558,7 @@ type ApiRequest = // | | | | __/ | | | | | |_) | __/ | // |_| |_|\___|_| |_| |_|_.__/ \___|_| | ApiCommandFB.AddFB, ParameterFB.ClusterMemberFB -> - either { + result { let! mem = let memish = fb.Parameter() if memish.HasValue then @@ -567,11 +567,11 @@ type ApiRequest = else "Empty ClusterMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddMember mem) } | ApiCommandFB.UpdateFB, ParameterFB.ClusterMemberFB -> - either { + result { let! mem = let memish = fb.Parameter() if memish.HasValue then @@ -580,11 +580,11 @@ type ApiRequest = else "Empty ClusterMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateMember mem) } | ApiCommandFB.RemoveFB, ParameterFB.ClusterMemberFB -> - either { + result { let! mem = let memish = fb.Parameter() if memish.HasValue then @@ -593,7 +593,7 @@ type ApiRequest = else "Empty ClusterMemberFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveMember mem) } @@ -604,15 +604,15 @@ type ApiRequest = /// |_| |___/_____|_| |_|\__|_| \__, | /// |___/ | ApiCommandFB.AddFB, ParameterFB.FsEntryUpdateFB -> - either { + result { let! entryUpdate = let update = fb.Parameter() if update.HasValue then - Either.succeed update.Value + Result.succeed update.Value else "Empty FsEntryUpdateFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail let! id = Id.decodeHostId entryUpdate let! entry = let entryish = entryUpdate.Entry @@ -622,19 +622,19 @@ type ApiRequest = else "Empty FsEntryFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddFsEntry (id, entry)) } | ApiCommandFB.UpdateFB, ParameterFB.FsEntryUpdateFB -> - either { + result { let! entryUpdate = let update = fb.Parameter() if update.HasValue then - Either.succeed update.Value + Result.succeed update.Value else "Empty FsEntryUpdateFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail let! id = Id.decodeHostId entryUpdate let! entry = let entryish = entryUpdate.Entry @@ -644,19 +644,19 @@ type ApiRequest = else "Empty FsEntryFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateFsEntry (id, entry)) } | ApiCommandFB.RemoveFB, ParameterFB.FsEntryUpdateFB -> - either { + result { let! entryUpdate = let update = fb.Parameter() if update.HasValue then - Either.succeed update.Value + Result.succeed update.Value else "Empty FsEntryUpdateFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail let! id = Id.decodeHostId entryUpdate let! path = let entryish = entryUpdate.Path @@ -666,7 +666,7 @@ type ApiRequest = else "Empty FsPathFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveFsEntry (id, path)) } @@ -676,15 +676,15 @@ type ApiRequest = /// | _|\__ \| || | | __/ __/ /// |_| |___/|_||_| \___|\___| | ApiCommandFB.AddFB, ParameterFB.FsTreeUpdateFB -> - either { + result { let! treeUpdate = let update = fb.Parameter() if update.HasValue then - Either.succeed update.Value + Result.succeed update.Value else "Empty FsTreeUpdateFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail let! tree = let treeish = treeUpdate.Tree @@ -694,19 +694,19 @@ type ApiRequest = else "Empty FsTreeFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddFsTree tree) } | ApiCommandFB.RemoveFB, ParameterFB.FsTreeUpdateFB -> - either { + result { let! treeUpdate = let update = fb.Parameter() if update.HasValue then - Either.succeed update.Value + Result.succeed update.Value else "Empty FsTreeUpdateFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail let! id = Id.decodeHostId treeUpdate return ApiRequest.Update (RemoveFsTree id) } @@ -718,7 +718,7 @@ type ApiRequest = // \____|_| \___/ \__,_| .__/ // |_| | ApiCommandFB.AddFB, ParameterFB.PinGroupFB -> - either { + result { let! group = let groupish = fb.Parameter() if groupish.HasValue then @@ -727,11 +727,11 @@ type ApiRequest = else "Empty PinGroupFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddPinGroup group) } | ApiCommandFB.UpdateFB, ParameterFB.PinGroupFB -> - either { + result { let! group = let groupish = fb.Parameter() if groupish.HasValue then @@ -740,11 +740,11 @@ type ApiRequest = else "Empty PinGroupFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdatePinGroup group) } | ApiCommandFB.RemoveFB, ParameterFB.PinGroupFB -> - either { + result { let! group = let groupish = fb.Parameter() if groupish.HasValue then @@ -753,7 +753,7 @@ type ApiRequest = else "Empty PinGroupFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemovePinGroup group) } @@ -764,7 +764,7 @@ type ApiRequest = // |_| |_|\__,_| .__/| .__/|_|_| |_|\__, | // |_| |_| |___/ | ApiCommandFB.AddFB, ParameterFB.PinMappingFB -> - either { + result { let! mapping = let mappingish = fb.Parameter() if mappingish.HasValue then @@ -773,11 +773,11 @@ type ApiRequest = else "Empty PinMappingFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddPinMapping mapping) } | ApiCommandFB.UpdateFB, ParameterFB.PinMappingFB -> - either { + result { let! mapping = let mappingish = fb.Parameter() if mappingish.HasValue then @@ -786,11 +786,11 @@ type ApiRequest = else "Empty PinMappingFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdatePinMapping mapping) } | ApiCommandFB.RemoveFB, ParameterFB.PinMappingFB -> - either { + result { let! mapping = let mappingish = fb.Parameter() if mappingish.HasValue then @@ -799,7 +799,7 @@ type ApiRequest = else "Empty PinMappingFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemovePinMapping mapping) } @@ -810,7 +810,7 @@ type ApiRequest = // \_/\_/ |_|\__,_|\__, |\___|\__| // |___/ | ApiCommandFB.AddFB, ParameterFB.PinWidgetFB -> - either { + result { let! widget = let widgetish = fb.Parameter() if widgetish.HasValue then @@ -819,11 +819,11 @@ type ApiRequest = else "Empty PinWidgetFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddPinWidget widget) } | ApiCommandFB.UpdateFB, ParameterFB.PinWidgetFB -> - either { + result { let! widget = let widgetish = fb.Parameter() if widgetish.HasValue then @@ -832,11 +832,11 @@ type ApiRequest = else "Empty PinWidgetFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdatePinWidget widget) } | ApiCommandFB.RemoveFB, ParameterFB.PinWidgetFB -> - either { + result { let! widget = let widgetish = fb.Parameter() if widgetish.HasValue then @@ -845,7 +845,7 @@ type ApiRequest = else "Empty PinWidgetFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemovePinWidget widget) } @@ -855,7 +855,7 @@ type ApiRequest = // | __/| | | | | // |_| |_|_| |_| | ApiCommandFB.AddFB, ParameterFB.PinFB -> - either { + result { let! pin = let pinish = fb.Parameter() if pinish.HasValue then @@ -864,11 +864,11 @@ type ApiRequest = else "Empty PinFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddPin pin) } | ApiCommandFB.UpdateFB, ParameterFB.PinFB -> - either { + result { let! pin = let pinish = fb.Parameter() if pinish.HasValue then @@ -877,11 +877,11 @@ type ApiRequest = else "Empty PinFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdatePin pin) } | ApiCommandFB.RemoveFB, ParameterFB.PinFB -> - either { + result { let! pin = let pinish = fb.Parameter() if pinish.HasValue then @@ -890,11 +890,11 @@ type ApiRequest = else "Empty PinFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemovePin pin) } | ApiCommandFB.UpdateFB, ParameterFB.SlicesFB -> - either { + result { let! slices = let slicish = fb.Parameter() if slicish.HasValue then @@ -903,7 +903,7 @@ type ApiRequest = else "Empty SlicesFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateSlices slices) } @@ -913,7 +913,7 @@ type ApiRequest = // | |__| |_| | __/ // \____\__,_|\___| | ApiCommandFB.AddFB, ParameterFB.CueFB -> - either { + result { let! cue = let cueish = fb.Parameter() if cueish.HasValue then @@ -922,11 +922,11 @@ type ApiRequest = else "Empty CueFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddCue cue) } | ApiCommandFB.UpdateFB, ParameterFB.CueFB -> - either { + result { let! cue = let cueish = fb.Parameter() if cueish.HasValue then @@ -935,11 +935,11 @@ type ApiRequest = else "Empty CueFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateCue cue) } | ApiCommandFB.RemoveFB, ParameterFB.CueFB -> - either { + result { let! cue = let cueish = fb.Parameter() if cueish.HasValue then @@ -948,11 +948,11 @@ type ApiRequest = else "Empty CueFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveCue cue) } | ApiCommandFB.CallCueFB, ParameterFB.CueFB -> - either { + result { let! cue = let cueish = fb.Parameter() if cueish.HasValue then @@ -961,7 +961,7 @@ type ApiRequest = else "Empty CueFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (CallCue cue) } @@ -971,7 +971,7 @@ type ApiRequest = // | |__| |_| | __/ |___| \__ \ |_ // \____\__,_|\___|_____|_|___/\__| | ApiCommandFB.AddFB, ParameterFB.CueListFB -> - either { + result { let! cueList = let cueListish = fb.Parameter() if cueListish.HasValue then @@ -980,11 +980,11 @@ type ApiRequest = else "Empty CueListFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddCueList cueList) } | ApiCommandFB.UpdateFB, ParameterFB.CueListFB -> - either { + result { let! cueList = let cueListish = fb.Parameter() if cueListish.HasValue then @@ -993,11 +993,11 @@ type ApiRequest = else "Empty CueListFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateCueList cueList) } | ApiCommandFB.RemoveFB, ParameterFB.CueListFB -> - either { + result { let! cueList = let cueListish = fb.Parameter() if cueListish.HasValue then @@ -1006,7 +1006,7 @@ type ApiRequest = else "Empty CueListFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveCueList cueList) } @@ -1016,7 +1016,7 @@ type ApiRequest = // | |_| \__ \ __/ | // \___/|___/\___|_| | ApiCommandFB.AddFB, ParameterFB.UserFB -> - either { + result { let! user = let userish = fb.Parameter() if userish.HasValue then @@ -1025,11 +1025,11 @@ type ApiRequest = else "Empty UserFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddUser user) } | ApiCommandFB.UpdateFB, ParameterFB.UserFB -> - either { + result { let! user = let userish = fb.Parameter() if userish.HasValue then @@ -1038,11 +1038,11 @@ type ApiRequest = else "Empty UserFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateUser user) } | ApiCommandFB.RemoveFB, ParameterFB.UserFB -> - either { + result { let! user = let userish = fb.Parameter() if userish.HasValue then @@ -1051,7 +1051,7 @@ type ApiRequest = else "Empty UserFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveUser user) } @@ -1061,7 +1061,7 @@ type ApiRequest = // ___) | __/\__ \__ \ | (_) | | | | // |____/ \___||___/___/_|\___/|_| |_| | ApiCommandFB.AddFB, ParameterFB.SessionFB -> - either { + result { let! session = let sessionish = fb.Parameter() if sessionish.HasValue then @@ -1070,11 +1070,11 @@ type ApiRequest = else "Empty SessionFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddSession session) } | ApiCommandFB.UpdateFB, ParameterFB.SessionFB -> - either { + result { let! session = let sessionish = fb.Parameter() if sessionish.HasValue then @@ -1083,11 +1083,11 @@ type ApiRequest = else "Empty SessionFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateSession session) } | ApiCommandFB.RemoveFB, ParameterFB.SessionFB -> - either { + result { let! session = let sessionish = fb.Parameter() if sessionish.HasValue then @@ -1096,7 +1096,7 @@ type ApiRequest = else "Empty SessionFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveSession session) } @@ -1106,7 +1106,7 @@ type ApiRequest = // | |_| | \__ \ (_| (_) \ V / __/ | | __/ (_| | // |____/|_|___/\___\___/ \_/ \___|_| \___|\__,_| | ApiCommandFB.AddFB, ParameterFB.DiscoveredServiceFB -> - either { + result { let! service = let serviceish = fb.Parameter() if serviceish.HasValue then @@ -1115,11 +1115,11 @@ type ApiRequest = else "Empty DiscoveredServiceFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (AddDiscoveredService service) } | ApiCommandFB.UpdateFB, ParameterFB.DiscoveredServiceFB -> - either { + result { let! service = let serviceish = fb.Parameter() if serviceish.HasValue then @@ -1128,11 +1128,11 @@ type ApiRequest = else "Empty DiscoveredServiceFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateDiscoveredService service) } | ApiCommandFB.RemoveFB, ParameterFB.DiscoveredServiceFB -> - either { + result { let! service = let serviceish = fb.Parameter() if serviceish.HasValue then @@ -1141,7 +1141,7 @@ type ApiRequest = else "Empty DiscoveredServiceFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (RemoveDiscoveredService service) } @@ -1152,7 +1152,7 @@ type ApiRequest = // |_____\___/ \__, | // |___/ | ApiCommandFB.LogEventFB, ParameterFB.LogEventFB -> - either { + result { let! log = let logish = fb.Parameter() if logish.HasValue then @@ -1161,11 +1161,11 @@ type ApiRequest = else "Empty LogEventFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (LogMsg log) } | ApiCommandFB.SetLogLevelFB, _ -> - either { + result { let! level = let levelish = fb.Parameter() if levelish.HasValue then @@ -1174,7 +1174,7 @@ type ApiRequest = else "Empty StringFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (SetLogLevel level) } @@ -1184,16 +1184,16 @@ type ApiRequest = // | |___| | (_) | (__| < // \____|_|\___/ \___|_|\_\ | ApiCommandFB.UpdateFB, ParameterFB.ClockFB -> - either { + result { let! clock = let clockish = fb.Parameter() if clockish.HasValue then let value = clockish.Value - Right value.Value + Ok value.Value else "Empty ClockFB payload" |> Error.asParseError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail return ApiRequest.Update (UpdateClock clock) } @@ -1206,24 +1206,24 @@ type ApiRequest = AppCommand.Undo |> Command |> ApiRequest.Update - |> Either.succeed + |> Result.succeed | ApiCommandFB.RedoFB, _ -> AppCommand.Redo |> Command |> ApiRequest.Update - |> Either.succeed + |> Result.succeed | ApiCommandFB.ResetFB, _ -> AppCommand.Reset |> Command |> ApiRequest.Update - |> Either.succeed + |> Result.succeed | x,y -> sprintf "Unknown Command/Type combination in ApiRequest: %A/%A" x y |> Error.asClientError "ApiRequest.FromFB" - |> Either.fail + |> Result.fail // ** ToBytes @@ -1271,10 +1271,10 @@ type ApiResponse = static member FromFB(fb: ApiResponseFB) = match fb.Status with - | StatusFB.RegisteredFB -> Right Registered - | StatusFB.UnregisteredFB -> Right Unregistered + | StatusFB.RegisteredFB -> Ok Registered + | StatusFB.UnregisteredFB -> Ok Unregistered | StatusFB.NOKFB -> - either { + result { let! error = let errorish = fb.Error if errorish.HasValue then @@ -1283,13 +1283,13 @@ type ApiResponse = else "Empty ApiErrorFB value" |> Error.asParseError "ApiResponse.FromFB" - |> Either.fail + |> Result.fail return NOK error } | x -> sprintf "Unknown StatusFB value: %A" x |> Error.asParseError "ApiResponse.FromFB" - |> Either.fail + |> Result.fail member request.ToBytes() = Binary.buildBuffer request diff --git a/src/Disco/Disco/Client/Interfaces.fs b/src/Disco/Disco/Client/Interfaces.fs index 4f98f1d2..1cd70341 100644 --- a/src/Disco/Disco/Client/Interfaces.fs +++ b/src/Disco/Disco/Client/Interfaces.fs @@ -50,8 +50,8 @@ type ClientEvent = type IApiClient = inherit IDisposable abstract Id: ClientId - abstract Start: unit -> Either - abstract Restart: server:DiscoServer -> Either + abstract Start: unit -> DiscoResult + abstract Restart: server:DiscoServer -> DiscoResult abstract State: State abstract Status: ServiceStatus abstract Subscribe: (ClientEvent -> unit) -> IDisposable diff --git a/src/Disco/Disco/Core/Aliases.fs b/src/Disco/Disco/Core/Aliases.fs index 3686cac8..da249b34 100644 --- a/src/Disco/Disco/Core/Aliases.fs +++ b/src/Disco/Disco/Core/Aliases.fs @@ -241,59 +241,59 @@ type ServiceStatus = // ** FromFB static member FromFB (fb: ServiceStatusFB) = - either { + result { return! #if FABLE_COMPILER match fb.Type with - | x when x = ServiceStatusTypeFB.RunningFB -> Right Running - | x when x = ServiceStatusTypeFB.StartingFB -> Right Starting - | x when x = ServiceStatusTypeFB.StoppingFB -> Right Stopping - | x when x = ServiceStatusTypeFB.StoppedFB -> Right Stopped - | x when x = ServiceStatusTypeFB.DisposedFB -> Right Disposed + | x when x = ServiceStatusTypeFB.RunningFB -> Ok Running + | x when x = ServiceStatusTypeFB.StartingFB -> Ok Starting + | x when x = ServiceStatusTypeFB.StoppingFB -> Ok Stopping + | x when x = ServiceStatusTypeFB.StoppedFB -> Ok Stopped + | x when x = ServiceStatusTypeFB.DisposedFB -> Ok Disposed | x when x = ServiceStatusTypeFB.DegradedFB -> - fb.Error |> DiscoError.FromFB |> Either.map Degraded + fb.Error |> DiscoError.FromFB |> Result.map Degraded | x when x = ServiceStatusTypeFB.FailedFB -> - fb.Error |> DiscoError.FromFB |> Either.map Failed + fb.Error |> DiscoError.FromFB |> Result.map Failed | other -> other |> sprintf "could not parse empty Error payload: %O" |> Error.asParseError "ServiceStatus.FromFB" - |> Either.fail + |> Result.fail #else match fb.Type with - | ServiceStatusTypeFB.RunningFB -> Right Running - | ServiceStatusTypeFB.StartingFB -> Right Starting - | ServiceStatusTypeFB.StoppingFB -> Right Stopping - | ServiceStatusTypeFB.StoppedFB -> Right Stopped - | ServiceStatusTypeFB.DisposedFB -> Right Disposed + | ServiceStatusTypeFB.RunningFB -> Ok Running + | ServiceStatusTypeFB.StartingFB -> Ok Starting + | ServiceStatusTypeFB.StoppingFB -> Ok Stopping + | ServiceStatusTypeFB.StoppedFB -> Ok Stopped + | ServiceStatusTypeFB.DisposedFB -> Ok Disposed | ServiceStatusTypeFB.DegradedFB -> let valueish = fb.Error if valueish.HasValue then let value = valueish.Value DiscoError.FromFB value - |> Either.map Degraded + |> Result.map Degraded else "could not parse empty Error payload" |> Error.asParseError "ServiceStatus.FromFB" - |> Either.fail + |> Result.fail | ServiceStatusTypeFB.FailedFB -> let valueish = fb.Error if valueish.HasValue then let value = valueish.Value DiscoError.FromFB value - |> Either.map Failed + |> Result.map Failed else "could not parse empty Error payload" |> Error.asParseError "ServiceStatus.FromFB" - |> Either.fail + |> Result.fail | other -> other |> sprintf "could not parse empty Error payload: %O" |> Error.asParseError "ServiceStatus.FromFB" - |> Either.fail + |> Result.fail #endif } diff --git a/src/Disco/Disco/Core/Asset.fs b/src/Disco/Disco/Core/Asset.fs index efe9ec40..a26fb416 100644 --- a/src/Disco/Disco/Core/Asset.fs +++ b/src/Disco/Disco/Core/Asset.fs @@ -35,46 +35,46 @@ module Asset = #if !FABLE_COMPILER - let inline save< ^t when ^t : (member Save: FilePath -> Either)> + let inline save< ^t when ^t : (member Save: FilePath -> DiscoResult)> (path: FilePath) (t: ^t) = - (^t : (member Save: FilePath -> Either) (t, path)) + (^t : (member Save: FilePath -> DiscoResult) (t, path)) // ** delete - let inline delete< ^t when ^t : (member Delete: FilePath -> Either)> + let inline delete< ^t when ^t : (member Delete: FilePath -> DiscoResult)> (path: FilePath) (t: ^t) = - (^t : (member Delete: FilePath -> Either) (t, path)) + (^t : (member Delete: FilePath -> DiscoResult) (t, path)) // ** saveMap - let inline saveMap (basepath: FilePath) (guard: Either) _ (t: ^t) = - either { + let inline saveMap (basepath: FilePath) (guard: DiscoResult) _ (t: ^t) = + result { do! guard do! save basepath t } // ** load - let inline load< ^t when ^t : (static member Load: FilePath -> Either)> + let inline load< ^t when ^t : (static member Load: FilePath -> DiscoResult< ^t>)> (path: FilePath) = - (^t : (static member Load: FilePath -> Either) path) + (^t : (static member Load: FilePath -> DiscoResult< ^t>) path) // ** loadWithMachine - let inline loadWithMachine< ^t when ^t : (static member Load: FilePath * DiscoMachine -> Either)> + let inline loadWithMachine< ^t when ^t : (static member Load: FilePath * DiscoMachine -> DiscoResult< ^t>)> (path: FilePath) (machine: DiscoMachine) = - (^t : (static member Load: FilePath * DiscoMachine -> Either) (path,machine)) + (^t : (static member Load: FilePath * DiscoMachine -> DiscoResult< ^t>) (path,machine)) // ** loadAll - let inline loadAll< ^t when ^t : (static member LoadAll: FilePath -> Either)> + let inline loadAll< ^t when ^t : (static member LoadAll: FilePath -> DiscoResult< ^t array>)> (basePath: FilePath) = - (^t : (static member LoadAll: FilePath -> Either) basePath) + (^t : (static member LoadAll: FilePath -> DiscoResult< ^t array>) basePath) // ** hasParent @@ -104,9 +104,9 @@ module DiscoData = /// - location: FilePath to asset /// - payload: string payload to save /// - /// Returns: Either + /// Returns: DiscoResult let write (location: FilePath) (payload: StringPayload) = - either { + result { try let data = match payload with | Payload data -> data let info = File.info location @@ -119,7 +119,7 @@ module DiscoData = return! exn.Message |> Error.asAssetError (tag "write") - |> Either.fail + |> Result.fail } #endif @@ -135,9 +135,9 @@ module DiscoData = /// ### Signature: /// - location: FilePath to asset /// - /// Returns: Either + /// Returns: DiscoResult let remove (location: FilePath) = - either { + result { try if File.exists location then Path.map File.Delete location @@ -148,7 +148,7 @@ module DiscoData = return! exn.Message |> Error.asAssetError (tag "remove") - |> Either.fail + |> Result.fail } #endif @@ -165,9 +165,9 @@ module DiscoData = /// ### Signature: /// - locationg: FilePath to asset /// - /// Returns: Either - let read (location: FilePath) : Either = - either { + /// Returns: DiscoResult + let read (location: FilePath) : DiscoResult< string> = + result { if File.exists location then try return File.readText location @@ -176,19 +176,19 @@ module DiscoData = return! exn.Message |> Error.asAssetError (tag "read") - |> Either.fail + |> Result.fail else return! sprintf "File not found: %O" location |> Error.asAssetError (tag "read") - |> Either.fail + |> Result.fail } #endif // ** load let inline load (path: FilePath) = - either { + result { let! data = read path let! group = Yaml.decode data return group @@ -197,7 +197,7 @@ module DiscoData = // ** loadAll let inline loadAll (basePath: FilePath) = - either { + result { try let files = Directory.getFiles true ("*" + Constants.ASSET_EXTENSION) basePath let! (_,groups) = @@ -206,14 +206,14 @@ module DiscoData = |> Array.length |> Array.zeroCreate Array.fold - (fun (m: Either) path -> - either { + (fun (m: DiscoResult) path -> + result { let! (idx,groups) = m let! group = load path groups.[idx] <- group return (idx + 1, groups) }) - (Right(0, arr)) + (Ok(0, arr)) files return groups with @@ -221,7 +221,7 @@ module DiscoData = return! exn.Message |> Error.asAssetError "PinGroup.LoadAll" - |> Either.fail + |> Result.fail } // ** ensureDirectoryExists @@ -231,9 +231,9 @@ module DiscoData = path |> Path.getDirectoryName |> Directory.createDirectory - |> Either.ignore + |> Result.ignore else - Either.nothing + Result.nothing // ** ensureDirectoryGone @@ -241,14 +241,14 @@ module DiscoData = if Asset.hasParent asset then if Directory.isEmpty dir then Directory.removeDirectory dir - |> Either.ignore - else Either.nothing - else Either.nothing + |> Result.ignore + else Result.nothing + else Result.nothing // ** save let inline save (basePath: FilePath) asset = - either { + result { let path = basePath Asset.path asset do! ensureDirectoryExists path asset let data = Yaml.encode asset @@ -259,7 +259,7 @@ module DiscoData = // ** delete let inline delete (basePath: FilePath) asset = - either { + result { let path = basePath Asset.path asset do! path |> Path.concat basePath |> remove do! ensureDirectoryGone (Path.directoryName path) asset @@ -270,7 +270,7 @@ module DiscoData = #if !FABLE_COMPILER let inline commit (basepath: FilePath) (msg: string) (signature: LibGit2Sharp.Signature) (t: ^t) = - either { + result { use! repo = Git.Repo.repository basepath let target = @@ -291,7 +291,7 @@ module DiscoData = #if !FABLE_COMPILER let inline saveWithCommit (basepath: FilePath) (signature: LibGit2Sharp.Signature) (t: ^t) = - either { + result { do! save basepath t let filename = t |> Asset.path |> Path.getFileName let msg = sprintf "%s saved %A" signature.Name filename @@ -305,7 +305,7 @@ module DiscoData = #if !FABLE_COMPILER let inline deleteWithCommit (basepath: FilePath) (signature: LibGit2Sharp.Signature) (t: ^t) = - either { + result { let filepath = basepath Asset.path t let! _ = remove filepath let msg = sprintf "%s deleted %A" signature.Name (Path.getFileName filepath) diff --git a/src/Disco/Disco/Core/Client.fs b/src/Disco/Disco/Core/Client.fs index 76abd918..83fb6eda 100644 --- a/src/Disco/Disco/Core/Client.fs +++ b/src/Disco/Disco/Core/Client.fs @@ -43,18 +43,18 @@ type Role = static member FromFB(fb: RoleFB) = #if FABLE_COMPILER match fb with - | x when x = RoleFB.RendererFB -> Either.succeed Renderer + | x when x = RoleFB.RendererFB -> Result.succeed Renderer | x -> sprintf "Unknown RoleFB value: %A" x |> Error.asClientError "Role.FromFB" - |> Either.fail + |> Result.fail #else match fb with - | RoleFB.RendererFB -> Either.succeed Renderer + | RoleFB.RendererFB -> Result.succeed Renderer | x -> sprintf "Unknown RoleFB value: %A" x |> Error.asClientError "Role.FromFB" - |> Either.fail + |> Result.fail #endif // * DiscoClient @@ -97,7 +97,7 @@ type DiscoClient = // ** FromFB static member FromFB(fb: DiscoClientFB) = - either { + result { let! id = Id.decodeId fb let! serviceId = Id.decodeServiceId fb let! role = Role.FromFB fb.Role @@ -113,7 +113,7 @@ type DiscoClient = else "could not parse empty status payload" |> Error.asParseError "DiscoClient.FromFB" - |> Either.fail + |> Result.fail #endif return { Id = id diff --git a/src/Disco/Disco/Core/Color.fs b/src/Disco/Disco/Core/Color.fs index 63a31936..1513cea4 100644 --- a/src/Disco/Disco/Core/Color.fs +++ b/src/Disco/Disco/Core/Color.fs @@ -148,17 +148,17 @@ type RGBAValue = Green = green Blue = blue Alpha = alpha } - |> Either.succeed + |> Result.succeed | Parsing.RGB (red, green, blue) -> { Red = red Green = green Blue = blue Alpha = 255uy } - |> Either.succeed + |> Result.succeed | _ -> System.String.Format("Cannot parse {0} as RGB(A)", value) |> Error.asParseError "RGBAValue.TryParse" - |> Either.fail + |> Result.fail // ** ToOffset @@ -179,18 +179,18 @@ type RGBAValue = // ** FromFB - static member FromFB(fb: RGBAValueFB) : Either = + static member FromFB(fb: RGBAValueFB) : DiscoResult = try { Red = fb.Red ; Green = fb.Green ; Blue = fb.Blue ; Alpha = fb.Alpha - } |> Right + } |> Ok with | exn -> exn.Message |> Error.asParseError "RGBAValue.FromFB" - |> Either.fail + |> Result.fail // ** ToBytes @@ -291,18 +291,18 @@ type HSLAValue = // ** FromFB - static member FromFB(fb: HSLAValueFB) : Either = + static member FromFB(fb: HSLAValueFB) : DiscoResult = try { Hue = fb.Hue ; Saturation = fb.Saturation ; Lightness = fb.Lightness ; Alpha = fb.Alpha - } |> Right + } |> Ok with | exn -> exn.Message |> Error.asParseError "HSLAValue.FromFB" - |> Either.fail + |> Result.fail // ** ToBytes @@ -333,7 +333,7 @@ type ColorSpace = static member TryParse(value:string) = value |> RGBAValue.TryParse - |> Either.map ColorSpace.RGBA + |> Result.map ColorSpace.RGBA // ** Black @@ -372,25 +372,25 @@ type ColorSpace = // ** FromFB - static member FromFB(fb: ColorSpaceFB) : Either = + static member FromFB(fb: ColorSpaceFB) : DiscoResult = #if FABLE_COMPILER match fb.ValueType with | x when x = ColorSpaceTypeFB.RGBAValueFB -> RGBAValueFB.Create() |> fb.Value |> RGBAValue.FromFB - |> Either.map RGBA + |> Result.map RGBA | x when x = ColorSpaceTypeFB.HSLAValueFB -> HSLAValueFB.Create() |> fb.Value |> HSLAValue.FromFB - |> Either.map HSLA + |> Result.map HSLA | x -> sprintf "Could not deserialize %A" x |> Error.asParseError "ColorSpace.FromFB" - |> Either.fail + |> Result.fail #else // On .NET side, System.Nullables are used. Hard to emulate rn. @@ -400,27 +400,27 @@ type ColorSpace = if v.HasValue then v.Value |> RGBAValue.FromFB - |> Either.map RGBA + |> Result.map RGBA else "Could not parse RGBAValue" |> Error.asParseError "ColorSpace.FromFB" - |> Either.fail + |> Result.fail | ColorSpaceTypeFB.HSLAValueFB -> let v = fb.Value() if v.HasValue then v.Value |> HSLAValue.FromFB - |> Either.map HSLA + |> Result.map HSLA else "Could not parse RGBAValue" |> Error.asParseError "ColorSpace.FromFB" - |> Either.fail + |> Result.fail | x -> sprintf "Could not parse ColorSpaceFB. Unknown type: %A" x |> Error.asParseError "ColorSpace.FromFB" - |> Either.fail + |> Result.fail #endif @@ -469,17 +469,17 @@ type ColorSpace = Green = yml.Channel2; Blue = yml.Channel3; Alpha = yml.Alpha - } |> Right + } |> Ok | "HSLA" -> HSLA { Hue = yml.Channel1; Saturation = yml.Channel2; Lightness = yml.Channel3; Alpha = yml.Alpha - } |> Right + } |> Ok | x -> sprintf "Could not parse ColorYaml. Unknown type: %s" x |> Error.asParseError "ColorSpace.FromYaml" - |> Either.fail + |> Result.fail #endif diff --git a/src/Disco/Disco/Core/Commands.fs b/src/Disco/Disco/Core/Commands.fs index 86add673..e69abe0e 100644 --- a/src/Disco/Disco/Core/Commands.fs +++ b/src/Disco/Disco/Core/Commands.fs @@ -43,4 +43,4 @@ type Command = | LoadProject of projectName:Name * site:NameAndId option | GetProjectSites of projectName:Name -type CommandAgent = Command -> Async> +type CommandAgent = Command -> Async> diff --git a/src/Disco/Disco/Core/Cue.fs b/src/Disco/Disco/Core/Cue.fs index 7996d1af..772af402 100644 --- a/src/Disco/Disco/Core/Cue.fs +++ b/src/Disco/Disco/Core/Cue.fs @@ -50,19 +50,19 @@ type CueYaml() = // ** ToCue member yaml.ToCue() = - either { + result { let! slices = let arr = Array.zeroCreate yaml.Slices.Length Array.fold - (fun (m: Either) box -> either { + (fun (m: DiscoResult) box -> result { let! (i, arr) = m let! (slice : Slices) = Yaml.fromYaml box arr.[i] <- slice return (i + 1, arr) }) - (Right (0, arr)) + (Ok (0, arr)) yaml.Slices - |> Either.map snd + |> Result.map snd let! id = DiscoId.TryParse yaml.Id @@ -106,12 +106,12 @@ type Cue = // |____/|_|_| |_|\__,_|_| \__, | // |___/ - static member FromFB(fb: CueFB) : Either = - either { + static member FromFB(fb: CueFB) : DiscoResult = + result { let! slices = let arr = Array.zeroCreate fb.SlicesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (i, slices) = m let! slice = @@ -126,19 +126,19 @@ type Cue = else "Could not parse empty SlicesFB" |> Error.asParseError "Cue.FromFB" - |> Either.fail + |> Result.fail #endif with | exn -> exn.Message |> Error.asParseError "Cue.FromtFB" - |> Either.fail + |> Result.fail slices.[i] <- slice return (i + 1, slices) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd let! id = Id.decodeId fb @@ -164,7 +164,7 @@ type Cue = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = bytes |> Binary.createBuffer |> CueFB.GetRootAsCueFB @@ -188,7 +188,7 @@ type Cue = // ** FromYaml - static member FromYaml(yaml: CueYaml) : Either = + static member FromYaml(yaml: CueYaml) : DiscoResult = yaml.ToCue() // ** AssetPath @@ -216,12 +216,12 @@ type Cue = // | |__| (_) | (_| | (_| | // |_____\___/ \__,_|\__,_| - static member Load(path: FilePath) : Either = + static member Load(path: FilePath) : DiscoResult = DiscoData.load path // ** LoadAll - static member LoadAll(basePath: FilePath) : Either = + static member LoadAll(basePath: FilePath) : DiscoResult = basePath filepath CUE_DIR |> DiscoData.loadAll diff --git a/src/Disco/Disco/Core/CueGroup.fs b/src/Disco/Disco/Core/CueGroup.fs index c8dd7a32..fba08187 100644 --- a/src/Disco/Disco/Core/CueGroup.fs +++ b/src/Disco/Disco/Core/CueGroup.fs @@ -53,9 +53,9 @@ type CueGroupYaml() = // ** ToCueGroup member yaml.ToCueGroup() = - either { + result { let! id = DiscoId.TryParse yaml.Id - let! cues = Either.bindArray Yaml.fromYaml yaml.CueRefs + let! cues = Result.bindArray Yaml.fromYaml yaml.CueRefs let name = if System.String.IsNullOrWhiteSpace yaml.Name then None @@ -106,10 +106,10 @@ type CueGroup = // |____/|_|_| |_|\__,_|_| \__, | // |___/ - static member FromFB(fb: CueGroupFB) : Either = - either { + static member FromFB(fb: CueGroupFB) : DiscoResult = + result { let! cues = - EitherExt.bindGeneratorToArray + ResultExt.bindGeneratorToArray "CueGroup.FromFB" fb.CueRefsLength fb.CueRefs @@ -143,7 +143,7 @@ type CueGroup = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = bytes |> Binary.createBuffer |> CueGroupFB.GetRootAsCueGroupFB @@ -167,7 +167,7 @@ type CueGroup = // ** FromYaml - static member FromYaml(yaml: CueGroupYaml) : Either = + static member FromYaml(yaml: CueGroupYaml) : DiscoResult = yaml.ToCueGroup() #endif diff --git a/src/Disco/Disco/Core/CueList.fs b/src/Disco/Disco/Core/CueList.fs index c60b784d..3abda8fc 100644 --- a/src/Disco/Disco/Core/CueList.fs +++ b/src/Disco/Disco/Core/CueList.fs @@ -45,19 +45,19 @@ type CueListYaml() = yaml member yaml.ToCueList() = - either { + result { let! items = let arr = Array.zeroCreate yaml.Items.Length Array.fold - (fun (m: Either) itemish -> either { + (fun (m: DiscoResult) itemish -> result { let! (i, arr) = m let! (item: CueGroup) = Yaml.fromYaml itemish arr.[i] <- item return (i + 1, arr) }) - (Right (0, arr)) + (Ok (0, arr)) yaml.Items - |> Either.map snd + |> Result.map snd let! id = DiscoId.TryParse yaml.Id @@ -122,12 +122,12 @@ type CueList = // ** FromFB - static member FromFB(fb: CueListFB) : Either = - either { + static member FromFB(fb: CueListFB) : DiscoResult = + result { let! items = let arr = Array.zeroCreate fb.ItemsLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (i, items) = m #if FABLE_COMPILER @@ -140,15 +140,15 @@ type CueList = else "Could not parse empty CueGroupFB" |> Error.asParseError "CueList.FromFB" - |> Either.fail + |> Result.fail #endif items.[i] <- item return (i + 1, items) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd let! id = Id.decodeId fb @@ -180,7 +180,7 @@ type CueList = // ** FromYaml - static member FromYaml(yml: CueListYaml) : Either = + static member FromYaml(yml: CueListYaml) : DiscoResult = yml.ToCueList() // ** AssetPath @@ -202,12 +202,12 @@ type CueList = // | |__| (_) | (_| | (_| | // |_____\___/ \__,_|\__,_| - static member Load(path: FilePath) : Either = + static member Load(path: FilePath) : DiscoResult = DiscoData.load path // ** LoadAll - static member LoadAll(basePath: FilePath) : Either = + static member LoadAll(basePath: FilePath) : DiscoResult = basePath filepath CUELIST_DIR |> DiscoData.loadAll diff --git a/src/Disco/Disco/Core/CuePlayer.fs b/src/Disco/Disco/Core/CuePlayer.fs index aa02f2c9..f471b5e1 100644 --- a/src/Disco/Disco/Core/CuePlayer.fs +++ b/src/Disco/Disco/Core/CuePlayer.fs @@ -68,7 +68,7 @@ type CuePlayerYaml() = // ** ToPlayer member yaml.ToPlayer() = - either { + result { let str2opt str = match str with | null -> None @@ -200,30 +200,30 @@ type CuePlayer = // ** FromFB static member FromFB(fb: CuePlayerFB) = - either { + result { let! cuelist = try if fb.CueListIdLength = 0 - then Either.succeed None - else Id.decodeCueListId fb |> Either.map Some + then Result.succeed None + else Id.decodeCueListId fb |> Result.map Some with exn -> - Either.succeed None + Result.succeed None let! lastcalled = try if fb.LastCalledIdLength = 0 - then Either.succeed None - else Id.decodeLastCalledId fb |> Either.map Some + then Result.succeed None + else Id.decodeLastCalledId fb |> Result.map Some with exn -> - Either.succeed None + Result.succeed None let! lastcaller = try if fb.LastCallerIdLength = 0 - then Either.succeed None - else Id.decodeLastCallerId fb |> Either.map Some + then Result.succeed None + else Id.decodeLastCallerId fb |> Result.map Some with exn -> - Either.succeed None + Result.succeed None let! id = Id.decodeId fb let! call = Id.decodeCallId fb @@ -252,7 +252,7 @@ type CuePlayer = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> CuePlayerFB.GetRootAsCuePlayerFB |> CuePlayer.FromFB @@ -278,12 +278,12 @@ type CuePlayer = #if !FABLE_COMPILER && !DISCO_NODES - static member Load(path: FilePath) : Either = + static member Load(path: FilePath) : DiscoResult = DiscoData.load path // ** LoadAll - static member LoadAll(basePath: FilePath) : Either = + static member LoadAll(basePath: FilePath) : DiscoResult = basePath filepath Constants.CUEPLAYER_DIR |> DiscoData.loadAll diff --git a/src/Disco/Disco/Core/CueReference.fs b/src/Disco/Disco/Core/CueReference.fs index f9da48b0..43685bc2 100644 --- a/src/Disco/Disco/Core/CueReference.fs +++ b/src/Disco/Disco/Core/CueReference.fs @@ -55,7 +55,7 @@ type CueReferenceYaml() = // ** ToCueReference member yaml.ToCueReference() = - either { + result { let! id = DiscoId.TryParse yaml.Id let! cueId = DiscoId.TryParse yaml.CueId return { @@ -112,8 +112,8 @@ type CueReference = // |____/|_|_| |_|\__,_|_| \__, | // |___/ - static member FromFB(fb: CueReferenceFB) : Either = - either { + static member FromFB(fb: CueReferenceFB) : DiscoResult = + result { let! id = Id.decodeId fb let! cueId = Id.decodeCueId fb return { @@ -140,7 +140,7 @@ type CueReference = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = bytes |> Binary.createBuffer |> CueReferenceFB.GetRootAsCueReferenceFB @@ -164,7 +164,7 @@ type CueReference = // ** FromYaml - static member FromYaml(yaml: CueReferenceYaml) : Either = + static member FromYaml(yaml: CueReferenceYaml) : DiscoResult = yaml.ToCueReference() #endif diff --git a/src/Disco/Disco/Core/Discovery.fs b/src/Disco/Disco/Core/Discovery.fs index 14866e5a..cc85d9f5 100644 --- a/src/Disco/Disco/Core/Discovery.fs +++ b/src/Disco/Disco/Core/Discovery.fs @@ -61,12 +61,12 @@ type ServiceType = try str |> ServiceType.Parse - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asParseError "ServiceType.TryParse" - |> Either.fail + |> Result.fail // ** ToOffset @@ -83,26 +83,26 @@ type ServiceType = static member FromFB(fb: ExposedServiceTypeFB) = #if FABLE_COMPILER match fb with - | x when x = ExposedServiceTypeFB.GitFB -> Right Git - | x when x = ExposedServiceTypeFB.RaftFB -> Right Raft - | x when x = ExposedServiceTypeFB.HttpFB -> Right Http - | x when x = ExposedServiceTypeFB.ApiFB -> Right Api - | x when x = ExposedServiceTypeFB.WebSocketFB -> Right WebSocket + | x when x = ExposedServiceTypeFB.GitFB -> Ok Git + | x when x = ExposedServiceTypeFB.RaftFB -> Ok Raft + | x when x = ExposedServiceTypeFB.HttpFB -> Ok Http + | x when x = ExposedServiceTypeFB.ApiFB -> Ok Api + | x when x = ExposedServiceTypeFB.WebSocketFB -> Ok WebSocket | x -> sprintf "Unknown ExposedServiceTypeFB value: %d" x |> Error.asParseError "ServiceType.FromFB" - |> Either.fail + |> Result.fail #else match fb with - | ExposedServiceTypeFB.GitFB -> Right Git - | ExposedServiceTypeFB.RaftFB -> Right Raft - | ExposedServiceTypeFB.HttpFB -> Right Http - | ExposedServiceTypeFB.ApiFB -> Right Api - | ExposedServiceTypeFB.WebSocketFB -> Right WebSocket + | ExposedServiceTypeFB.GitFB -> Ok Git + | ExposedServiceTypeFB.RaftFB -> Ok Raft + | ExposedServiceTypeFB.HttpFB -> Ok Http + | ExposedServiceTypeFB.ApiFB -> Ok Api + | ExposedServiceTypeFB.WebSocketFB -> Ok WebSocket | x -> sprintf "Unknown ExposedServiceTypeFB value: %O" x |> Error.asParseError "ServiceType.FromFB" - |> Either.fail + |> Result.fail #endif @@ -148,7 +148,7 @@ type ExposedService = // ** FromFB static member FromFB (fb: ExposedServiceFB) = - either { + result { let! tipe = ServiceType.FromFB fb.Type return { ServiceType = tipe; Port = port fb.Port } } @@ -341,20 +341,20 @@ type DiscoveredService = // ** FromFB static member FromFB(fb: DiscoveredServiceFB) = - either { + result { let! protocol = match fb.Protocol with - | "IPv4" -> Right IPProtocol.IPv4 - | "IPv6" -> Right IPProtocol.IPv6 + | "IPv4" -> Ok IPProtocol.IPv4 + | "IPv6" -> Ok IPProtocol.IPv6 | other -> "Unknown protocol: " + other |> Error.asParseError "Discovery.FromFB" - |> Either.fail + |> Result.fail let! metadata = let arr = Array.zeroCreate fb.ExtraMetadataLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (idx, props) = m #if FABLE_COMPILER @@ -368,28 +368,28 @@ type DiscoveredService = else "Unable to parse empty Property value" |> Error.asParseError "DiscoveredService.FromFB" - |> Either.fail + |> Result.fail #endif props.[idx] <- prop return (idx + 1, props) }) - (Right(0, arr)) + (Ok(0, arr)) arr - |> Either.map snd + |> Result.map snd let! addressList = let arr = Array.zeroCreate fb.AddressListLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (idx, addresses) = m let! ip = fb.AddressList(idx) |> IpAddress.TryParse addresses.[idx] <- ip return (idx + 1, addresses) }) - (Right(0, arr)) + (Ok(0, arr)) arr - |> Either.map snd + |> Result.map snd let aliases = [| for i = 0 to fb.AliasesLength - 1 do @@ -407,13 +407,13 @@ type DiscoveredService = else "Unable to parse empty ServiceStatus" |> Error.asParseError "DiscoveredService.FromFB" - |> Either.fail + |> Result.fail #endif let! services = let arr = Array.zeroCreate fb.ServicesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (idx, services) = m #if FABLE_COMPILER @@ -427,15 +427,15 @@ type DiscoveredService = else "Unable to parse empty ExposedService key/value" |> Error.asParseError "DiscoveryService.FromFB" - |> Either.fail + |> Result.fail #endif services.[idx] <- service return (idx + 1, services) }) - (Right(0, arr)) + (Ok(0, arr)) arr - |> Either.map snd + |> Result.map snd let! id = Id.decodeId fb @@ -580,11 +580,11 @@ module Discovery = #if FABLE_COMPILER let prt = try Some(uint16 item.ValueString) with | _ -> None match ServiceType.TryParse item.Key, prt with - | Right st, (true, prt) -> Some { ServiceType = st; Port = port prt } + | Ok st, (true, prt) -> Some { ServiceType = st; Port = port prt } | _ -> None #else match ServiceType.TryParse item.Key, UInt16.TryParse item.ValueString with - | Right st, (true, prt) -> Some { ServiceType = st; Port = port prt } + | Ok st, (true, prt) -> Some { ServiceType = st; Port = port prt } | _ -> None #endif @@ -607,22 +607,22 @@ module Discovery = let private parseMachine (txt: ITxtRecord) = match parseFieldWith (|Machine|_|) txt with - | Some id -> id |> DiscoId.Parse |> Either.succeed + | Some id -> id |> DiscoId.Parse |> Result.succeed | _ -> "Could not find machine id in metatdata" |> Error.asParseError (tag "parseMachine") - |> Either.fail + |> Result.fail // ** parseProtocol let private parseProtocol (proto: AddressProtocol) = match proto with - | AddressProtocol.IPv4 -> Either.succeed IPv4 - | AddressProtocol.IPv6 -> Either.succeed IPv6 + | AddressProtocol.IPv4 -> Result.succeed IPv4 + | AddressProtocol.IPv6 -> Result.succeed IPv6 | x -> "AddressProtocol could not be parsed: " + string x |> Error.asParseError (tag "parseProtocol") - |> Either.fail + |> Result.fail // ** parseStatus @@ -632,14 +632,14 @@ module Discovery = let rawstatus = parseFieldWith (|Status|_|) record match rawstatus, rawid, rawname with - | Some MachineStatus.IDLE, _, _ -> Right Idle + | Some MachineStatus.IDLE, _, _ -> Ok Idle | Some MachineStatus.BUSY, Some id, Some parsed when not (isNull id) && not (isNull parsed) -> - Busy (DiscoId.Parse id, name parsed) |> Either.succeed + Busy (DiscoId.Parse id, name parsed) |> Result.succeed | _, _, _ -> "Failed to parse Machine status: field(s) missing or null" |> Error.asParseError (tag "parseStatus") - |> Either.fail + |> Result.fail // ** reservedField @@ -701,7 +701,7 @@ module Discovery = // ** toDiscoveredService let toDiscoveredService (service: IResolvableService) = - either { + result { let entry = service.HostEntry let! proto = parseProtocol service.AddressProtocol diff --git a/src/Disco/Disco/Core/Either.fs b/src/Disco/Disco/Core/Either.fs index 9463c940..96806040 100644 --- a/src/Disco/Disco/Core/Either.fs +++ b/src/Disco/Disco/Core/Either.fs @@ -9,74 +9,61 @@ namespace Disco.Core open System -// * Either Type - -// _____ _ _ _ -// | ____(_) |_| |__ ___ _ __ -// | _| | | __| '_ \ / _ \ '__| -// | |___| | |_| | | | __/ | -// |_____|_|\__|_| |_|\___|_| - -type Either<'err,'a> = - | Right of 'a - | Left of 'err - -// * Either Module +// * Result Module [] -[] -module Either = +module Result = // ** ofNullable // FB types are not modeled with nullables in JS #if FABLE_COMPILER let ofNullable (v: 'T) (er: string -> 'Err) = - Right v + Ok v #else let ofNullable (v: Nullable<'T>) (er: string -> 'Err) = if v.HasValue - then Right v.Value - else "Item has no value" |> er |> Left + then Ok v.Value + else "Item has no value" |> er |> Error #endif // ** succeed - /// ## lift a regular value into Either + /// ## lift a regular value into Result /// /// ### Signature: - /// - v: value to lift into Either + /// - v: value to lift into Result /// - /// Returns: Either<^err, ^t> - let succeed v = Right v + /// Returns: Result<^err, ^t> + let succeed v = Ok v // ** fail - /// ## lift an error value into Either + /// ## lift an error value into Result /// /// ### Signature: - /// - v: error to lift into Either + /// - v: error to lift into Result /// - /// Returns: Either<^err, ^t> - let fail v = Left v + /// Returns: Result<^err, ^t> + let fail v = Error v // ** isFail - /// ## Check if Either is a failure + /// ## Check if Result is a failure /// - /// Check passed value of type Either<^err, ^t> for being a failure. + /// Check passed value of type Result<^err, ^t> for being a failure. /// /// ### Signature: /// - value: value to be checked /// /// Returns: bool let isFail = function - | Left _ -> true + | Error _ -> true | _ -> false // ** isSuccess - /// ## Check if Either value is a success + /// ## Check if Result value is a success /// /// Check the passed value for being a success constructor.g /// @@ -85,175 +72,116 @@ module Either = /// /// Returns: bool let isSuccess = function - | Right _ -> true + | Ok _ -> true | _ -> false // ** get - /// ## Extract success value from Either wrapper type + /// ## Extract success value from Result wrapper type /// /// Extracts the result of a computation from the wrapper - /// type. Crashes hard if the constructor is a Left (failure). + /// type. Crashes hard if the constructor is a Error (failure). /// /// ### Signature: - /// - value: Either<^err,^t> to extract result from + /// - value: Result<^err,^t> to extract result from /// /// Returns: ^t let get = function - | Right result -> result - | Left error -> - failwithf "Either: cannot get result from failure: %A" error + | Ok result -> result + | Error error -> + failwithf "Result: cannot get result from failure: %A" error // ** error - /// ## Extract the embedded error value from an Either + /// ## Extract the embedded error value from an Result /// - /// Extracts the embedded error value from the passed Either + /// Extracts the embedded error value from the passed Result /// wrapper. Crashed hard if the constructor was actually a success. /// /// ### Signature: - /// - value: value of type Either<^err,^t> to extract error from + /// - value: value of type Result<^err,^t> to extract error from /// /// Returns: ^err let error = function - | Left error -> error - | Right _ -> - failwith "Either: cannot get error from regular result" + | Error error -> error + | Ok _ -> + failwith "Result: cannot get error from regular result" // ** iter - let inline iter< ^a, ^err >(f: ^a -> unit) (a: Either< ^err, ^a >) = + let inline iter< ^a, ^err >(f: ^a -> unit) (a: Result< ^a,^err >) = match a with - | Right value -> f value - | Left _ -> () + | Ok value -> f value + | Error _ -> () // ** iterError - let inline iterError< ^a, ^err >(f: ^err -> unit) (a: Either< ^err, ^a >) = - match a with - | Left error -> f error - | Right _ -> () - - // ** unwrap - - /// Gets the value if it's successful and runs the provided function otherwise - let inline unwrap< ^a, ^err > (fail: ^err -> ^a) (a: Either< ^err, ^a >) = - match a with - | Right value -> value - | Left err -> fail err - - // ** bind - - /// ## Bind a function to the result of a computation - /// - /// Inspects the passed value `a` and applies the function `f` to - /// the embedded value, *if* `a` was a `Right` (or success). Errors - /// are just passed through. - /// - /// ### Signature: - /// - `f`: function to apply to the embedded value of `a` - /// - `a`: value of type Either<^err, ^t> to apply `f` to - /// - /// Returns: Either<^err, ^t> - let inline bind< ^a, ^b, ^err > - (f: ^a -> Either< ^err, ^b >) - (a: Either< ^err, ^a >) - : Either< ^err, ^b > = + let inline iterError< ^a, ^err >(f: ^err -> unit) (a: Result< ^a, ^err >) = match a with - | Right value -> f value - | Left err -> Left err - - // ** map + | Error error -> f error + | Ok _ -> () - /// ## Map over an embedded value - /// - /// Applies a function `f` to the inner value of `a`, *if* `a` - /// indeed is a `Right`. - /// - /// ### Signature: - /// - `f`: function to apply to the inner value of `a` - /// - `a`: value to extract and apply `f` to - /// - /// Returns: Either<^err, ^t> - let inline map< ^a, ^b, ^err > - (f: ^a -> ^b) - (a: Either< ^err, ^a >) - : Either< ^err, ^b > = - match a with - | Right value -> f value |> succeed - | Left error -> Left error + // ** bindArray - let bindArray(f: 'a -> Either<'err,'b>) (arr:'a[]): Either<'err,'b[]> = + let bindArray(f: 'a -> Result<'b,'err>) (arr:'a[]): Result<'b[],'err> = let mutable i = 0 let mutable error = None let arr2 = Array.zeroCreate arr.Length while i < arr.Length && Option.isNone error do match f arr.[i] with - | Right value -> arr2.[i] <- value; i <- i + 1 - | Left err -> error <- Some err + | Ok value -> arr2.[i] <- value; i <- i + 1 + | Error err -> error <- Some err match error with - | Some err -> Left err - | None -> Right arr2 + | Some err -> Error err + | None -> Ok arr2 - // ** mapError + // ** unwrap - /// ## Map over the embedded error value - /// - /// Inspects the passed value `a` and applies the function `f`, *if* - /// `a` is a `Left`. - /// - /// ### Signature: - /// - `f`: function to apply to the inner error value - /// - `a`: value of type Either<^err,^t> - /// - /// Returns: Either<^err, ^t> - let inline mapError< ^a, ^err1, ^err2 > - (f: ^err1 -> ^err2) - (a: Either< ^err1, ^a >) - : Either< ^err2, ^a> = + /// Gets the value if it's successful and runs the provided function otherwise + let inline unwrap< ^a, ^err > (fail: ^err -> ^a) (a: Result< ^a,^err >) = match a with - | Right value -> Right value - | Left error -> Left(f error) + | Ok value -> value + | Error err -> fail err // ** combine let inline combine< ^a, ^b, ^err > (v1 : ^a) - (v2 : Either< ^err, ^b >) - : Either< ^err, (^a * ^b) > = + (v2 : Result< ^b,^err >) + : Result< (^a * ^b),^err > = match v2 with - | Right value2 -> succeed (v1, value2) - | Left err -> Left err + | Ok value2 -> succeed (v1, value2) + | Error err -> Error err // ** ofOption - /// ## Transform an Option value into an Either + /// ## Transform an Option value into a Result /// /// Converts the passed value of type `'t option` into an - /// Either<^err, ^t>. If the passed value is a `None`, use the - /// provided error value in the `Left`. + /// Result<^t,^err>. If the passed value is a `None`, use the + /// provided error value in the `Error`. /// /// ### Signature: /// - err: error value to use when `a` is `None` /// - `a`: value to convert /// - /// Returns: Either<^err,^t> + /// Returns: Result<^t,^err> let inline ofOption< ^a, ^b, ^err > (err: ^err) (a: ^a option) - : Either< ^err, ^a > = + : Result< ^a,^err > = match a with - | Some value -> Right value - | None -> Left err + | Some value -> Ok value + | None -> Error err // ** nothing - let inline nothing< ^err > : Either< ^err,unit > = + let inline nothing< ^err > : Result = succeed () // ** ignore - let inline ignore< ^err > _ : Either< ^err, unit > = + let inline ignore< ^err > _ : Result = succeed () // ** tryWith @@ -261,7 +189,7 @@ module Either = let inline tryWith< ^a, ^err > (err: (string -> ^err)) (f: unit -> ^a) - : Either< ^err, ^a > = + : Result< ^a, ^err > = try f() |> succeed with @@ -274,56 +202,48 @@ module Either = // ** orElse let inline orElse value = function - | Right _ as good -> good - | Left _ -> Right value + | Ok _ as good -> good + | Error _ -> Ok value // ** defaultValue let defaultValue def = function - | Right value -> value - | Left _ -> def - -// * Either Builder + | Ok value -> value + | Error _ -> def -// _____ _ _ _ ____ _ _ _ -// | ____(_) |_| |__ ___ _ __ | __ ) _ _(_) | __| | ___ _ __ -// | _| | | __| '_ \ / _ \ '__| | _ \| | | | | |/ _` |/ _ \ '__| -// | |___| | |_| | | | __/ | | |_) | |_| | | | (_| | __/ | -// |_____|_|\__|_| |_|\___|_| |____/ \__,_|_|_|\__,_|\___|_| +// * Result Builder [] -module EitherUtils = +module ResultUtils = - type EitherBuilder() = + type ResultBuilder() = - member self.Return(v: 'a): Either<'err, 'a> = Right v + member self.Return(v: 'a): Result<'a,'err> = Ok v - member self.ReturnFrom(v: Either<'err, 'a>): Either<'err, 'a> = v + member self.ReturnFrom(v: Result<'a,'err>): Result<'a,'err> = v - member self.Bind(m: Either<'err, 'a>, f: 'a -> Either<'err, 'b>): Either<'err, 'b> = - match m with - | Right value -> f value - | Left err -> Left err + member self.Bind(m: Result<'a,'err>, f: 'a -> Result<'b,'err>): Result<'b,'err> = + Result.bind f m - member self.Zero(): Either<'err, unit> = Right () + member self.Zero(): Result = Ok () - member self.Delay(f: unit -> Either<'err, 'a>) = f + member self.Delay(f: unit -> Result<'a,'err>) = f - member self.Run(f: unit -> Either<'err, 'a>) = f() + member self.Run(f: unit -> Result<'a,'err>) = f() - member self.While(guard: unit -> bool, body: unit -> Either<'err, unit>): Either<'err, unit> = + member self.While(guard: unit -> bool, body: unit -> Result): Result = if guard () then self.Bind(body(), fun () -> self.While(guard, body)) else self.Zero() - member self.For(sequence:seq<'a>, body: 'a -> Either<'err, unit>): Either<'err, unit> = + member self.For(sequence:seq<'a>, body: 'a -> Result): Result = self.Using(sequence.GetEnumerator(), fun enum -> self.While(enum.MoveNext, fun () -> body enum.Current)) member self.Combine(a, b) = match a with - | Right _ -> a - | Left _ -> b + | Ok _ -> a + | Error _ -> b member self.TryWith(body, handler) = try body() |> self.ReturnFrom @@ -336,17 +256,17 @@ module EitherUtils = handler () member self.Using<'a, 'b, 'err when 'a :> IDisposable> - (disposable: 'a, body: 'a -> Either<'err, 'b>): Either<'err, 'b> = + (disposable: 'a, body: 'a -> Result<'b,'err>): Result<'b,'err> = let body' = fun () -> body disposable self.TryFinally(body', fun () -> disposable.Dispose()) - let either = EitherBuilder() + let result = ResultBuilder() #if INTERACTIVE module Test = - open EitherUtils + open ResultUtils type DisposableAction(f) = interface IDisposable with @@ -360,15 +280,15 @@ module Test = let orFail x = match x with - | Left err -> printfn "ERROR: %O" err - | Right v -> printfn "OK: %O" v + | Error err -> printfn "ERROR: %O" err + | Ok v -> printfn "OK: %O" v let riskyOp x = printfn "Evaluating %O..." x - if x = 0 then Left "boom!" else Right () + if x = 0 then Error "boom!" else Ok () let test() = - let test = either { + let test = result { printfn "This should be lazy but it's evaluated eagerly" let ar = [|1;2;0;3|] let mutable i = 0 @@ -381,13 +301,13 @@ module Test = orFail test // No problem here - either { + result { for x in [1;2;3] do do! riskyOp x } |> orFail // Boom! - either { + result { for x in [|1;2;0;3|] do do! riskyOp x } |> orFail @@ -396,10 +316,10 @@ module Test = let isDisposed = ref false let step1ok = ref false let step2ok = ref false - let resource = either { + let resource = result { return new DisposableAction(fun () -> isDisposed := true) } - either { + result { use! r = resource step1ok := not !isDisposed } |> ignore @@ -434,4 +354,4 @@ module OptionUtils = member __.Run (f) = f() - let maybe = new MaybeBuilder() + let maybe = MaybeBuilder() diff --git a/src/Disco/Disco/Core/Error.fs b/src/Disco/Disco/Core/Error.fs index d39025d5..1c59decd 100644 --- a/src/Disco/Disco/Core/Error.fs +++ b/src/Disco/Disco/Core/Error.fs @@ -87,35 +87,35 @@ type DiscoError = static member FromFB (fb: ErrorFB) = match fb.Type with #if FABLE_COMPILER - | x when x = ErrorTypeFB.OKFB -> Right OK - | x when x = ErrorTypeFB.OtherFB -> Right (Other (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.GitErrorFB -> Right (GitError (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.ProjectErrorFB -> Right (ProjectError (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.AssetErrorFB -> Right (AssetError (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.RaftErrorFB -> Right (RaftError (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.ParseErrorFB -> Right (ParseError (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.SocketErrorFB -> Right (SocketError (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.ClientErrorFB -> Right (ClientError (fb.Location,fb.Message)) - | x when x = ErrorTypeFB.IOErrorFB -> Right (IOError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.OKFB -> Ok OK + | x when x = ErrorTypeFB.OtherFB -> Ok (Other (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.GitErrorFB -> Ok (GitError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.ProjectErrorFB -> Ok (ProjectError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.AssetErrorFB -> Ok (AssetError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.RaftErrorFB -> Ok (RaftError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.ParseErrorFB -> Ok (ParseError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.SocketErrorFB -> Ok (SocketError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.ClientErrorFB -> Ok (ClientError (fb.Location,fb.Message)) + | x when x = ErrorTypeFB.IOErrorFB -> Ok (IOError (fb.Location,fb.Message)) | x -> ("DiscoError.FromFB", sprintf "Could not parse unknown ErrorTypeFB: %A" x) |> ParseError - |> Either.fail + |> Result.fail #else - | ErrorTypeFB.OKFB -> Right OK - | ErrorTypeFB.OtherFB -> Right (Other (fb.Location,fb.Message)) - | ErrorTypeFB.GitErrorFB -> Right (GitError (fb.Location,fb.Message)) - | ErrorTypeFB.ProjectErrorFB -> Right (ProjectError (fb.Location,fb.Message)) - | ErrorTypeFB.AssetErrorFB -> Right (AssetError (fb.Location,fb.Message)) - | ErrorTypeFB.RaftErrorFB -> Right (RaftError (fb.Location,fb.Message)) - | ErrorTypeFB.ParseErrorFB -> Right (ParseError (fb.Location,fb.Message)) - | ErrorTypeFB.SocketErrorFB -> Right (SocketError (fb.Location,fb.Message)) - | ErrorTypeFB.ClientErrorFB -> Right (ClientError (fb.Location,fb.Message)) - | ErrorTypeFB.IOErrorFB -> Right (IOError (fb.Location,fb.Message)) + | ErrorTypeFB.OKFB -> Ok OK + | ErrorTypeFB.OtherFB -> Ok (Other (fb.Location,fb.Message)) + | ErrorTypeFB.GitErrorFB -> Ok (GitError (fb.Location,fb.Message)) + | ErrorTypeFB.ProjectErrorFB -> Ok (ProjectError (fb.Location,fb.Message)) + | ErrorTypeFB.AssetErrorFB -> Ok (AssetError (fb.Location,fb.Message)) + | ErrorTypeFB.RaftErrorFB -> Ok (RaftError (fb.Location,fb.Message)) + | ErrorTypeFB.ParseErrorFB -> Ok (ParseError (fb.Location,fb.Message)) + | ErrorTypeFB.SocketErrorFB -> Ok (SocketError (fb.Location,fb.Message)) + | ErrorTypeFB.ClientErrorFB -> Ok (ClientError (fb.Location,fb.Message)) + | ErrorTypeFB.IOErrorFB -> Ok (IOError (fb.Location,fb.Message)) | x -> ("DiscoError.FromFB", sprintf "Could not parse unknown ErrotTypeFB: %A" x) |> ParseError - |> Either.fail + |> Result.fail #endif // ** ToOffset @@ -167,6 +167,10 @@ type DiscoError = +// * DiscoResult + +type DiscoResult<'t> = Result<'t,DiscoError> + // * Error Module [] module Error = @@ -267,10 +271,10 @@ module Error = /// - `a`: value to apply function /// /// Returns: ^b - let inline orExit (f: ^a -> ^b) (a: Either< DiscoError, ^a>) : ^b = + let inline orExit (f: ^a -> ^b) (a: DiscoResult< ^a >) : ^b = match a with - | Right value -> f value - | Left error -> exitWith error + | Ok value -> f value + | Error error -> exitWith error let asGitError loc err = GitError(loc,err) let asProjectError loc err = ProjectError(loc,err) diff --git a/src/Disco/Disco/Core/FileSystem.fs b/src/Disco/Disco/Core/FileSystem.fs index 81a54e34..d1f9fbf3 100644 --- a/src/Disco/Disco/Core/FileSystem.fs +++ b/src/Disco/Disco/Core/FileSystem.fs @@ -94,20 +94,20 @@ type FsPath = // ** FromFB static member FromFB(fb: FsPathFB) = - either { + result { let! platform = Platform.FromFB fb.Platform let drive = Convert.ToChar fb.Drive let! elements = if fb.ElementsLength > 0 then Array.fold - (fun (lst:Either) idx -> either { + (fun (lst:DiscoResult) idx -> result { let! elms = lst let elm = fb.Elements idx return elm :: elms }) - (Right List.empty) + (Ok List.empty) [| 0 .. fb.ElementsLength - 1 |] - else Either.succeed List.empty + else Result.succeed List.empty return { Drive = drive Platform = platform @@ -121,7 +121,7 @@ type FsPath = // ** FromBytes - static member FromBytes (bytes: byte array) : Either = + static member FromBytes (bytes: byte array) : DiscoResult = bytes |> Binary.createBuffer |> FsPathFB.GetRootAsFsPathFB @@ -240,7 +240,7 @@ type FsEntry = // ** FromEntryFB static member FromEntryFB(fb: FsInfoFB) = - either { + result { let! path = #if FABLE_COMPILER FsPath.FromFB fb.Path @@ -252,7 +252,7 @@ type FsEntry = else "Cannot parse empty path value" |> Error.asParseError "FsTree.toEntry" - |> Either.fail + |> Result.fail #endif let info = { Path = path @@ -278,7 +278,7 @@ type FsEntry = other |> sprintf "%A is not a known FsEntry type" |> Error.asParseError "FsTree.toEntry" - |> Either.fail + |> Result.fail } // ** ToOffset @@ -307,7 +307,7 @@ type FsEntry = // ** FromFB static member FromFB(fb:FsEntryFB) = - either { + result { let! root = #if FABLE_COMPILER FsEntry.FromEntryFB fb.Root @@ -319,7 +319,7 @@ type FsEntry = else "Could not parse empty FsEntry root value" |> Error.asParseError "FsEntry.FromFB" - |> Either.fail + |> Result.fail #endif match root with @@ -328,7 +328,7 @@ type FsEntry = | FsEntry.Directory _ -> return! List.fold - (fun (m:Either) idx -> either { + (fun (m:DiscoResult) idx -> result { let! lst = m let! child = #if FABLE_COMPILER @@ -343,18 +343,18 @@ type FsEntry = else "Could not parse empty child value" |> Error.asParseError "FsEntry.FromFB" - |> Either.fail + |> Result.fail #endif return child :: lst }) - (Right List.empty) + (Ok List.empty) [ 0 .. fb.ChildrenLength - 1 ] - |> Either.map (List.rev >> FsEntry.inflate root) + |> Result.map (List.rev >> FsEntry.inflate root) } // ** FromBytes - static member FromBytes (bytes: byte array) : Either = + static member FromBytes (bytes: byte array) : DiscoResult = bytes |> Binary.createBuffer |> FsEntryFB.GetRootAsFsEntryFB @@ -433,7 +433,7 @@ type FsTree = // ** FromBytes - static member FromBytes (bytes: byte array) : Either = + static member FromBytes (bytes: byte array) : DiscoResult = bytes |> Binary.createBuffer |> FsTreeFB.GetRootAsFsTreeFB @@ -446,7 +446,7 @@ type FsTree = // ** FromFB static member FromFB(fb:FsTreeFB) = - either { + result { let! hostId = Id.decodeHostId fb let filters = fb.Filters.Split(' ') @@ -462,11 +462,11 @@ type FsTree = else "Could not parse empty root" |> Error.asParseError "FsTree.FromtFB" - |> Either.fail + |> Result.fail #endif let! children = Array.fold - (fun (m:Either) idx -> either { + (fun (m:DiscoResult) idx -> result { let! list = m let! child = #if FABLE_COMPILER @@ -481,11 +481,11 @@ type FsTree = else "Could not parse empty child" |> Error.asParseError "FsTree.FromFB" - |> Either.fail + |> Result.fail #endif return child :: list }) - (Right List.empty) + (Ok List.empty) [| 0 .. fb.ChildrenLength - 1 |] return children @@ -744,11 +744,11 @@ module File = path |> unwrap |> File.Delete - |> Either.succeed + |> Result.succeed with exn -> exn.Message |> Error.asIOError (tag "delete") - |> Either.fail + |> Result.fail // ** ensurePath @@ -757,11 +757,11 @@ module File = path |> Path.getDirectoryName |> Directory.createDirectory - |> Either.ignore + |> Result.ignore with exn -> exn.Message |> Error.asIOError (tag "ensurePath") - |> Either.fail + |> Result.fail #endif @@ -782,18 +782,18 @@ module Directory = /// Create a new directory. Upon failure, return an DiscoError /// /// FilePath - /// Either + /// DiscoResult let createDirectory (path: FilePath) = try path |> unwrap |> Directory.CreateDirectory - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asIOError (tag "createDirectory") - |> Either.fail + |> Result.fail // ** removeDirectory @@ -801,11 +801,11 @@ module Directory = try unwrap path |> Directory.Delete - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asIOError (tag "removeDirectory") - |> Either.fail + |> Result.fail // ** info @@ -921,8 +921,8 @@ module FileSystem = /// ### Signature: /// - path: FilePath to delete /// - /// Returns: Either - let rec rmDir (path: FilePath) : Either = + /// Returns: DiscoResult + let rec rmDir (path: FilePath) : DiscoResult = try let info = new FileInfo(unwrap path) info.IsReadOnly <- false @@ -930,28 +930,28 @@ module FileSystem = if (attrs &&& FileAttributes.Directory) = FileAttributes.Directory then let children = DirectoryInfo(unwrap path).EnumerateFileSystemInfos() if children.Count() > 0 then - either { + result { do! Seq.fold - (fun (_: Either) (child: FileSystemInfo) -> either { + (fun (_: DiscoResult) (child: FileSystemInfo) -> result { return! child.FullName |> filepath |> rmDir }) - (Right ()) + (Ok ()) children return Directory.Delete(unwrap path) } else Directory.Delete(unwrap path) - |> Either.succeed + |> Result.succeed else path |> unwrap |> File.Delete - |> Either.succeed + |> Result.succeed with | exn -> ("FileSystem.rmDir", exn.Message) |> IOError - |> Either.fail + |> Result.fail #endif @@ -995,7 +995,7 @@ module FileSystem = /// ### Signature: /// - path: FilePath /// - /// Returns: Either + /// Returns: DiscoResult let mkDir (path: FilePath) = try if path |> unwrap |> Directory.Exists |> not then @@ -1003,14 +1003,14 @@ module FileSystem = |> unwrap |> Directory.CreateDirectory |> ignore - |> Either.succeed + |> Result.succeed else - Either.succeed () + Result.succeed () with | exn -> ("FileSystem.mkDir", exn.Message) |> IOError - |> Either.fail + |> Result.fail #endif @@ -1026,9 +1026,9 @@ module FileSystem = /// - source: FilePath /// - target: FilePath /// - /// Returns: Either + /// Returns: DiscoResult - let rec copyDir (source: FilePath) (target: FilePath) : Either = + let rec copyDir (source: FilePath) (target: FilePath) : DiscoResult = try let source = Directory.info source @@ -1046,12 +1046,12 @@ module FileSystem = let destpath = filepath target.FullName filepath dir.Name copyDir (filepath dir.FullName) destpath |> ignore - Either.succeed () + Result.succeed () with | exn -> ("FileSystem.mkDir", exn.Message) |> IOError - |> Either.fail + |> Result.fail #endif @@ -1509,13 +1509,13 @@ module FsTree = basePath |> sprintf "%A was not found or is not a directory" |> Error.asAssetError "FsTree" - |> Either.fail - either { + |> Result.fail + result { let! root = if Directory.exists basePath then let path = FsPath.parse basePath match FsEntry.create path with - | Some root -> Right root + | Some root -> Ok root | None -> notFound() else notFound() return { @@ -1680,11 +1680,11 @@ module FsTree = |> List.choose id |> inflate host root |> setFilters filters - |> Either.succeed + |> Result.succeed | None -> "Could not parse root entry: does the directory exist?" |> Error.asIOError "FsTree.read" - |> Either.fail + |> Result.fail #endif @@ -1739,7 +1739,7 @@ module FsTreeTesting = fp |> File.readBytes |> Binary.decode - |> Either.get + |> Result.get let roundTrip dirCount fileCount = let fp = Path.getTempFile() diff --git a/src/Disco/Disco/Core/Git.fs b/src/Disco/Disco/Core/Git.fs index 6a9113c4..eee2f353 100644 --- a/src/Disco/Disco/Core/Git.fs +++ b/src/Disco/Disco/Core/Git.fs @@ -80,12 +80,12 @@ module Git = url |> Repository.ListRemoteReferences |> Seq.cast - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "lsRemote") - |> Either.fail + |> Result.fail // ** Branch module @@ -119,12 +119,12 @@ module Git = let create (name: string) (repo: Repository) = try repo.CreateBranch(name) - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "create") - |> Either.fail + |> Result.fail // *** current @@ -147,14 +147,14 @@ module Git = /// ### Signature: /// - branch: Branch /// - /// Returns: Either - let tracked (branch: Branch) : Either = + /// Returns: Result + let tracked (branch: Branch) : DiscoResult = match branch.TrackedBranch with | null -> "No tracked branch" |> Error.asGitError (tag "tracked") - |> Either.fail - | branch -> Either.succeed branch + |> Result.fail + | branch -> Result.succeed branch // *** tracking @@ -166,13 +166,13 @@ module Git = /// - branch: Branch to get details for /// /// Returns: BranchTrackingDetails option - let tracking (branch: Branch) : Either = + let tracking (branch: Branch) : DiscoResult = match branch.TrackingDetails with | null -> "No tracked branch" |> Error.asGitError (tag "tracking") - |> Either.fail - | details -> Either.succeed details + |> Result.fail + | details -> Result.succeed details // *** tip @@ -310,7 +310,7 @@ module Git = /// - remote: string /// - upstream: string /// - /// Returns: Either + /// Returns: DiscoResult let setTracked (repo: Repository) (branch: Branch) (remote: Remote) = try @@ -318,12 +318,12 @@ module Git = updater.Remote <- remote.Name updater.UpstreamBranch <- branch.CanonicalName repo.Branches.Update (branch, setRemote) - |> Either.ignore + |> Result.ignore with | exn -> exn.Message |> Error.asGitError (tag "setTracked") - |> Either.fail + |> Result.fail // ** Repo @@ -396,12 +396,12 @@ module Git = let setReceivePackConfig (repo: Repository) = try repo.Config.Set("receive.denyCurrentBranch", "updateInstead") - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "setReceivePackConfig") - |> Either.fail + |> Result.fail #endif @@ -415,10 +415,10 @@ module Git = /// - target: FilePath to target directory /// - remote: string specifiying the remote repository address /// - /// Returns: Either + /// Returns: DiscoResult let clone (target: FilePath) (remote: string) = try - either { + result { let path = Repository.Clone(remote, unwrap target) let repo = new Repository(path) do! setReceivePackConfig repo @@ -427,7 +427,7 @@ module Git = | exn -> exn.Message |> Error.asGitError (tag "clone") - |> Either.fail + |> Result.fail // *** branches @@ -484,12 +484,12 @@ module Git = let reset (opts: ResetMode) (repo: Repository) = try repo.Reset opts - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "reset") - |> Either.fail + |> Result.fail // *** resetTo @@ -506,12 +506,12 @@ module Git = let resetTo (opts: ResetMode) (commit: Commit) (repo: Repository) = try repo.Reset(opts, commit) - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "resetTo") - |> Either.fail + |> Result.fail // *** clean @@ -628,8 +628,8 @@ module Git = spec |> String.format "{0} not found" |> Error.asGitError (tag "checkout") - |> Either.fail - | branch -> Either.succeed branch + |> Result.fail + | branch -> Result.succeed branch // *** repository @@ -641,7 +641,7 @@ module Git = /// - path: FilePath to search for the .git folder /// /// Returns: Repository option - let repository (path: FilePath) : Either = + let repository (path: FilePath) : DiscoResult = try let normalized = if Path.endsWith ".git" path then @@ -650,17 +650,17 @@ module Git = path filepath ".git" new Repository(unwrap normalized) - |> Either.succeed + |> Result.succeed with | :? RepositoryNotFoundException as exn -> exn.Message |> String.format (unwrap path + ": {0}") |> Error.asGitError (tag "repository") - |> Either.fail + |> Result.fail | exn -> exn.Message |> Error.asGitError (tag "repository") - |> Either.fail + |> Result.fail // *** init @@ -671,7 +671,7 @@ module Git = /// ### Signature: /// - path: FilePath pointing to the target directory /// - /// Returns: Either,Repository> + /// Returns: DiscoResult let init (path: FilePath) = try Path.map Repository.Init path |> ignore @@ -680,7 +680,7 @@ module Git = | exn -> exn.Message |> Error.asGitError (tag "init") - |> Either.fail + |> Result.fail // *** add @@ -690,18 +690,18 @@ module Git = path |> String.format "Path must be relative to the project root: {0}" |> Error.asGitError (tag "add") - |> Either.fail + |> Result.fail else if File.exists path || Directory.exists path then runGit repo.Info.WorkingDirectory "add" "." "" - |> Either.ignore + |> Result.ignore else - Either.succeed () + Result.succeed () with | exn -> exn.Message |> Error.asGitError (tag "add") - |> Either.fail + |> Result.fail // *** stage @@ -709,17 +709,17 @@ module Git = try if Path.isPathRooted path && not (repo.Ignore.IsPathIgnored (unwrap path))then runGit repo.Info.WorkingDirectory "stage" "." "" - |> Either.ignore + |> Result.ignore else path |> String.format "Paths must be absolute: {0}" |> Error.asGitError (tag "stage") - |> Either.fail + |> Result.fail with | exn -> exn.Message |> Error.asGitError (tag "stage") - |> Either.fail + |> Result.fail // *** stageAll @@ -731,24 +731,24 @@ module Git = try repo.RetrieveStatus() |> Seq.iter _stage - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "stageAll") - |> Either.fail + |> Result.fail // *** commit let commit (repo: Repository) (msg: string) (committer: Signature) = try repo.Commit(msg, committer, committer) - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "commit") - |> Either.fail + |> Result.fail // *** status @@ -760,15 +760,15 @@ module Git = /// - repo: Repository to fetch status for /// /// Returns: RepositoryStatus - let status (repo: Repository) : Either = + let status (repo: Repository) : DiscoResult = try repo.RetrieveStatus() - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "status") - |> Either.fail + |> Result.fail // *** isDirty @@ -780,8 +780,8 @@ module Git = /// - repo: Repository to check /// /// Returns: boolean - let isDirty (repo: Repository) : Either = - either { + let isDirty (repo: Repository) : DiscoResult = + result { let! status = status repo return status.IsDirty } @@ -796,8 +796,8 @@ module Git = /// - repo: Repository /// /// Returns: seq - let untracked (repo: Repository) : Either> = - either { + let untracked (repo: Repository) : DiscoResult> = + result { let! status = status repo return status.Untracked } @@ -827,15 +827,15 @@ module Git = /// - t: IQueryableCommitLog /// /// Returns: Commit - let elementAt (idx: int) (t: IQueryableCommitLog) : Either = + let elementAt (idx: int) (t: IQueryableCommitLog) : DiscoResult = try t.ElementAt(idx) - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "elementAt") - |> Either.fail + |> Result.fail // *** commitCount @@ -859,12 +859,12 @@ module Git = let basepath = Path.GetDirectoryName repo.Info.Path branch.FriendlyName |> runGit basepath "push" remote.Name - |> Either.ignore + |> Result.ignore with | exn -> exn.Message |> Error.asGitError (tag "push") - |> Either.fail + |> Result.fail // *** pull @@ -876,11 +876,11 @@ module Git = /// - repo: Repository /// - remote: string /// - /// Returns: Either + /// Returns: DiscoResult let pull (repo: Repository) (signature: Signature) = try - either { + result { let options = let fopts = FetchOptions() let popts = PullOptions() @@ -896,7 +896,7 @@ module Git = | exn -> exn.Message |> Error.asGitError (tag "pull") - |> Either.fail + |> Result.fail // *** lsRemote @@ -905,12 +905,12 @@ module Git = remote |> repo.Network.ListReferences |> Seq.cast - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "lsRemote") - |> Either.fail + |> Result.fail // ** Config @@ -946,12 +946,12 @@ module Git = let addRemote (repo: Repository) (name: string) (url: Url) = try repo.Network.Remotes.Add(name, unwrap url) - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "addRemote") - |> Either.fail + |> Result.fail // *** updateRemote @@ -961,18 +961,18 @@ module Git = updater.Url <- unwrap url repo.Network.Remotes.Update(remote.Name, update) repo.Network.Remotes.[remote.Name] - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asGitError (tag "updateRemote") - |> Either.fail + |> Result.fail // *** delRemote - let delRemote (repo: Repository) (name: string) : Either = + let delRemote (repo: Repository) (name: string) : DiscoResult = repo.Network.Remotes.Remove name - |> Either.succeed + |> Result.succeed #endif @@ -1031,6 +1031,6 @@ repo.Network.Fetch("git@bitbucket.org:krgn/meh.git", ["master"], "hello") Commands.Pull(repo, User.Admin.Signature, options) -repo.Network.Push(fix_issue |> Either.get) +repo.Network.Push(fix_issue |> Result.get) #endif diff --git a/src/Disco/Disco/Core/Id.fs b/src/Disco/Disco/Core/Id.fs index ad4908ff..278160c9 100644 --- a/src/Disco/Disco/Core/Id.fs +++ b/src/Disco/Disco/Core/Id.fs @@ -56,11 +56,11 @@ type DiscoId = // ** TryParse static member TryParse (str: string) = - try DiscoId.Parse str |> Either.succeed + try DiscoId.Parse str |> Result.succeed with exn -> exn.Message |> Error.asParseError "DiscoId" - |> Either.fail + |> Result.fail // ** FromGuid @@ -127,7 +127,7 @@ module Id = [| 0 .. 15 |] |> Array.map t |> DiscoId.FromByteArray - |> Either.succeed + |> Result.succeed let inline decodeId (fb: ^t) = (fun idx -> (^t : (member Id: int -> byte) fb, idx)) diff --git a/src/Disco/Disco/Core/IpAddress.fs b/src/Disco/Disco/Core/IpAddress.fs index 727e4832..0bdf8de8 100644 --- a/src/Disco/Disco/Core/IpAddress.fs +++ b/src/Disco/Disco/Core/IpAddress.fs @@ -57,28 +57,28 @@ type IpAddress = #if FABLE_COMPILER try IpAddress.Parse str - |> Either.succeed + |> Result.succeed with | exn -> sprintf "Unable to parse IP: %s Cause: %s" str exn.Message |> Disco.Core.Error.asParseError "IpAddress.Parse" - |> Either.fail + |> Result.fail #else try let ip = IPAddress.Parse(str) match ip.AddressFamily with - | Sockets.AddressFamily.InterNetwork -> IPv4Address str |> Right - | Sockets.AddressFamily.InterNetworkV6 -> IPv6Address str |> Right + | Sockets.AddressFamily.InterNetwork -> IPv4Address str |> Ok + | Sockets.AddressFamily.InterNetworkV6 -> IPv6Address str |> Ok | fam -> sprintf "Unable to parse IP: %s Unsupported AddressFamily: %A" str fam |> Error.asParseError "IpAddress.Parse" - |> Either.fail + |> Result.fail with | exn -> sprintf "Unable to parse IP: %s Cause: %s" str exn.Message |> Error.asParseError "IpAddress.Parse" - |> Either.fail + |> Result.fail #endif // ** ofIPAddress diff --git a/src/Disco/Disco/Core/LogLevel.fs b/src/Disco/Disco/Core/LogLevel.fs index eb2ae3d5..46ec5efe 100644 --- a/src/Disco/Disco/Core/LogLevel.fs +++ b/src/Disco/Disco/Core/LogLevel.fs @@ -34,7 +34,7 @@ type LogLevel = | _ -> failwithf "could not parse %s" str static member TryParse (str: string) = - Either.tryWith ParseError "LogLevel" <| fun _ -> + Result.tryWith ParseError "LogLevel" <| fun _ -> str |> LogLevel.Parse override self.ToString() = diff --git a/src/Disco/Disco/Core/Logging.fs b/src/Disco/Disco/Core/Logging.fs index 0e2ad09f..5eb473c5 100644 --- a/src/Disco/Disco/Core/Logging.fs +++ b/src/Disco/Disco/Core/Logging.fs @@ -58,7 +58,7 @@ type LogLevel = // ** TryParse static member TryParse (str: string) = - Either.tryWith (Error.asParseError "LogLevel.TryParse") <| fun _ -> + Result.tryWith (Error.asParseError "LogLevel.TryParse") <| fun _ -> str |> LogLevel.Parse // ** ToString @@ -108,7 +108,7 @@ type Tier = // ** TryParse static member TryParse (str: string) = - Either.tryWith (Error.asParseError "Tier.TryParse") <| fun _ -> + Result.tryWith (Error.asParseError "Tier.TryParse") <| fun _ -> str |> Tier.Parse // * LogEventYaml @@ -192,7 +192,7 @@ type LogEvent = // ** FromFB - static member FromFB(fb: LogEventFB) = either { + static member FromFB(fb: LogEventFB) = result { let! id = Id.decodeMachineId fb let! tier = Tier.TryParse fb.Tier let! level = LogLevel.TryParse fb.LogLevel @@ -230,8 +230,8 @@ type LogEvent = // ** FromYaml - static member FromYaml(yaml: LogEventYaml) : Either = - either { + static member FromYaml(yaml: LogEventYaml) : DiscoResult = + result { let! id = DiscoId.TryParse yaml.MachineId let! level = LogLevel.TryParse yaml.LogLevel let! tier = Tier.TryParse yaml.Tier @@ -577,24 +577,24 @@ module LogFile = log |> string |> file.Stream.WriteLine - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asIOError (tag "write") - |> Either.fail + |> Result.fail // ** create let create (machine: MachineId) (path: FilePath) = - either { + result { try let ts = DateTime.Now let fn = String.Format("disco-{0}-{1:yyyy-MM-dd_hh-mm-ss-tt}.log", machine.Prefix(), ts) do! if Directory.exists path |> not then Directory.createDirectory path - |> Either.ignore - else Either.succeed () + |> Result.ignore + else Result.succeed () let fp = Path.Combine(unwrap path, fn) let writer = File.AppendText fp writer.AutoFlush <- true @@ -607,7 +607,7 @@ module LogFile = return! exn.Message |> Error.asIOError (tag "create") - |> Either.fail + |> Result.fail } #endif diff --git a/src/Disco/Disco/Core/Machine.fs b/src/Disco/Disco/Core/Machine.fs index 42fbb4e6..4c4f9b41 100644 --- a/src/Disco/Disco/Core/Machine.fs +++ b/src/Disco/Disco/Core/Machine.fs @@ -165,7 +165,7 @@ type DiscoMachine = // ** FromFB static member FromFB (fb: DiscoMachineFB) = - either { + result { let! machineId = Id.decodeMachineId fb let! ip = IpAddress.TryParse fb.BindAddress let! metricsHost = IpAddress.TryParse fb.MetricsHost @@ -334,28 +334,28 @@ module MachineStatus = static member FromFB(fb: MachineStatusFB) = #if FABLE_COMPILER match fb.Status with - | x when x = MachineStatusEnumFB.IdleFB -> Either.succeed Idle + | x when x = MachineStatusEnumFB.IdleFB -> Result.succeed Idle | x when x = MachineStatusEnumFB.BusyFB -> - either { + result { let! id = Id.decodeProjectId fb return Busy (id, name fb.ProjectName) } | other -> sprintf "Unknown Machine Status: %d" other |> Error.asParseError "MachineStatus.FromOffset" - |> Either.fail + |> Result.fail #else match fb.Status with - | MachineStatusEnumFB.IdleFB -> Either.succeed Idle + | MachineStatusEnumFB.IdleFB -> Result.succeed Idle | MachineStatusEnumFB.BusyFB -> - either { + result { let! id = Id.decodeProjectId fb return Busy (id, name fb.ProjectName) } | other -> sprintf "Unknown Machine Status: %O" other |> Error.asParseError "MachineStatus.FromOffset" - |> Either.fail + |> Result.fail #endif // *** ToBytes @@ -452,8 +452,8 @@ module MachineConfig = // ** parse - let private parse (yml: DiscoMachineYaml) : Either = - either { + let private parse (yml: DiscoMachineYaml) : DiscoResult = + result { let! ip = IpAddress.TryParse yml.BindAddress let! metricsHost = IpAddress.TryParse yml.MetricsHost let! id = DiscoId.TryParse yml.MachineId @@ -556,7 +556,7 @@ module MachineConfig = // ** save - let save (path: FilePath option) (cfg: DiscoMachine) : Either = + let save (path: FilePath option) (cfg: DiscoMachine) : DiscoResult = let serializer = Serializer() try @@ -573,12 +573,12 @@ module MachineConfig = |> ensureExists File.WriteAllText(unwrap location, payload) - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asIOError (tag "save") - |> Either.fail + |> Result.fail // ** load @@ -594,16 +594,16 @@ module MachineConfig = else "could not find machine configuration" |> Error.asIOError (tag "load") - |> Either.fail + |> Result.fail with exn -> exn.Message |> Error.asIOError (tag "load") - |> Either.fail + |> Result.fail // ** init /// Attention: this method must be called only when starting the main process - let init getBindIp shiftDefaults (path: FilePath option) : Either = + let init getBindIp shiftDefaults (path: FilePath option) : DiscoResult = let serializer = Serializer() try let location = getLocation path @@ -617,11 +617,11 @@ module MachineConfig = let bindIp = getBindIp() let cfg = create bindIp shiftDefaults save path cfg - |> Either.map (fun _ -> cfg) + |> Result.map (fun _ -> cfg) match cfg with - | Left err -> Either.fail err - | Right cfg -> + | Error err -> Result.fail err + | Ok cfg -> if Path.IsPathRooted (unwrap cfg.WorkSpace) then singleton <- cfg else @@ -631,12 +631,12 @@ module MachineConfig = |> filepath cfg.WorkSpace singleton <- { cfg with WorkSpace = wp } - Either.succeed() + Result.succeed() with | exn -> exn.Message |> Error.asIOError (tag "load") - |> Either.fail + |> Result.fail #endif diff --git a/src/Disco/Disco/Core/Metrics.fs b/src/Disco/Disco/Core/Metrics.fs index d3b2154e..a4246799 100644 --- a/src/Disco/Disco/Core/Metrics.fs +++ b/src/Disco/Disco/Core/Metrics.fs @@ -23,11 +23,11 @@ module Metrics = .WriteTo.InfluxDB(url, config.MetricsDb) .CreateCollector() - let init (config: DiscoMachine): Either = + let init (config: DiscoMachine): DiscoResult = try if config.CollectMetrics then match agent with - | Some _ -> Either.nothing + | Some _ -> Result.nothing | None -> let collector = createCollector config let actor = ThreadActor.create "Metrics" (fun _ (name,value) -> @@ -36,12 +36,12 @@ module Metrics = do collector.Write(name, values)) actor.Start() agent <- Some actor - Either.nothing - else Either.nothing + Result.nothing + else Result.nothing with exn -> exn.Message |> Error.asIOError "Metrics.init" - |> Either.fail + |> Result.fail let collect (name: string) (value: obj) : unit = match agent with diff --git a/src/Disco/Disco/Core/Network.fs b/src/Disco/Disco/Core/Network.fs index 48e421ad..1e3f1c24 100644 --- a/src/Disco/Disco/Core/Network.fs +++ b/src/Disco/Disco/Core/Network.fs @@ -130,13 +130,13 @@ module Network = List.fold (fun result (iface: NetworkInterface) -> match result with - | Right () -> result - | Left _ -> + | Ok () -> result + | Error _ -> if List.contains ip iface.IpAddresses then - Either.succeed () + Result.succeed () else result) - (Left (Error.asSocketError (tag "checkIpAddress") msg)) + (Error (Error.asSocketError (tag "checkIpAddress") msg)) ifaces // ** ensureIpAddress @@ -160,7 +160,7 @@ module Network = // ** ensureAvailability let ensureAvailability (ip: IpAddress) (port: Port) = - either { + result { try use socket = new Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) let endpoint = IPEndPoint(ip.toIPAddress(), int port) @@ -174,7 +174,7 @@ module Network = port |> sprintf "Address %O:%O already in use" ip |> Error.asSocketError (tag "ensureAvailability") - |> Either.fail + |> Result.fail } #endif diff --git a/src/Disco/Disco/Core/Pin.fs b/src/Disco/Disco/Core/Pin.fs index c441d90a..b779f80b 100644 --- a/src/Disco/Disco/Core/Pin.fs +++ b/src/Disco/Disco/Core/Pin.fs @@ -63,16 +63,16 @@ type Behavior = static member TryParse (str: string) = match String.toLower str with - | "string" | "simple" -> Right Simple - | "multiline" -> Right MultiLine - | "filename" -> Right FileName - | "directory" -> Right Directory - | "url" -> Right Url - | "ip" -> Right IP + | "string" | "simple" -> Ok Simple + | "multiline" -> Ok MultiLine + | "filename" -> Ok FileName + | "directory" -> Ok Directory + | "url" -> Ok Url + | "ip" -> Ok IP | _ -> sprintf "Invalid Behavior value: %s" str |> Error.asParseError "Behavior.TryParse" - |> Either.fail + |> Result.fail // ** ToString @@ -97,30 +97,30 @@ type Behavior = static member FromFB (fb: BehaviorFB) = #if FABLE_COMPILER match fb with - | x when x = BehaviorFB.SimpleFB -> Right Simple - | x when x = BehaviorFB.MultiLineFB -> Right MultiLine - | x when x = BehaviorFB.FileNameFB -> Right FileName - | x when x = BehaviorFB.DirectoryFB -> Right Directory - | x when x = BehaviorFB.UrlFB -> Right Url - | x when x = BehaviorFB.IPFB -> Right IP + | x when x = BehaviorFB.SimpleFB -> Ok Simple + | x when x = BehaviorFB.MultiLineFB -> Ok MultiLine + | x when x = BehaviorFB.FileNameFB -> Ok FileName + | x when x = BehaviorFB.DirectoryFB -> Ok Directory + | x when x = BehaviorFB.UrlFB -> Ok Url + | x when x = BehaviorFB.IPFB -> Ok IP | x -> sprintf "Cannot parse Behavior. Unknown type: %A" x |> Error.asParseError "Behavior.FromFB" - |> Either.fail + |> Result.fail #else match fb with - | BehaviorFB.SimpleFB -> Right Simple - | BehaviorFB.MultiLineFB -> Right MultiLine - | BehaviorFB.FileNameFB -> Right FileName - | BehaviorFB.DirectoryFB -> Right Directory - | BehaviorFB.UrlFB -> Right Url - | BehaviorFB.IPFB -> Right IP + | BehaviorFB.SimpleFB -> Ok Simple + | BehaviorFB.MultiLineFB -> Ok MultiLine + | BehaviorFB.FileNameFB -> Ok FileName + | BehaviorFB.DirectoryFB -> Ok Directory + | BehaviorFB.UrlFB -> Ok Url + | BehaviorFB.IPFB -> Ok IP | x -> sprintf "Cannot parse Behavior. Unknown type: %A" x |> Error.asParseError "Behavior.FromFB" - |> Either.fail + |> Result.fail #endif @@ -177,12 +177,12 @@ type PinConfiguration = try str |> PinConfiguration.Parse - |> Either.succeed + |> Result.succeed with | x -> x.Message |> Error.asParseError "PinConfiguration.TryParse" - |> Either.fail + |> Result.fail // ** ToOffset @@ -197,22 +197,22 @@ type PinConfiguration = static member FromFB(fb: PinConfigurationFB) = #if FABLE_COMPILER match fb with - | x when x = PinConfigurationFB.SinkFB -> Right Sink - | x when x = PinConfigurationFB.SourceFB -> Right Source - | x when x = PinConfigurationFB.PresetFB -> Right Preset + | x when x = PinConfigurationFB.SinkFB -> Ok Sink + | x when x = PinConfigurationFB.SourceFB -> Ok Source + | x when x = PinConfigurationFB.PresetFB -> Ok Preset | x -> sprintf "Unknown PinConfigurationFB value: %A" x |> Error.asParseError "PinConfiguration.FromFB" - |> Either.fail + |> Result.fail #else match fb with - | PinConfigurationFB.SinkFB -> Right Sink - | PinConfigurationFB.SourceFB -> Right Source - | PinConfigurationFB.PresetFB -> Right Preset + | PinConfigurationFB.SinkFB -> Ok Sink + | PinConfigurationFB.SourceFB -> Ok Source + | PinConfigurationFB.PresetFB -> Ok Preset | x -> sprintf "Unknown PinConfigurationFB value: %A" x |> Error.asParseError "PinConfiguration.FromFB" - |> Either.fail + |> Result.fail #endif // * VecSize @@ -256,12 +256,12 @@ type VecSize = try str |> VecSize.Parse - |> Either.succeed + |> Result.succeed with | x -> x.Message |> Error.asParseError "VecSize.TryParse" - |> Either.fail + |> Result.fail // ** ToOffset @@ -282,21 +282,21 @@ type VecSize = static member FromFB(fb: VecSizeFB) = #if FABLE_COMPILER match fb.Type with - | x when x = VecSizeTypeFB.DynamicFB -> Right Dynamic + | x when x = VecSizeTypeFB.DynamicFB -> Ok Dynamic | x when x = VecSizeTypeFB.FixedFB -> - Right (Fixed fb.Size) + Ok (Fixed fb.Size) | x -> sprintf "Unknown VecSizeFB value: %A" x |> Error.asParseError "VecSize.FromFB" - |> Either.fail + |> Result.fail #else match fb.Type with - | VecSizeTypeFB.DynamicFB -> Right Dynamic - | VecSizeTypeFB.FixedFB -> Right (Fixed fb.Size) + | VecSizeTypeFB.DynamicFB -> Ok Dynamic + | VecSizeTypeFB.FixedFB -> Ok (Fixed fb.Size) | x -> sprintf "Unknown PinConfigurationFB value: %A" x |> Error.asParseError "PinConfiguration.FromFB" - |> Either.fail + |> Result.fail #endif // * Pin @@ -506,49 +506,49 @@ type Pin = // ** FromFB - static member FromFB(fb: PinFB) : Either = + static member FromFB(fb: PinFB) : DiscoResult = #if FABLE_COMPILER match fb.PinType with | x when x = PinTypeFB.StringPinFB -> StringPinFB.Create() |> fb.Pin |> StringPinD.FromFB - |> Either.map StringPin + |> Result.map StringPin | x when x = PinTypeFB.NumberPinFB -> NumberPinFB.Create() |> fb.Pin |> NumberPinD.FromFB - |> Either.map NumberPin + |> Result.map NumberPin | x when x = PinTypeFB.BoolPinFB -> BoolPinFB.Create() |> fb.Pin |> BoolPinD.FromFB - |> Either.map BoolPin + |> Result.map BoolPin | x when x = PinTypeFB.BytePinFB -> BytePinFB.Create() |> fb.Pin |> BytePinD.FromFB - |> Either.map BytePin + |> Result.map BytePin | x when x = PinTypeFB.EnumPinFB -> EnumPinFB.Create() |> fb.Pin |> EnumPinD.FromFB - |> Either.map EnumPin + |> Result.map EnumPin | x when x = PinTypeFB.ColorPinFB -> ColorPinFB.Create() |> fb.Pin |> ColorPinD.FromFB - |> Either.map ColorPin + |> Result.map ColorPin | x -> sprintf "%A is not a valid PinTypeFB" x |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail #else @@ -558,71 +558,71 @@ type Pin = if v.HasValue then v.Value |> StringPinD.FromFB - |> Either.map StringPin + |> Result.map StringPin else "StringPinFB has no value" |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail | PinTypeFB.NumberPinFB -> let v = fb.Pin() if v.HasValue then v.Value |> NumberPinD.FromFB - |> Either.map NumberPin + |> Result.map NumberPin else "NumberPinFB has no value" |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail | PinTypeFB.BoolPinFB -> let v = fb.Pin() if v.HasValue then v.Value |> BoolPinD.FromFB - |> Either.map BoolPin + |> Result.map BoolPin else "BoolPinFB has no value" |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail | PinTypeFB.BytePinFB -> let v = fb.Pin() if v.HasValue then v.Value |> BytePinD.FromFB - |> Either.map BytePin + |> Result.map BytePin else "BytePinFB has no value" |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail | PinTypeFB.EnumPinFB -> let v = fb.Pin() if v.HasValue then v.Value |> EnumPinD.FromFB - |> Either.map EnumPin + |> Result.map EnumPin else "EnumPinFB has no value" |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail | PinTypeFB.ColorPinFB -> let v = fb.Pin() if v.HasValue then v.Value |> ColorPinD.FromFB - |> Either.map ColorPin + |> Result.map ColorPin else "ColorPinFB has no value" |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail | x -> sprintf "PinTypeFB not recognized: %A" x |> Error.asParseError "PinFB.FromFB" - |> Either.fail + |> Result.fail #endif @@ -632,7 +632,7 @@ type Pin = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> PinFB.GetRootAsPinFB |> Pin.FromFB @@ -666,63 +666,64 @@ module Pin = #if FABLE_COMPILER - let inline parseComplexValues< ^a, ^b, ^t when ^t : (static member FromFB : ^a -> Either) + let inline parseComplexValues< ^a, ^b, ^t when ^t : (static member FromFB : ^a -> DiscoResult< ^t>) and ^b : (member ValuesLength : int) and ^b : (member Values : int -> ^a)> (fb: ^b) - : Either = + : DiscoResult< ^t array> = let len = (^b : (member ValuesLength : int) fb) let arr = Array.zeroCreate len Array.fold - (fun (result: Either) _ -> either { - - let! (i, slices) = result + (fun (res: DiscoResult) _ -> + result { + let! (i, slices) = res // In Javascript, Flatbuffer types are not modeled as nullables, // hence parsing code is much simpler let! slice = let value = (^b : (member Values : int -> ^a) (fb, i)) - (^t : (static member FromFB : ^a -> Either) value) + (^t : (static member FromFB : ^a -> DiscoResult< ^t>) value) // add the slice to the array> at its correct position slices.[i] <- slice return (i + 1, slices) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd #else - let inline parseComplexValues< ^a, ^b, ^t when ^t : (static member FromFB : ^a -> Either) + let inline parseComplexValues< ^a, ^b, ^t when ^t : (static member FromFB : ^a -> DiscoResult< ^t>) and ^b : (member ValuesLength : int) and ^b : (member Values : int -> Nullable< ^a >)> (fb: ^b) - : Either = + : DiscoResult< ^t array> = let len = (^b : (member ValuesLength : int) fb) let arr = Array.zeroCreate len Array.fold - (fun (result: Either) _ -> either { - let! (i, slices) = result + (fun (res: DiscoResult) _ -> + result { + let! (i, slices) = res // In .NET, Flatbuffers are modelled with nullables, hence // parsing is slightly more elaborate let! slice = let value = (^b : (member Values : int -> Nullable< ^a >) (fb, i)) if value.HasValue then - (^t : (static member FromFB : ^a -> Either) value.Value) + (^t : (static member FromFB : ^a -> DiscoResult< ^t>) value.Value) else "Could not parse empty slice" |> Error.asParseError (sprintf "ParseSlices of %s" (typeof< ^t >).Name) - |> Either.fail + |> Result.fail // add the slice to the array> at its correct position slices.[i] <- slice return (i + 1, slices) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd #endif @@ -733,37 +734,35 @@ module Pin = let inline parseSimpleValues< ^a, ^b when ^b : (member ValuesLength : int) and ^b : (member Values : int -> ^a)> (fb: ^b) - : Either = + : DiscoResult< ^a array> = let len = (^b : (member ValuesLength : int) fb) let arr = Array.zeroCreate len Array.fold - (fun (result: Either) _ -> either { - - let! (i, slices) = result - + (fun (res: DiscoResult) _ -> + result { + let! (i, slices) = res // In Javascript, Flatbuffer types are not modeled as nullables, // hence parsing code is much simpler let slice = (^b : (member Values : int -> ^a) (fb, i)) - // add the slice to the array> at its correct position slices.[i] <- slice return (i + 1, slices) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd #else let inline parseSimpleValues< ^a, ^b when ^b : (member ValuesLength : int) and ^b : (member Values : int -> ^a)> (fb: ^b) - : Either = + : DiscoResult< ^a array> = let len = (^b : (member ValuesLength : int) fb) let arr = Array.zeroCreate len Array.fold - (fun (result: Either) _ -> either { - let! (i, slices) = result + (fun (res: DiscoResult) _ -> result { + let! (i, slices) = res // In .NET, Flatbuffers are modelled with nullables, hence // parsing is slightly more elaborate @@ -775,9 +774,9 @@ module Pin = slices.[i] <- slice return (i + 1, slices) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd #endif @@ -796,7 +795,7 @@ module Pin = else "Cannot parse empty VecSize" |> Error.asParseError "VecSize.FromFB" - |> Either.fail + |> Result.fail #endif // ** parseLabels @@ -805,21 +804,21 @@ module Pin = let inline parseLabels< ^a when ^a : (member LabelsLength : int) and ^a : (member Labels : int -> string)> (fb: ^a) - : Either = + : DiscoResult< string array> = let len = (^a : (member LabelsLength : int) fb) let arr = Array.zeroCreate len Array.fold - (fun (result: Either) _ -> either { - let! (i, labels) = result + (fun (res: DiscoResult) _ -> result { + let! (i, labels) = res let value = try (^a : (member Labels : int -> string) (fb, i)) with | _ -> null labels.[i] <- value return (i + 1, labels) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd // ** parseTags @@ -831,30 +830,30 @@ module Pin = and ^a : (member Tags : int -> Nullable)> #endif (fb: ^a) - : Either = + : DiscoResult< Property array> = let len = (^a : (member TagsLength : int) fb) let arr = Array.zeroCreate len Array.fold - (fun (result: Either) _ -> either { - let! (i, arr) = result + (fun (res: DiscoResult) _ -> result { + let! (i, arr) = res #if FABLE_COMPILER let prop = (^a : (member Tags: int -> KeyValueFB) fb, i) #else let! prop = let nullable = (^a : (member Tags: int -> Nullable) fb,i) if nullable.HasValue then - Either.succeed nullable.Value + Result.succeed nullable.Value else "Cannot parse empty property" |> Error.asParseError "EnumPin.FromFB" - |> Either.fail + |> Result.fail #endif arr.[i] <- { Key = prop.Key; Value = prop.Value } return (i + 1, arr) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd // ** parseProperties @@ -865,11 +864,11 @@ module Pin = and ^a : (member Properties: int -> Nullable)> #endif (fb: ^a) - : Either = + : DiscoResult< Property array> = let len = (^a : (member PropertiesLength: int) fb) let properties = Array.zeroCreate len Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult< int * Property array>) _ -> result { let! (i, arr) = m #if FABLE_COMPILER let prop = (^a : (member Properties: int -> KeyValueFB) fb, i) @@ -877,18 +876,18 @@ module Pin = let! prop = let nullable = (^a : (member Properties: int -> Nullable) fb,i) if nullable.HasValue then - Either.succeed nullable.Value + Result.succeed nullable.Value else "Cannot parse empty property" |> Error.asParseError "EnumPin.FromFB" - |> Either.fail + |> Result.fail #endif arr.[i] <- { Key = prop.Key; Value = prop.Value } return (i + 1, arr) }) - (Right (0, properties)) + (Ok (0, properties)) properties - |> Either.map snd + |> Result.map snd // ** emtpyLabels @@ -1718,8 +1717,8 @@ type NumberPinD = // ** FromFB - static member FromFB(fb: NumberPinFB) : Either = - either { + static member FromFB(fb: NumberPinFB) : DiscoResult = + result { let! id = Id.decodeId fb let! groupId = Id.decodePinGroupId fb let! clientId = Id.decodeClientId fb @@ -1731,7 +1730,7 @@ type NumberPinD = let! slices = fb |> Pin.parseSimpleValues - |> Either.map (Array.map double) + |> Result.map (Array.map double) return { Id = id @@ -1759,7 +1758,7 @@ type NumberPinD = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> NumberPinFB.GetRootAsNumberPinFB |> NumberPinD.FromFB @@ -1916,8 +1915,8 @@ type StringPinD = // ** FromFB - static member FromFB(fb: StringPinFB) : Either = - either { + static member FromFB(fb: StringPinFB) : DiscoResult = + result { let! id = Id.decodeId fb let! groupId = Id.decodePinGroupId fb let! clientId = Id.decodeClientId fb @@ -1952,7 +1951,7 @@ type StringPinD = // ** FromStrings - static member FromStrings(bytes: byte[]) : Either = + static member FromStrings(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> StringPinFB.GetRootAsStringPinFB |> StringPinD.FromFB @@ -2052,8 +2051,8 @@ type BoolPinD = // ** FromFB - static member FromFB(fb: BoolPinFB) : Either = - either { + static member FromFB(fb: BoolPinFB) : DiscoResult = + result { let! id = Id.decodeId fb let! groupId = Id.decodePinGroupId fb let! clientId = Id.decodeClientId fb @@ -2086,7 +2085,7 @@ type BoolPinD = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> BoolPinFB.GetRootAsBoolPinFB |> BoolPinD.FromFB @@ -2248,8 +2247,8 @@ type [] BytePinD = // ** FromFB - static member FromFB(fb: BytePinFB) : Either = - either { + static member FromFB(fb: BytePinFB) : DiscoResult = + result { let! id = Id.decodeId fb let! group = Id.decodePinGroupId fb let! client = Id.decodeClientId fb @@ -2260,7 +2259,7 @@ type [] BytePinD = let! slices = fb |> Pin.parseSimpleValues - |> Either.map (Array.map String.decodeBase64) + |> Result.map (Array.map String.decodeBase64) return { Id = id @@ -2284,7 +2283,7 @@ type [] BytePinD = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> BytePinFB.GetRootAsBytePinFB |> BytePinD.FromFB @@ -2386,8 +2385,8 @@ type EnumPinD = // ** FromFB - static member FromFB(fb: EnumPinFB) : Either = - either { + static member FromFB(fb: EnumPinFB) : DiscoResult = + result { let! id = Id.decodeId fb let! group = Id.decodePinGroupId fb let! client = Id.decodeClientId fb @@ -2400,7 +2399,7 @@ type EnumPinD = let! properties = let properties = Array.zeroCreate fb.PropertiesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult< int * Property array>) _ -> result { let! (i, arr) = m #if FABLE_COMPILER let prop = fb.Properties(i) @@ -2408,18 +2407,18 @@ type EnumPinD = let! prop = let nullable = fb.Properties(i) if nullable.HasValue then - Either.succeed nullable.Value + Result.succeed nullable.Value else "Cannot parse empty property" |> Error.asParseError "EnumPin.FromFB" - |> Either.fail + |> Result.fail #endif arr.[i] <- { Key = prop.Key; Value = prop.Value } return (i + 1, arr) }) - (Right (0, properties)) + (Ok (0, properties)) properties - |> Either.map snd + |> Result.map snd return { Id = id @@ -2444,7 +2443,7 @@ type EnumPinD = // ** FromEnums - static member FromEnums(bytes: byte[]) : Either = + static member FromEnums(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> EnumPinFB.GetRootAsEnumPinFB |> EnumPinD.FromFB @@ -2540,8 +2539,8 @@ type ColorPinD = // ** FromFB - static member FromFB(fb: ColorPinFB) : Either = - either { + static member FromFB(fb: ColorPinFB) : DiscoResult = + result { let! id = Id.decodeId fb let! group = Id.decodePinGroupId fb let! client = Id.decodeClientId fb @@ -2572,7 +2571,7 @@ type ColorPinD = // ** FromColors - static member FromColors(bytes: byte[]) : Either = + static member FromColors(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> ColorPinFB.GetRootAsColorPinFB |> ColorPinD.FromFB @@ -2820,38 +2819,38 @@ type Slice = // ** FromFB - static member FromFB(fb: SliceFB) : Either = + static member FromFB(fb: SliceFB) : DiscoResult = match fb.SliceType with #if FABLE_COMPILER | x when x = SliceTypeFB.StringFB -> let slice = StringFB.Create() |> fb.Slice StringSlice(1 * fb.Index, slice.Value) - |> Either.succeed + |> Result.succeed | x when x = SliceTypeFB.DoubleFB -> let slice = DoubleFB.Create() |> fb.Slice NumberSlice(1 * fb.Index, slice.Value) - |> Either.succeed + |> Result.succeed | x when x = SliceTypeFB.BoolFB -> let slice = BoolFB.Create() |> fb.Slice BoolSlice(1 * fb.Index, slice.Trigger, slice.Value) - |> Either.succeed + |> Result.succeed | x when x = SliceTypeFB.ByteFB -> let slice = ByteFB.Create() |> fb.Slice ByteSlice(1 * fb.Index,String.decodeBase64 slice.Value) - |> Either.succeed + |> Result.succeed | x when x = SliceTypeFB.KeyValueFB -> - either { + result { let slice = KeyValueFB.Create() |> fb.Slice let! prop = Property.FromFB slice return EnumSlice(1 * fb.Index,prop) } | x when x = SliceTypeFB.ColorSpaceFB -> - either { + result { let slice = ColorSpaceFB.Create() |> fb.Slice let! color = ColorSpace.FromFB slice return ColorSlice(1 * fb.Index, color) @@ -2860,7 +2859,7 @@ type Slice = | x -> sprintf "Could not parse slice. Unknown slice type %A" x |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail #else @@ -2869,49 +2868,49 @@ type Slice = if slice.HasValue then let value = slice.Value StringSlice(1 * fb.Index, value.Value) - |> Either.succeed + |> Result.succeed else "Could not parse StringSlice" |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail | SliceTypeFB.DoubleFB -> let slice = fb.Slice() if slice.HasValue then let value = slice.Value NumberSlice(fb.Index * 1,value.Value) - |> Either.succeed + |> Result.succeed else "Could not parse NumberSlice" |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail | SliceTypeFB.BoolFB -> let slice = fb.Slice() if slice.HasValue then let value = slice.Value BoolSlice(fb.Index * 1, value.Trigger, value.Value) - |> Either.succeed + |> Result.succeed else "Could not parse BoolSlice" |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail | SliceTypeFB.ByteFB -> let slice = fb.Slice() if slice.HasValue then let value = slice.Value ByteSlice(fb.Index * 1, String.decodeBase64 value.Value) - |> Either.succeed + |> Result.succeed else "Could not parse ByteSlice" |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail | SliceTypeFB.KeyValueFB -> let slice = fb.Slice() if slice.HasValue then - either { + result { let value = slice.Value let! prop = Property.FromFB value return EnumSlice(fb.Index * 1, prop) @@ -2919,12 +2918,12 @@ type Slice = else "Could not parse EnumSlice" |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail | SliceTypeFB.ColorSpaceFB -> let slice = fb.Slice() if slice.HasValue then - either { + result { let value = slice.Value let! color = ColorSpace.FromFB value return ColorSlice(fb.Index * 1, color) @@ -2932,12 +2931,12 @@ type Slice = else "Could not parse ColorSlice" |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail | x -> sprintf "Cannot parse slice. Unknown slice type: %A" x |> Error.asParseError "Slice.FromFB" - |> Either.fail + |> Result.fail #endif @@ -2947,7 +2946,7 @@ type Slice = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> SliceFB.GetRootAsSliceFB |> Slice.FromFB @@ -3332,16 +3331,16 @@ type Slices = // ** FromFB - static member inline FromFB(fb: SlicesFB) : Either = - either { + static member inline FromFB(fb: SlicesFB) : DiscoResult = + result { let! id = Id.decodePinId fb let! client = try if fb.ClientIdLength = 0 - then Either.succeed None - else Id.decodeClientId fb |> Either.map Some + then Result.succeed None + else Id.decodeClientId fb |> Result.map Some with exn -> - Either.succeed None + Result.succeed None return! // _ ____ // | / ___| @@ -3354,79 +3353,79 @@ type Slices = let slices = StringsFB.Create() |> fb.Slices let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m parsed.[idx] <- slices.Values(idx) return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (strings, _) -> StringSlices(id,client,strings)) + |> Result.map (fun (strings, _) -> StringSlices(id,client,strings)) | x when x = SlicesTypeFB.DoublesFB -> let slices = DoublesFB.Create() |> fb.Slices let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m parsed.[idx] <- slices.Values(idx) return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (doubles,_) -> NumberSlices(id,client,doubles)) + |> Result.map (fun (doubles,_) -> NumberSlices(id,client,doubles)) | x when x = SlicesTypeFB.BoolsFB -> let slices = BoolsFB.Create() |> fb.Slices let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m parsed.[idx] <- slices.Values(idx) return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (bools,_) -> BoolSlices(id,client,slices.Trigger,bools)) + |> Result.map (fun (bools,_) -> BoolSlices(id,client,slices.Trigger,bools)) | x when x = SlicesTypeFB.BytesFB -> let slices = BytesFB.Create() |> fb.Slices let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m let bytes = slices.Values(idx) |> String.decodeBase64 parsed.[idx] <- bytes return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (bytes,_) -> ByteSlices(id,client,bytes)) + |> Result.map (fun (bytes,_) -> ByteSlices(id,client,bytes)) | x when x = SlicesTypeFB.KeyValuesFB -> let slices = KeyValuesFB.Create() |> fb.Slices let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m let! prop = let value = slices.Values(idx) Property.FromFB value parsed.[idx] <- prop return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (props,_) -> EnumSlices(id,client,props)) + |> Result.map (fun (props,_) -> EnumSlices(id,client,props)) | x when x = SlicesTypeFB.ColorSpacesFB -> let slices = ColorSpacesFB.Create() |> fb.Slices let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m let! color = let value = slices.Values(idx) ColorSpace.FromFB value parsed.[idx] <- color return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (colors,_) -> ColorSlices(id,client,colors)) + |> Result.map (fun (colors,_) -> ColorSlices(id,client,colors)) | x -> sprintf "unknown slices type: %O" x |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail // _ _ _____ _____ // | \ | | ____|_ _| @@ -3443,79 +3442,79 @@ type Slices = let slices = slicesish.Value let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m let value = try slices.Values(idx) with | _ -> null parsed.[idx] <- value return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (strings, _) -> StringSlices(id, client, strings)) + |> Result.map (fun (strings, _) -> StringSlices(id, client, strings)) else "empty slices value" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail | SlicesTypeFB.DoublesFB -> let slicesish = fb.Slices() if slicesish.HasValue then let slices = slicesish.Value let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m parsed.[idx] <- slices.Values(idx) return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (doubles,_) -> NumberSlices(id, client, doubles)) + |> Result.map (fun (doubles,_) -> NumberSlices(id, client, doubles)) else "empty slices value" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail | SlicesTypeFB.BoolsFB -> let slicesish = fb.Slices() if slicesish.HasValue then let slices = slicesish.Value let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m parsed.[idx] <- slices.Values(idx) return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (bools,_) -> BoolSlices(id, client, slices.Trigger, bools)) + |> Result.map (fun (bools,_) -> BoolSlices(id, client, slices.Trigger, bools)) else "empty slices value" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail | SlicesTypeFB.BytesFB -> let slicesish = fb.Slices() if slicesish.HasValue then let slices = slicesish.Value let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m let bytes = slices.Values(idx) |> String.decodeBase64 parsed.[idx] <- bytes return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (bytes,_) -> ByteSlices(id, client, bytes)) + |> Result.map (fun (bytes,_) -> ByteSlices(id, client, bytes)) else "empty slices value" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail | SlicesTypeFB.KeyValuesFB -> let slicesish = fb.Slices() if slicesish.HasValue then let slices = slicesish.Value let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m let! prop = let propish = slices.Values(idx) @@ -3525,23 +3524,23 @@ type Slices = else "could not parse empty property" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail parsed.[idx] <- prop return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (props,_) -> EnumSlices(id, client, props)) + |> Result.map (fun (props,_) -> EnumSlices(id, client, props)) else "empty slices value" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail | SlicesTypeFB.ColorSpacesFB -> let slicesish = fb.Slices() if slicesish.HasValue then let slices = slicesish.Value let arr = Array.zeroCreate slices.ValuesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (parsed,idx) = m let! color = let colorish = slices.Values(idx) @@ -3551,20 +3550,20 @@ type Slices = else "could not parse empty colorspace" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail parsed.[idx] <- color return parsed, idx + 1 }) - (Right (arr, 0)) + (Ok (arr, 0)) arr - |> Either.map (fun (colors,_) -> ColorSlices(id,client,colors)) + |> Result.map (fun (colors,_) -> ColorSlices(id,client,colors)) else "empty slices value" |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail | x -> sprintf "unknown slices type: %O" x |> Error.asParseError "Slices.FromFB" - |> Either.fail + |> Result.fail #endif } @@ -3575,7 +3574,7 @@ type Slices = // ** FromBytes - static member FromBytes(raw: byte[]) : Either = + static member FromBytes(raw: byte[]) : DiscoResult = Binary.createBuffer raw |> SlicesFB.GetRootAsSlicesFB |> Slices.FromFB @@ -3725,17 +3724,17 @@ module SliceYaml = // ** toSlice - let toSlice (yml: SliceYaml) : Either = + let toSlice (yml: SliceYaml) : DiscoResult = match yml.SliceType with | "StringSlice" -> - Either.tryWith (Error.asParseError "SliceYaml.ToSlice (String)") <| fun _ -> + Result.tryWith (Error.asParseError "SliceYaml.ToSlice (String)") <| fun _ -> let parse (str: obj) = match str with | null -> null | _ -> str :?> String StringSlice(1 * yml.Index, parse yml.Value) | "NumberSlice" -> - Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Number)") <| fun _ -> + Result.tryWith (Error.asParseError "SliceYaml.ToSlice (Number)") <| fun _ -> let parse (value: obj) = try match value with @@ -3752,24 +3751,24 @@ module SliceYaml = 0.0 NumberSlice(1 * yml.Index, parse yml.Value) | "BoolSlice" -> - Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Bool)") <| fun _ -> + Result.tryWith (Error.asParseError "SliceYaml.ToSlice (Bool)") <| fun _ -> BoolSlice(1 * yml.Index, yml.Trigger, yml.Value :?> bool) | "ByteSlice" -> - Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Byte)") <| fun _ -> + Result.tryWith (Error.asParseError "SliceYaml.ToSlice (Byte)") <| fun _ -> ByteSlice(1 * yml.Index, yml.Value |> string |> Convert.FromBase64String) | "EnumSlice" -> - Either.tryWith (Error.asParseError "SliceYaml.ToSlice (Enum)") <| fun _ -> + Result.tryWith (Error.asParseError "SliceYaml.ToSlice (Enum)") <| fun _ -> let pyml = yml.Value :?> PropertyYaml EnumSlice(1 * yml.Index, { Key = pyml.Key; Value = pyml.Value }) | "ColorSlice" -> - either { + result { let! color = Yaml.fromYaml(yml.Value :?> ColorYaml) return ColorSlice(1 * yml.Index, color) } | unknown -> sprintf "Could not de-serialize unknown type: %A" unknown |> Error.asParseError "SliceYaml.ToSlice" - |> Either.fail + |> Result.fail // * SlicesYaml @@ -3838,7 +3837,7 @@ module SlicesYaml = let toSlices (yml: SlicesYaml) = match yml.SliceType with | "StringSlices" -> - Either.tryWith (Error.asParseError "SlicesYaml.ToSlice (String)") <| fun _ -> + Result.tryWith (Error.asParseError "SlicesYaml.ToSlice (String)") <| fun _ -> let parse (str: obj) = match str with | null -> null @@ -3846,7 +3845,7 @@ module SlicesYaml = let client = if isNull yml.ClientId then None else Some (DiscoId.Parse yml.ClientId) StringSlices(DiscoId.Parse yml.PinId, client, Array.map parse yml.Values) | "NumberSlices" -> - Either.tryWith (Error.asParseError "SlicesYaml.ToSlice (Number)") <| fun _ -> + Result.tryWith (Error.asParseError "SlicesYaml.ToSlice (Number)") <| fun _ -> let parse (value: obj) = try match value with @@ -3864,11 +3863,11 @@ module SlicesYaml = let client = if isNull yml.ClientId then None else Some (DiscoId.Parse yml.ClientId) NumberSlices(DiscoId.Parse yml.PinId, client, Array.map parse yml.Values) | "BoolSlices" -> - Either.tryWith (Error.asParseError "SlicesYaml.ToSlice (Bool)") <| fun _ -> + Result.tryWith (Error.asParseError "SlicesYaml.ToSlice (Bool)") <| fun _ -> let client = if isNull yml.ClientId then None else Some (DiscoId.Parse yml.ClientId) BoolSlices(DiscoId.Parse yml.PinId, client, yml.Trigger, Array.map unbox yml.Values) | "ByteSlices" -> - Either.tryWith (Error.asParseError "SlicesYaml.ToSlice (Byte)") <| fun _ -> + Result.tryWith (Error.asParseError "SlicesYaml.ToSlice (Byte)") <| fun _ -> let parse (value: obj) = match value with | :? String -> (value :?> String) |> Convert.FromBase64String @@ -3881,33 +3880,33 @@ module SlicesYaml = let client = if isNull yml.ClientId then None else Some (DiscoId.Parse yml.ClientId) ByteSlices(DiscoId.Parse yml.PinId, client, Array.map parse yml.Values) | "EnumSlices" -> - Either.tryWith (Error.asParseError "SlicesYaml.ToSlice (Enum)") <| fun _ -> + Result.tryWith (Error.asParseError "SlicesYaml.ToSlice (Enum)") <| fun _ -> let ofPyml (o: obj) = let pyml: PropertyYaml = unbox o { Key = pyml.Key; Value = pyml.Value } let client = if isNull yml.ClientId then None else Some (DiscoId.Parse yml.ClientId) EnumSlices(DiscoId.Parse yml.PinId, client, Array.map ofPyml yml.Values) | "ColorSlices" -> - either { + result { let! colors = Array.fold - (fun (m: Either) value -> either { + (fun (m: DiscoResult) value -> result { let! (idx, colors) = m let unboxed: ColorYaml = unbox value let! color = Yaml.fromYaml unboxed colors.[idx] <- color return (idx + 1, colors) }) - (Right(0, Array.zeroCreate yml.Values.Length)) + (Ok(0, Array.zeroCreate yml.Values.Length)) yml.Values - |> Either.map snd + |> Result.map snd let client = if isNull yml.ClientId then None else Some (DiscoId.Parse yml.ClientId) return ColorSlices(DiscoId.Parse yml.PinId, client, colors) } | unknown -> sprintf "Could not de-serialize unknown type: %A" unknown |> Error.asParseError "SlicesYaml.ToSlice" - |> Either.fail + |> Result.fail // * PinYaml @@ -4051,21 +4050,21 @@ module PinYaml = let toPin (yml: PinYaml) = let parseTags (yaml: PinYaml) = Array.fold - (fun (m: Either) yml -> - either { + (fun (m: DiscoResult< int * Property array>) yml -> + result { let! state = m let! parsed = Yaml.fromYaml yml (snd state).[fst state] <- parsed return (fst state + 1, snd state) }) - (Right (0, Array.zeroCreate yaml.Tags.Length)) + (Ok (0, Array.zeroCreate yaml.Tags.Length)) yaml.Tags - |> Either.map snd + |> Result.map snd try match yml.PinType with | "StringPin" -> - either { + result { let! id = DiscoId.TryParse yml.Id let! group = DiscoId.TryParse yml.PinGroupId let! client = DiscoId.TryParse yml.ClientId @@ -4076,14 +4075,14 @@ module PinYaml = let! (_, slices) = let arr = Array.zeroCreate yml.Values.Length Array.fold - (fun (m: Either) (yml: SliceYaml) -> - either { + (fun (m: DiscoResult) (yml: SliceYaml) -> + result { let! (i, arr) = m let! value = SliceYaml.toSlice yml arr.[i] <- (value.Value :?> String) return (i + 1, arr) }) - (Right(0, arr)) + (Ok(0, arr)) yml.Values return StringPin { @@ -4104,7 +4103,7 @@ module PinYaml = } } - | "NumberPin" -> either { + | "NumberPin" -> result { let! id = DiscoId.TryParse yml.Id let! group = DiscoId.TryParse yml.PinGroupId let! client = DiscoId.TryParse yml.ClientId @@ -4114,20 +4113,20 @@ module PinYaml = let! (_, slices) = let arr = Array.zeroCreate yml.Values.Length Array.fold - (fun (m: Either) (yml: SliceYaml) -> - either { + (fun (m: DiscoResult) (yml: SliceYaml) -> + result { let! (i, arr) = m let! value = SliceYaml.toSlice yml let! value = - try value.Value :?> double |> Either.succeed + try value.Value :?> double |> Result.succeed with | x -> sprintf "Could not parse double: %s" x.Message |> Error.asParseError "FromYaml NumberPin" - |> Either.fail + |> Result.fail arr.[i] <- value return (i + 1, arr) }) - (Right(0, arr)) + (Ok(0, arr)) yml.Values return NumberPin { @@ -4150,7 +4149,7 @@ module PinYaml = } } - | "BoolPin" -> either { + | "BoolPin" -> result { let! id = DiscoId.TryParse yml.Id let! group = DiscoId.TryParse yml.PinGroupId let! client = DiscoId.TryParse yml.ClientId @@ -4160,24 +4159,24 @@ module PinYaml = let! (_, slices) = let arr = Array.zeroCreate yml.Values.Length Array.fold - (fun (m: Either) (yml: SliceYaml) -> - either { + (fun (m: DiscoResult) (yml: SliceYaml) -> + result { let! (i, arr) = m let! value = SliceYaml.toSlice yml let! value = try value.Value :?> bool - |> Either.succeed + |> Result.succeed with | x -> sprintf "Could not parse double: %s" x.Message |> Error.asParseError "FromYaml NumberPin" - |> Either.fail + |> Result.fail arr.[i] <- value return (i + 1, arr) }) - (Right(0, arr)) + (Ok(0, arr)) yml.Values return BoolPin { @@ -4197,7 +4196,7 @@ module PinYaml = } } - | "BytePin" -> either { + | "BytePin" -> result { let! id = DiscoId.TryParse yml.Id let! group = DiscoId.TryParse yml.PinGroupId let! client = DiscoId.TryParse yml.ClientId @@ -4207,24 +4206,24 @@ module PinYaml = let! (_, slices) = let arr = Array.zeroCreate yml.Values.Length Array.fold - (fun (m: Either) (yml: SliceYaml) -> - either { + (fun (m: DiscoResult) (yml: SliceYaml) -> + result { let! (i, arr) = m let! value = SliceYaml.toSlice yml let! value = try value.Value :?> byte array - |> Either.succeed + |> Result.succeed with | x -> sprintf "Could not parse double: %s" x.Message |> Error.asParseError "FromYaml NumberPin" - |> Either.fail + |> Result.fail arr.[i] <- value return (i + 1, arr) }) - (Right(0, arr)) + (Ok(0, arr)) yml.Values return BytePin { @@ -4243,41 +4242,41 @@ module PinYaml = } } - | "EnumPin" -> either { + | "EnumPin" -> result { let! properties = Array.fold - (fun (m: Either) yml -> - either { + (fun (m: DiscoResult< int * Property array>) yml -> + result { let! state = m let! parsed = Yaml.fromYaml yml (snd state).[fst state] <- parsed return (fst state + 1, snd state) }) - (Right (0, Array.zeroCreate yml.Properties.Length)) + (Ok (0, Array.zeroCreate yml.Properties.Length)) yml.Properties - |> Either.map snd + |> Result.map snd let! (_, slices) = let arr = Array.zeroCreate yml.Values.Length Array.fold - (fun (m: Either) (yml: SliceYaml) -> - either { + (fun (m: DiscoResult) (yml: SliceYaml) -> + result { let! (i, arr) = m let! value = SliceYaml.toSlice yml let! value = try value.Value :?> Property - |> Either.succeed + |> Result.succeed with | x -> sprintf "Could not parse Property: %s" x.Message |> Error.asParseError "FromYaml NumberPin" - |> Either.fail + |> Result.fail arr.[i] <- value return (i + 1, arr) }) - (Right(0, arr)) + (Ok(0, arr)) yml.Values let! id = DiscoId.TryParse yml.Id @@ -4304,7 +4303,7 @@ module PinYaml = } } - | "ColorPin" -> either { + | "ColorPin" -> result { let! id = DiscoId.TryParse yml.Id let! group = DiscoId.TryParse yml.PinGroupId let! client = DiscoId.TryParse yml.ClientId @@ -4315,24 +4314,24 @@ module PinYaml = let! (_, slices) = let arr = Array.zeroCreate yml.Values.Length Array.fold - (fun (m: Either) (yml: SliceYaml) -> - either { + (fun (m: DiscoResult) (yml: SliceYaml) -> + result { let! (i, arr) = m let! value = SliceYaml.toSlice yml let! value = try value.Value :?> ColorSpace - |> Either.succeed + |> Result.succeed with | x -> sprintf "Could not parse Property: %s" x.Message |> Error.asParseError "FromYaml NumberPin" - |> Either.fail + |> Result.fail arr.[i] <- value return (i + 1, arr) }) - (Right(0, arr)) + (Ok(0, arr)) yml.Values return ColorPin { @@ -4354,11 +4353,11 @@ module PinYaml = | x -> sprintf "Could not parse PinYml type: %s" x |> Error.asParseError "PynYml.FromYaml" - |> Either.fail + |> Result.fail with exn -> sprintf "Could not parse PinYml: %s" exn.Message |> Error.asParseError "PynYml.FromYaml" - |> Either.fail + |> Result.fail #endif diff --git a/src/Disco/Disco/Core/PinGroup.fs b/src/Disco/Disco/Core/PinGroup.fs index 5994527e..4a7d7184 100644 --- a/src/Disco/Disco/Core/PinGroup.fs +++ b/src/Disco/Disco/Core/PinGroup.fs @@ -54,18 +54,18 @@ type PinGroupYaml() = yml member yml.ToPinGroup() = - either { + result { let! id = DiscoId.TryParse yml.Id let! client = DiscoId.TryParse yml.ClientId let! pins = Array.fold - (fun (m: Either>) pinyml -> either { + (fun (m: DiscoResult>) pinyml -> result { let! pins = m let! (pin : Pin) = Yaml.fromYaml pinyml return Map.add pin.Id pin pins }) - (Right Map.empty) + (Ok Map.empty) yml.Pins let path = @@ -75,11 +75,11 @@ type PinGroupYaml() = let! refersTo = if isNull yml.RefersTo then - Either.succeed None + Result.succeed None else yml.RefersTo |> Yaml.fromYaml - |> Either.map Some + |> Result.map Some return { Id = id @@ -111,11 +111,11 @@ type ReferencedValueYaml() = member yml.ToReferencedValue() = match yml.Type.ToLowerInvariant() with - | "player" -> either { + | "player" -> result { let! id = DiscoId.TryParse yml.Id return ReferencedValue.Player id } - | "widget" -> either { + | "widget" -> result { let! id = DiscoId.TryParse yml.Id return ReferencedValue.Widget id } @@ -123,7 +123,7 @@ type ReferencedValueYaml() = other |> String.format "Could not parse ReferencedValue type: {0}" |> Error.asParseError "ReferencedValueYaml.ToReferencedValue" - |> Either.fail + |> Result.fail #endif @@ -192,22 +192,22 @@ type ReferencedValue = static member FromFB (fb: ReferencedValueFB) = #if FABLE_COMPILER match fb.Type with - | x when x = ReferencedValueTypeFB.PlayerFB -> Id.decodeId fb |> Either.map Player - | x when x = ReferencedValueTypeFB.WidgetFB -> Id.decodeId fb |> Either.map Widget + | x when x = ReferencedValueTypeFB.PlayerFB -> Id.decodeId fb |> Result.map Player + | x when x = ReferencedValueTypeFB.WidgetFB -> Id.decodeId fb |> Result.map Widget | x -> x |> String.format "Could not parse unknown ReferencedValueTypeFB {0}" |> Error.asParseError "ReferencedValue.FromFB" - |> Either.fail + |> Result.fail #else match fb.Type with - | ReferencedValueTypeFB.PlayerFB -> Id.decodeId fb |> Either.map Player - | ReferencedValueTypeFB.WidgetFB -> Id.decodeId fb |> Either.map Widget + | ReferencedValueTypeFB.PlayerFB -> Id.decodeId fb |> Result.map Player + | ReferencedValueTypeFB.WidgetFB -> Id.decodeId fb |> Result.map Widget | other -> other |> String.format "Could not parse unknown ReferencedValueTypeFB {0}" |> Error.asParseError "ReferencedValue.FromFB" - |> Either.fail + |> Result.fail #endif // ** ToOffset @@ -228,7 +228,7 @@ type ReferencedValue = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> ReferencedValueFB.GetRootAsReferencedValueFB |> ReferencedValue.FromFB @@ -319,11 +319,11 @@ type PinGroup = // |___/ static member FromFB (fb: PinGroupFB) = - either { + result { let! pins = let arr = Array.zeroCreate fb.PinsLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, pins) = m #if FABLE_COMPILER @@ -337,31 +337,31 @@ type PinGroup = else "Could not parse empty PinFB" |> Error.asParseError "PinGroup.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add pin.Id pin pins) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd let! refersTo = #if FABLE_COMPILER if isNull fb.RefersTo then - Either.succeed None + Result.succeed None else fb.RefersTo |> ReferencedValue.FromFB - |> Either.map Some + |> Result.map Some #else let refish = fb.RefersTo if refish.HasValue then let value = refish.Value ReferencedValue.FromFB value - |> Either.map Some + |> Result.map Some else - Either.succeed None + Result.succeed None #endif let path = @@ -410,7 +410,7 @@ type PinGroup = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> PinGroupFB.GetRootAsPinGroupFB |> PinGroup.FromFB @@ -430,12 +430,12 @@ type PinGroup = #if !FABLE_COMPILER && !DISCO_NODES - static member Load(path: FilePath) : Either = + static member Load(path: FilePath) : DiscoResult = DiscoData.load path // ** LoadAll - static member LoadAll(basePath: FilePath) : Either = + static member LoadAll(basePath: FilePath) : DiscoResult = basePath filepath Constants.PINGROUP_DIR |> DiscoData.loadAll @@ -527,7 +527,7 @@ module PinGroup = group |> persistedPins |> DiscoData.save basePath - else Either.succeed () + else Result.succeed () #endif @@ -801,7 +801,7 @@ type PinGroupMap = static member FromFB(fb: PinGroupMapFB) = [ 0 .. fb.GroupsLength - 1 ] |> List.fold - (fun (m: Either) idx -> either { + (fun (m: DiscoResult) idx -> result { let! current = m let! parsed = #if FABLE_COMPILER @@ -815,12 +815,12 @@ type PinGroupMap = else "Could not parse empty PinGroup value" |> Error.asParseError "PinGroupMap.FromFB" - |> Either.fail + |> Result.fail #endif return PinGroupMap.add parsed current }) - (Right PinGroupMap.empty) + (Ok PinGroupMap.empty) // ** ToBytes @@ -828,7 +828,7 @@ type PinGroupMap = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> PinGroupMapFB.GetRootAsPinGroupMapFB |> PinGroupMap.FromFB @@ -837,8 +837,8 @@ type PinGroupMap = #if !FABLE_COMPILER && !DISCO_NODES - static member Load(path: FilePath) : Either = - either { + static member Load(path: FilePath) : DiscoResult = + result { let! groups = Asset.loadAll path return PinGroupMap.ofArray groups } @@ -847,12 +847,12 @@ type PinGroupMap = member map.Save (basePath: FilePath) = Map.fold - (fun (m: Either) _ groups -> - either { + (fun (m: DiscoResult) _ groups -> + result { let! _ = m - return! Map.fold (Asset.saveMap basePath) Either.nothing groups + return! Map.fold (Asset.saveMap basePath) Result.nothing groups }) - Either.nothing + Result.nothing map.Groups #endif diff --git a/src/Disco/Disco/Core/PinMapping.fs b/src/Disco/Disco/Core/PinMapping.fs index ae2cba23..8b707b1e 100644 --- a/src/Disco/Disco/Core/PinMapping.fs +++ b/src/Disco/Disco/Core/PinMapping.fs @@ -46,7 +46,7 @@ type PinMappingYaml() = yml member yml.ToPinMapping() = - either { + result { let! id = DiscoId.TryParse yml.Id let! source = DiscoId.TryParse yml.Source return { @@ -86,7 +86,7 @@ type PinMapping = // ** FromFB static member FromFB (fb: PinMappingFB) = - either { + result { try let! id = Id.decodeId fb let! source = Id.decodeSource fb @@ -103,7 +103,7 @@ type PinMapping = return! exn.Message |> Error.asParseError "PinMapping.FromFB" - |> Either.fail + |> Result.fail } // ** ToOffset @@ -128,7 +128,7 @@ type PinMapping = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> PinMappingFB.GetRootAsPinMappingFB |> PinMapping.FromFB @@ -143,12 +143,12 @@ type PinMapping = #if !FABLE_COMPILER && !DISCO_NODES - static member Load(path: FilePath) : Either = + static member Load(path: FilePath) : DiscoResult = DiscoData.load path // ** LoadAll - static member LoadAll(basePath: FilePath) : Either = + static member LoadAll(basePath: FilePath) : DiscoResult = basePath filepath Constants.PINMAPPING_DIR |> DiscoData.loadAll diff --git a/src/Disco/Disco/Core/PinWidget.fs b/src/Disco/Disco/Core/PinWidget.fs index 2fc9a7bf..01891c48 100644 --- a/src/Disco/Disco/Core/PinWidget.fs +++ b/src/Disco/Disco/Core/PinWidget.fs @@ -48,7 +48,7 @@ type PinWidgetYaml() = yml member yml.ToPinWidget() = - either { + result { let! id = DiscoId.TryParse yml.Id let! widget = DiscoId.TryParse yml.WidgetType return { @@ -109,7 +109,7 @@ type PinWidget = // |___/ static member FromFB (fb: PinWidgetFB) = - either { + result { let! id = Id.decodeId fb let! widget = Id.decodeWidgetType fb return { @@ -137,7 +137,7 @@ type PinWidget = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> PinWidgetFB.GetRootAsPinWidgetFB |> PinWidget.FromFB @@ -152,12 +152,12 @@ type PinWidget = #if !FABLE_COMPILER && !DISCO_NODES - static member Load(path: FilePath) : Either = + static member Load(path: FilePath) : DiscoResult = DiscoData.load path // ** LoadAll - static member LoadAll(basePath: FilePath) : Either = + static member LoadAll(basePath: FilePath) : DiscoResult = basePath filepath Constants.PINWIDGET_DIR |> DiscoData.loadAll diff --git a/src/Disco/Disco/Core/Platform.fs b/src/Disco/Disco/Core/Platform.fs index b633dde2..347ce73c 100644 --- a/src/Disco/Disco/Core/Platform.fs +++ b/src/Disco/Disco/Core/Platform.fs @@ -39,16 +39,16 @@ type Platform = static member FromFB(fb: PlatformFB) = match fb with #if FABLE_COMPILER - | x when x = PlatformFB.WindowsFB -> Right Windows - | x when x = PlatformFB.UnixFB -> Right Unix + | x when x = PlatformFB.WindowsFB -> Ok Windows + | x when x = PlatformFB.UnixFB -> Ok Unix #else - | PlatformFB.WindowsFB -> Right Windows - | PlatformFB.UnixFB -> Right Unix + | PlatformFB.WindowsFB -> Ok Windows + | PlatformFB.UnixFB -> Ok Unix #endif | other -> string other + " is not a recognized platform identifier" |> Error.asParseError "Platform.FromFB" - |> Either.fail + |> Result.fail // * Platform module diff --git a/src/Disco/Disco/Core/Project.fs b/src/Disco/Disco/Core/Project.fs index 7ec53b8f..9e790268 100644 --- a/src/Disco/Disco/Core/Project.fs +++ b/src/Disco/Disco/Core/Project.fs @@ -117,7 +117,7 @@ type RaftConfig = // ** FromFB static member FromFB(fb: RaftConfigFB) = - either { + result { let! level = Disco.Core.LogLevel.TryParse fb.LogLevel return { RequestTimeout = fb.RequestTimeout * 1 @@ -202,7 +202,7 @@ type ClientExecutable = // ** FromFB static member FromFB(fb: ClientExecutableFB) = - either { + result { let! id = Id.decodeId fb return { Id = id @@ -271,11 +271,11 @@ type ClientConfig = ClientConfig of Map // ** FromFB static member FromFB(fb: ClientConfigFB) = - either { + result { let! executables = List.fold - (fun (m: Either>) idx -> - either { + (fun (m: DiscoResult>) idx -> + result { let! exes = m let! exe = #if FABLE_COMPILER @@ -289,11 +289,11 @@ type ClientConfig = ClientConfig of Map else "Could not parse empty ClientExecutableFB" |> Error.asParseError "ClientConfig.FromFB" - |> Either.fail + |> Result.fail #endif return Map.add exe.Id exe exes }) - (Right Map.empty) + (Ok Map.empty) [ for n in 0 .. fb.ExecutablesLength - 1 -> n ] return ClientConfig executables } @@ -387,14 +387,14 @@ type TimingConfig = // ** FromFB static member FromFB(fb: TimingConfigFB) = - either { + result { let! (_,servers) = let arr = fb.ServersLength |> Array.zeroCreate Array.fold - (fun (m: Either) _ -> - either { + (fun (m: DiscoResult) _ -> + result { let! (idx,servers) = m let! server = fb.Servers(idx) @@ -402,7 +402,7 @@ type TimingConfig = servers.[idx] <- server return (idx + 1, servers) }) - (Right(0, arr)) + (Ok(0, arr)) arr return @@ -467,7 +467,7 @@ type AudioConfig = // ** FromFB static member FromFB(fb: AudioConfigFB) = - either { + result { return { SampleRate = fb.SampleRate } } @@ -529,20 +529,20 @@ type HostGroup = // ** FromFB static member FromFB(fb: HostGroupFB) = - either { + result { let! (_,members) = let arr = fb.MembersLength |> Array.zeroCreate Array.fold - (fun (m: Either) _ -> - either { + (fun (m: DiscoResult) _ -> + result { let! (idx, ids) = m let! id = DiscoId.TryParse (fb.Members(idx)) ids.[idx] <- id return (idx + 1, ids) }) - (Right(0, arr)) + (Ok(0, arr)) arr return @@ -675,8 +675,8 @@ type ClusterMember = // ** FromFB - static member FromFB (fb: ClusterMemberFB) : Either = - either { + static member FromFB (fb: ClusterMemberFB) : DiscoResult = + result { let! id = Id.decodeId fb let! state = MemberState.FromFB fb.State let! status = MemberStatus.FromFB fb.Status @@ -856,14 +856,14 @@ type ClusterConfig = // ** FromFB static member FromFB(fb: ClusterConfigFB) = - either { + result { let! (_,members) = let arr = fb.MembersLength |> Array.zeroCreate Array.fold - (fun (m: Either>) _ -> - either { + (fun (m: DiscoResult>) _ -> + result { let! (idx,members) = m let! mem = @@ -878,12 +878,12 @@ type ClusterConfig = else "Could not parse empty ClusterMemberFB" |> Error.asParseError "Cluster.FromFB" - |> Either.fail + |> Result.fail #endif return (idx + 1, Map.add mem.Id mem members) }) - (Right(0, Map.empty)) + (Ok(0, Map.empty)) arr let! (_,groups) = @@ -891,8 +891,8 @@ type ClusterConfig = fb.GroupsLength |> Array.zeroCreate Array.fold - (fun (m: Either) _ -> - either { + (fun (m: DiscoResult) _ -> + result { let! (idx,groups) = m let! group = @@ -907,13 +907,13 @@ type ClusterConfig = else "Could not parse empty HostGroupFB" |> Error.asParseError "Cluster.FromFB" - |> Either.fail + |> Result.fail #endif groups.[idx] <- group return (idx + 1, groups) }) - (Right(0, arr)) + (Ok(0, arr)) arr let! id = Id.decodeId fb @@ -1057,16 +1057,16 @@ type DiscoConfig = // ** FromFB static member FromFB(fb: ConfigFB) = - either { + result { let version = fb.Version let! site = try if fb.ActiveSiteLength = 0 - then Either.succeed None - else Id.decodeActiveSite fb |> Either.map Some + then Result.succeed None + else Id.decodeActiveSite fb |> Result.map Some with exn -> - Either.succeed None + Result.succeed None let! machine = #if FABLE_COMPILER @@ -1079,7 +1079,7 @@ type DiscoConfig = else "Unable to parse empty DiscoMachineFB value" |> Error.asParseError "DiscoConfig.FromFB" - |> Either.fail + |> Result.fail #endif let! audio = @@ -1093,7 +1093,7 @@ type DiscoConfig = else "Could not parse empty AudioConfigFB" |> Error.asParseError "DiscoConfig.FromFB" - |> Either.fail + |> Result.fail #endif let! clients = @@ -1107,7 +1107,7 @@ type DiscoConfig = else "Could not parse empty ClientConfigFB" |> Error.asParseError "DiscoConfig.FromFB" - |> Either.fail + |> Result.fail #endif let! raft = @@ -1121,7 +1121,7 @@ type DiscoConfig = else "Could not parse empty RaftConfigFB" |> Error.asParseError "DiscoConfig.FromFB" - |> Either.fail + |> Result.fail #endif let! timing = @@ -1135,13 +1135,13 @@ type DiscoConfig = else "Could not parse empty TimingConfigFB" |> Error.asParseError "DiscoConfig.FromFB" - |> Either.fail + |> Result.fail #endif let! (_, sites) = Array.fold - (fun (m: Either>) _ -> - either { + (fun (m: DiscoResult>) _ -> + result { let! (idx, sites) = m let! site = #if FABLE_COMPILER @@ -1155,11 +1155,11 @@ type DiscoConfig = else "Could not parse empty ClusterConfigFB" |> Error.asParseError "DiscoConfig.FromFB" - |> Either.fail + |> Result.fail #endif return (idx + 1, Map.add site.Id site sites) }) - (Right(0, Map.empty)) + (Ok(0, Map.empty)) [| 0 .. fb.SitesLength - 1 |] return { @@ -1296,22 +1296,22 @@ module ProjectYaml = // ** parseTuple - let internal parseTuple (input: string) : Either = + let internal parseTuple (input: string) : DiscoResult = input.Split [| '('; ','; ' '; ')' |] // split the string according to the specified chars |> Array.filter (String.length >> ((<) 0)) // filter out elements that have zero length |> fun parsed -> try match parsed with - | [| x; y |] -> Right (int x, int y) + | [| x; y |] -> Ok (int x, int y) | _ -> sprintf "Cannot parse %A as (int * int) tuple" input |> Error.asParseError "Config.parseTuple" - |> Either.fail + |> Result.fail with | exn -> sprintf "Cannot parse %A as (int * int) tuple: %s" input exn.Message |> Error.asParseError "Config.parseTuple" - |> Either.fail + |> Result.fail // ** parseStringProp @@ -1325,8 +1325,8 @@ module ProjectYaml = /// Parses the Audio configuration section of the passed-in configuration file. /// /// # Returns: AudioConfig - let internal parseAudio (config: DiscoProjectYaml) : Either = - Either.tryWith (Error.asParseError "Config.parseAudio") <| fun _ -> + let internal parseAudio (config: DiscoProjectYaml) : DiscoResult = + Result.tryWith (Error.asParseError "Config.parseAudio") <| fun _ -> { SampleRate = uint32 config.Audio.SampleRate } // ** saveAudio @@ -1344,8 +1344,8 @@ module ProjectYaml = // ** parseExecutable - let internal parseExecutable (exe: ClientExecutableYaml) : Either = - either { + let internal parseExecutable (exe: ClientExecutableYaml) : DiscoResult = + result { let! id = DiscoId.TryParse exe.Id return { Id = id @@ -1357,16 +1357,16 @@ module ProjectYaml = // ** parseClients - let internal parseClients (file: DiscoProjectYaml) : Either = - either { + let internal parseClients (file: DiscoProjectYaml) : DiscoResult = + result { let! executables = Seq.fold - (fun (m: Either>) exe -> either { + (fun (m: DiscoResult>) exe -> result { let! exes = m let! exe = parseExecutable exe return Map.add exe.Id exe exes }) - (Right Map.empty) + (Ok Map.empty) file.Clients return ClientConfig executables } @@ -1398,8 +1398,8 @@ module ProjectYaml = /// Parses the passed-in configuration file contents and returns a `RaftConfig` value. /// /// Returns: RaftConfig - let internal parseRaft (config: DiscoProjectYaml) : Either = - either { + let internal parseRaft (config: DiscoProjectYaml) : DiscoResult = + result { let! loglevel = Disco.Core.LogLevel.TryParse config.Engine.LogLevel try @@ -1416,7 +1416,7 @@ module ProjectYaml = return! sprintf "Could not parse Engine config: %s" exn.Message |> Error.asParseError "Config.parseRaft" - |> Either.fail + |> Result.fail } // ** saveRaft @@ -1452,8 +1452,8 @@ module ProjectYaml = /// Parse TimingConfig related values into a TimingConfig value and return it. /// /// # Returns: TimingConfig - let internal parseTiming (config: DiscoProjectYaml) : Either = - either { + let internal parseTiming (config: DiscoProjectYaml) : DiscoResult = + result { let timing = config.Timing let arr = timing.Servers @@ -1462,13 +1462,13 @@ module ProjectYaml = let! (_,servers) = Seq.fold - (fun (m: Either) thing -> either { + (fun (m: DiscoResult) thing -> result { let! (idx, lst) = m let! server = IpAddress.TryParse thing lst.[idx] <- server return (idx + 1, lst) }) - (Right(0, arr)) + (Ok(0, arr)) timing.Servers try @@ -1483,7 +1483,7 @@ module ProjectYaml = return! sprintf "Could not parse Timing config: %s" exn.Message |> Error.asParseError "Config.parseTiming" - |> Either.fail + |> Result.fail } // ** saveTiming @@ -1508,7 +1508,7 @@ module ProjectYaml = // ** parseMember let internal parseMember (yaml:ClusterMemberYaml) = - either { + result { let! id = DiscoId.TryParse yaml.Id let! ip = IpAddress.TryParse yaml.IpAddress let! mcastip = IpAddress.TryParse yaml.MulticastAddress @@ -1557,17 +1557,17 @@ module ProjectYaml = /// ### Signature: /// - mems: MemberYaml collection /// - /// Returns: Either - let internal parseMembers mems : Either> = - either { + /// Returns: DiscoResult + let internal parseMembers mems : DiscoResult> = + result { let! (_,mems) = Seq.fold - (fun (m: Either>) mem -> either { + (fun (m: DiscoResult>) mem -> result { let! (idx, mems) = m let! mem = parseMember mem return (idx + 1, Map.add mem.Id mem mems) }) - (Right(0, Map.empty)) + (Ok(0, Map.empty)) mems return mems @@ -1575,8 +1575,8 @@ module ProjectYaml = // ** parseGroup - let internal parseGroup (group: GroupYaml) : Either = - either { + let internal parseGroup (group: GroupYaml) : DiscoResult = + result { let ids = Seq.map (string >> DiscoId.Parse) group.Members |> Seq.toArray return { Name = name group.Name @@ -1586,8 +1586,8 @@ module ProjectYaml = // ** parseGroups - let internal parseGroups groups : Either = - either { + let internal parseGroups groups : DiscoResult = + result { let arr = groups |> Seq.length @@ -1595,13 +1595,13 @@ module ProjectYaml = let! (_, groups) = Seq.fold - (fun (m: Either) group -> either { + (fun (m: DiscoResult) group -> result { let! (idx, groups) = m let! group = parseGroup group groups.[idx] <- group return (idx + 1, groups) }) - (Right(0,arr)) + (Ok(0,arr)) groups return groups @@ -1616,8 +1616,8 @@ module ProjectYaml = /// /// # Returns: Cluster - let internal parseCluster (cluster: SiteYaml) : Either = - either { + let internal parseCluster (cluster: SiteYaml) : DiscoResult = + result { let! groups = parseGroups cluster.Groups let! mems = parseMembers cluster.Members let! id = DiscoId.TryParse cluster.Id @@ -1632,16 +1632,16 @@ module ProjectYaml = // ** parseSites let internal parseSites (config: DiscoProjectYaml) = - either { + result { let! (_, sites) = Seq.fold - (fun (m: Either>) cfg -> - either { + (fun (m: DiscoResult>) cfg -> + result { let! (idx, sites) = m let! site = parseCluster cfg return (idx + 1, Map.add site.Id site sites) }) - (Right(0, Map.empty)) + (Ok(0, Map.empty)) config.Sites return sites } @@ -1724,12 +1724,12 @@ module ProjectYaml = try str |> Yaml.deserialize - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asParseError "ProjectYaml.parse" - |> Either.fail + |> Result.fail #endif @@ -1754,8 +1754,8 @@ module Config = let fromFile (file: ProjectYaml.DiscoProjectYaml) (machine: DiscoMachine) - : Either = - either { + : DiscoResult = + result { let version = file.Version let! raftcfg = ProjectYaml.parseRaft file let! timing = ProjectYaml.parseTiming file @@ -1765,8 +1765,8 @@ module Config = let! site = if isNull file.ActiveSite || file.ActiveSite = "" - then Right None - else DiscoId.TryParse file.ActiveSite |> Either.map Some + then Ok None + else DiscoId.TryParse file.ActiveSite |> Result.map Some return { Machine = machine @@ -1857,25 +1857,25 @@ module Config = match Map.tryFind active config.Sites with | Some cluster -> match Map.tryFind id cluster.Members with - | Some mem -> Either.succeed mem + | Some mem -> Result.succeed mem | _ -> ErrorMessages.PROJECT_MISSING_MEMBER + ": " + (string id) |> Error.asProjectError "Config.findMember" - |> Either.fail + |> Result.fail | _ -> ErrorMessages.PROJECT_MISSING_CLUSTER + ": " + (string active) |> Error.asProjectError "Config.findMember" - |> Either.fail + |> Result.fail | None -> ErrorMessages.PROJECT_NO_ACTIVE_CONFIG |> Error.asProjectError "Config.findMember" - |> Either.fail + |> Result.fail // ** tryFindMember let tryFindMember (config: DiscoConfig) (id: MemberId) = match findMember config id with - | Right mem -> Some mem + | Ok mem -> Some mem | _ -> None // ** getMembers @@ -1884,25 +1884,25 @@ module Config = match config.ActiveSite with | Some active -> match Map.tryFind active config.Sites with - | Some site -> site.Members |> Either.succeed + | Some site -> site.Members |> Result.succeed | None -> ErrorMessages.PROJECT_MISSING_CLUSTER + ": " + (string active) |> Error.asProjectError "Config.getMembers" - |> Either.fail + |> Result.fail | None -> ErrorMessages.PROJECT_NO_ACTIVE_CONFIG |> Error.asProjectError "Config.getMembers" - |> Either.fail + |> Result.fail // ** setActiveSite let setActiveSite (id: SiteId) (config: DiscoConfig) = if Map.containsKey id config.Sites - then Right { config with ActiveSite = Some id } + then Ok { config with ActiveSite = Some id } else ErrorMessages.PROJECT_MISSING_MEMBER + ": " + (string id) |> Error.asProjectError "Config.setActiveSite" - |> Either.fail + |> Result.fail // ** getActiveSite @@ -1938,7 +1938,7 @@ module Config = // ** validateSettings /// Cross-check the settins in a given cluster member definition with this machines settings - let validateSettings (mem: ClusterMember) (machine:DiscoMachine): Either = + let validateSettings (mem: ClusterMember) (machine:DiscoMachine): DiscoResult = let errorMsg tag a b = sprintf "Member %s: %O is different from Machine %s: %O\n" tag a tag b let errors = [ @@ -1954,12 +1954,12 @@ module Config = yield errorMsg "WS Post" mem.WsPort machine.WsPort ] if List.isEmpty errors - then Either.nothing + then Result.nothing else errors |> List.fold ((+)) "" |> Error.asProjectError (tag "validateSettings") - |> Either.fail + |> Result.fail // ** addSitePrivate @@ -2165,7 +2165,7 @@ Config: %A // |_____\___/ \__,_|\__,_| static member Load (basepath: FilePath, machine: DiscoMachine) = - either { + result { let filename = PROJECT_FILENAME + ASSET_EXTENSION let normalizedPath = @@ -2183,7 +2183,7 @@ Config: %A return! sprintf "Project Not Found: %O" normalizedPath |> Error.asProjectError "Project.load" - |> Either.fail + |> Result.fail else let! project = DiscoData.load normalizedPath return @@ -2257,26 +2257,26 @@ Config: %A // ** FromFB static member FromFB(fb: ProjectFB) = - either { + result { let nll = sprintf "%A" null let! lastsaved = match fb.LastSaved with - | null -> Right None - | value when value = nll -> Right (Some null) - | date -> Right (Some date) + | null -> Ok None + | value when value = nll -> Ok (Some null) + | date -> Ok (Some date) let! copyright = match fb.Copyright with - | null -> Right None - | value when value = nll -> Right (Some null) - | str -> Right (Some str) + | null -> Ok None + | value when value = nll -> Ok (Some null) + | str -> Ok (Some str) let! author = match fb.Author with - | null -> Right None - | value when value = nll -> Right (Some null) - | str -> Right (Some str) + | null -> Ok None + | value when value = nll -> Ok (Some null) + | str -> Ok (Some str) let! config = #if FABLE_COMPILER @@ -2289,7 +2289,7 @@ Config: %A else "Could not parse empty ConfigFB" |> Error.asParseError "DiscoProject.FromFB" - |> Either.fail + |> Result.fail #endif let! id = Id.decodeId fb @@ -2346,7 +2346,7 @@ Config: %A // ** FromYaml static member FromYaml(meta: ProjectYaml.DiscoProjectYaml) = - either { + result { let lastSaved = match meta.LastSaved with | null | "" -> None @@ -2427,7 +2427,7 @@ module Project = #if !FABLE_COMPILER && !DISCO_NODES let currentBranch (project: DiscoProject) = - either { + result { let! repo = repository project return Git.Branch.current repo } @@ -2439,7 +2439,7 @@ module Project = #if !FABLE_COMPILER && !DISCO_NODES let checkoutBranch (name: string) (project: DiscoProject) = - either { + result { let! repo = repository project return! Git.Repo.checkout name repo } @@ -2462,9 +2462,9 @@ module Project = if File.exists path |> not then sprintf "Project Not Found: %O" projectName |> Error.asProjectError (tag "checkPath") - |> Either.fail + |> Result.fail else - Either.succeed path + Result.succeed path #endif @@ -2493,7 +2493,7 @@ module Project = #if !FABLE_COMPILER && !DISCO_NODES let private writeDaemonExportFile (repo: Repository) = - either { + result { let path = repo.Info.Path <.> "git-daemon-export-ok" let! _ = DiscoData.write path (Payload "") return () @@ -2506,7 +2506,7 @@ module Project = #if !FABLE_COMPILER && !DISCO_NODES let private writeGitIgnoreFile (repo: Repository) = - either { + result { let parent = Git.Repo.parentPath repo let path = parent filepath ".gitignore" let! _ = DiscoData.write path (Payload GITIGNORE) @@ -2520,7 +2520,7 @@ module Project = #if !FABLE_COMPILER && !DISCO_NODES let private createAssetDir (repo: Repository) (dir: FilePath) = - either { + result { let parent = Git.Repo.parentPath repo let target = parent dir do! FileSystem.mkDir target @@ -2550,8 +2550,8 @@ module Project = (committer: Signature) (msg : string) (project: DiscoProject) : - Either = - either { + DiscoResult = + result { let! repo = repository project let abspath = if Path.isPathRooted filepath then @@ -2574,9 +2574,9 @@ module Project = (committer: Signature) (msg : string) (project: DiscoProject) : - Either = + DiscoResult = - either { + result { let info = File.info path do! info.Directory.FullName |> filepath |> FileSystem.mkDir let! _ = DiscoData.write path (Payload contents) @@ -2593,8 +2593,8 @@ module Project = (committer: Signature) (msg : string) (project: DiscoProject) : - Either = - either { + DiscoResult = + result { let! _ = DiscoData.remove path return! commitPath path committer msg project } @@ -2615,7 +2615,7 @@ module Project = /// - committer: User the thing to save. Must implement certain methods/getters /// - project: Project to save file into /// - /// Returns: Either + /// Returns: DiscoResult let inline saveAsset (thing: ^t) (committer: User) (project: DiscoProject) = let payload = thing |> Yaml.encode let filepath = project.Path Asset.path thing @@ -2639,7 +2639,7 @@ module Project = /// - msg: User committing the change /// - project: DiscoProject to work on /// - /// Returns: Either + /// Returns: DiscoResult let inline deleteAsset (thing: ^t) (committer: User) (project: DiscoProject) = let filepath = project.Path Asset.path thing let signature = committer.Signature @@ -2672,15 +2672,15 @@ module Project = /// exists, otherwise creating it. /// /// # Returns: Repository - let private initRepo (project: DiscoProject) : Either = - either { + let private initRepo (project: DiscoProject) : DiscoResult = + result { let! repo = project.Path |> Git.Repo.init do! writeDaemonExportFile repo do! Git.Repo.setReceivePackConfig repo do! writeGitIgnoreFile repo do! List.fold - (fun m dir -> Either.bind (fun () -> createAssetDir repo (filepath dir)) m) - Either.nothing + (fun m dir -> Result.bind (fun () -> createAssetDir repo (filepath dir)) m) + Result.nothing Constants.GLOBAL_ASSET_DIRS let relPath = Asset.path User.Admin let absPath = project.Path relPath @@ -2705,7 +2705,7 @@ module Project = /// /// # Returns: DiscoProject let create (path: FilePath) (projectName: string) (machine: DiscoMachine) = - either { + result { let project = { Id = DiscoId.Create() Name = Measure.name projectName @@ -2780,16 +2780,16 @@ module Project = /// Using the current active site configuration, update git remotes to reflect the configured /// members' details. This allows the service to use `git push` to those peers. - let updateRemotes (project: DiscoProject) = either { + let updateRemotes (project: DiscoProject) = result { let! repo = repository project // delete all current remotes let current = Git.Config.remotes repo do! Map.fold - (fun kontinue name _ -> either { + (fun kontinue name _ -> result { do! kontinue do! Git.Config.delRemote repo name }) - (Right ()) + (Ok ()) current let! mem = Config.selfMember project.Config @@ -2798,18 +2798,18 @@ module Project = do! match Config.getActiveSite project.Config with | Some cluster -> Map.fold - (fun kontinue id peer -> either { + (fun kontinue id peer -> result { do! kontinue if id <> mem.Id then let url = Uri.gitUri project.Name peer.IpAddress peer.GitPort let name = string peer.Id do! Git.Config.addRemote repo name url - |> Either.iterError (string >> Logger.err (tag "updateRemotes")) - |> Either.succeed + |> Result.iterError (string >> Logger.err (tag "updateRemotes")) + |> Result.succeed }) - (Right ()) + (Ok ()) cluster.Members - | None -> Either.nothing + | None -> Result.nothing } #endif diff --git a/src/Disco/Disco/Core/Property.fs b/src/Disco/Disco/Core/Property.fs index 6a926674..13982266 100644 --- a/src/Disco/Disco/Core/Property.fs +++ b/src/Disco/Disco/Core/Property.fs @@ -68,7 +68,7 @@ type Property = static member FromFB(fb: KeyValueFB) = { Key = fb.Key; Value = fb.Value } - |> Either.succeed + |> Result.succeed // ** ToYaml @@ -79,14 +79,14 @@ type Property = // ** FromYaml - static member FromYaml(yml: PropertyYaml) : Either = + static member FromYaml(yml: PropertyYaml) : DiscoResult = try { Key = yml.Key; Value = yml.Value } - |> Either.succeed + |> Result.succeed with | exn -> ("Property.FromYaml",sprintf "Could not parse PropteryYaml: %s" exn.Message) |> ParseError - |> Either.fail + |> Result.fail #endif diff --git a/src/Disco/Disco/Core/Serialization.fs b/src/Disco/Disco/Core/Serialization.fs index c76a2564..9d6959d7 100644 --- a/src/Disco/Disco/Core/Serialization.fs +++ b/src/Disco/Disco/Core/Serialization.fs @@ -21,12 +21,12 @@ open FlatBuffers #endif -// * EitherExt module +// * ResultExt module [] -module EitherExt = +module ResultExt = - let bindGeneratorToArray loc length generator (f: 'a -> Either) = + let bindGeneratorToArray loc length generator (f: 'a -> DiscoResult<'b>) = let mutable i = 0 let mutable error = None let arr = Array.zeroCreate length @@ -41,11 +41,11 @@ module EitherExt = let item = generator i #endif match f item with - | Right value -> arr.[i] <- value; i <- i + 1 - | Left err -> error <- Some err + | Ok value -> arr.[i] <- value; i <- i + 1 + | Error err -> error <- Some err match error with - | Some err -> Left err - | None -> Right arr + | Some err -> Error err + | None -> Ok arr // * Binary module @@ -75,16 +75,16 @@ module Binary = // ** decode - let inline decode< ^t when ^t : (static member FromBytes : byte[] -> Either)> + let inline decode< ^t when ^t : (static member FromBytes : byte[] -> DiscoResult< ^t >)> (bytes: byte[]) : - Either = + DiscoResult< ^t > = try - (^t : (static member FromBytes : byte[] -> Either) bytes) + (^t : (static member FromBytes : byte[] -> DiscoResult< ^t >) bytes) with | exn -> ((typeof< ^t >).Name + ".FromBytes", exn.Message) |> ParseError - |> Either.fail + |> Result.fail // ** toOffset @@ -145,9 +145,9 @@ module Yaml = // ** fromYaml - let inline fromYaml< ^err, ^a, ^t when ^t : (static member FromYaml : ^a -> Either< ^err, ^t >)> + let inline fromYaml< ^err, ^a, ^t when ^t : (static member FromYaml : ^a -> Result< ^t,^err >)> (thing: ^a) = - (^t : (static member FromYaml : ^a -> Either< ^err, ^t >) thing) + (^t : (static member FromYaml : ^a -> Result< ^t,^err >) thing) // ** encode @@ -156,14 +156,14 @@ module Yaml = // ** decode - let inline decode< ^a, ^t when ^t : (static member FromYaml: ^a -> Either)> + let inline decode< ^a, ^t when ^t : (static member FromYaml: ^a -> DiscoResult< ^t >)> (str: string) = try let thing = str |> deserialize< ^a > - (^t : (static member FromYaml : ^a -> Either) thing) + (^t : (static member FromYaml : ^a -> DiscoResult< ^t >) thing) with exn -> exn.Message |> Error.asParseError "Yaml.decode" - |> Either.fail + |> Result.fail #endif diff --git a/src/Disco/Disco/Core/Session.fs b/src/Disco/Disco/Core/Session.fs index 35bb71e2..2758f69c 100644 --- a/src/Disco/Disco/Core/Session.fs +++ b/src/Disco/Disco/Core/Session.fs @@ -79,8 +79,8 @@ type Session = // |____/|_|_| |_|\__,_|_| \__, | // |___/ - static member FromFB(fb: SessionFB) : Either = - either { + static member FromFB(fb: SessionFB) : DiscoResult = + result { let! ip = IpAddress.TryParse fb.IpAddress let! id = Id.decodeId fb return { @@ -92,7 +92,7 @@ type Session = // ** FromBytes - static member FromBytes(bytes: byte[]) : Either = + static member FromBytes(bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> SessionFB.GetRootAsSessionFB |> Session.FromFB @@ -132,7 +132,7 @@ type Session = // ** FromYaml static member FromYaml (yml: SessionYaml) = - either { + result { let! ip = IpAddress.TryParse yml.IpAddress let! id = DiscoId.TryParse yml.Id return { diff --git a/src/Disco/Disco/Core/StateMachine.fs b/src/Disco/Disco/Core/StateMachine.fs index 451a910b..a336ac33 100644 --- a/src/Disco/Disco/Core/StateMachine.fs +++ b/src/Disco/Disco/Core/StateMachine.fs @@ -86,7 +86,7 @@ type AppCommand = // ** TryParse static member TryParse (str: string) = - Either.tryWith (Error.asParseError "AppCommand.TryParse") <| fun _ -> + Result.tryWith (Error.asParseError "AppCommand.TryParse") <| fun _ -> str |> AppCommand.Parse // ** FromFB @@ -94,24 +94,24 @@ type AppCommand = static member FromFB (fb: StateMachineActionFB) = #if FABLE_COMPILER match fb with - | x when x = StateMachineActionFB.UndoFB -> Right Undo - | x when x = StateMachineActionFB.RedoFB -> Right Redo - | x when x = StateMachineActionFB.ResetFB -> Right Reset - | x when x = StateMachineActionFB.SaveFB -> Right Save + | x when x = StateMachineActionFB.UndoFB -> Ok Undo + | x when x = StateMachineActionFB.RedoFB -> Ok Redo + | x when x = StateMachineActionFB.ResetFB -> Ok Reset + | x when x = StateMachineActionFB.SaveFB -> Ok Save | x -> sprintf "Could not parse %A as AppCommand" x |> Error.asParseError "AppCommand.FromFB" - |> Either.fail + |> Result.fail #else match fb with - | StateMachineActionFB.UndoFB -> Right Undo - | StateMachineActionFB.RedoFB -> Right Redo - | StateMachineActionFB.ResetFB -> Right Reset - | StateMachineActionFB.SaveFB -> Right Save + | StateMachineActionFB.UndoFB -> Ok Undo + | StateMachineActionFB.RedoFB -> Ok Redo + | StateMachineActionFB.ResetFB -> Ok Reset + | StateMachineActionFB.SaveFB -> Ok Save | x -> sprintf "Could not parse %A as AppCommand" x |> Error.asParseError "AppCommand.FromFB" - |> Either.fail + |> Result.fail #endif // ** ToOffset @@ -254,8 +254,8 @@ type State = #if !FABLE_COMPILER && !DISCO_NODES static member Load (path: FilePath, machine: DiscoMachine) = - either { - let inline toMap value = Either.map (Array.map toPair >> Map.ofArray) value + result { + let inline toMap value = Result.map (Array.map toPair >> Map.ofArray) value let! project = Asset.loadWithMachine path machine let! groups = Asset.load project.Path let! widgets = Asset.loadAll project.Path |> toMap @@ -293,13 +293,13 @@ type State = #if !FABLE_COMPILER && !DISCO_NODES member state.Save (basePath: FilePath) = - either { - do! Map.fold (Asset.saveMap basePath) Either.nothing state.PinMappings - do! Map.fold (Asset.saveMap basePath) Either.nothing state.PinWidgets - do! Map.fold (Asset.saveMap basePath) Either.nothing state.Cues - do! Map.fold (Asset.saveMap basePath) Either.nothing state.CueLists - do! Map.fold (Asset.saveMap basePath) Either.nothing state.Users - do! Map.fold (Asset.saveMap basePath) Either.nothing state.CuePlayers + result { + do! Map.fold (Asset.saveMap basePath) Result.nothing state.PinMappings + do! Map.fold (Asset.saveMap basePath) Result.nothing state.PinWidgets + do! Map.fold (Asset.saveMap basePath) Result.nothing state.Cues + do! Map.fold (Asset.saveMap basePath) Result.nothing state.CueLists + do! Map.fold (Asset.saveMap basePath) Result.nothing state.Users + do! Map.fold (Asset.saveMap basePath) Result.nothing state.CuePlayers do! Asset.save basePath state.PinGroups do! Asset.save basePath state.Project } @@ -390,8 +390,8 @@ type State = // ** FromFB - static member FromFB(fb: StateFB) : Either = - either { + static member FromFB(fb: StateFB) : DiscoResult< State> = + result { // PROJECT let! project = @@ -405,7 +405,7 @@ type State = else "Could not parse empty ProjectFB" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif // GROUPS @@ -421,7 +421,7 @@ type State = else "Could not parse empty group map payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif // MAPPINGS @@ -429,7 +429,7 @@ type State = let! mappings = let arr = Array.zeroCreate fb.PinMappingsLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -443,21 +443,21 @@ type State = else "Could not parse empty PinMapping payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add group.Id group map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // WIDGETS let! widgets = let arr = Array.zeroCreate fb.PinWidgetsLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -471,21 +471,21 @@ type State = else "Could not parse empty PinWidget payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add group.Id group map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // CUES let! cues = let arr = Array.zeroCreate fb.CuesLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -499,21 +499,21 @@ type State = else "Could not parse empty Cue payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add cue.Id cue map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // CUES let! fsTrees = let arr = Array.zeroCreate fb.FsTreesLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -527,21 +527,21 @@ type State = else "Could not parse empty FsTree payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add fsTree.HostId fsTree map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // CUELISTS let! cuelists = let arr = Array.zeroCreate fb.CueListsLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -555,21 +555,21 @@ type State = else "Could not parse empty CueList payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add cuelist.Id cuelist map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // USERS let! users = let arr = Array.zeroCreate fb.UsersLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -583,21 +583,21 @@ type State = else "Could not parse empty User payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add user.Id user map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // SESSIONS let! sessions = let arr = Array.zeroCreate fb.SessionsLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -611,21 +611,21 @@ type State = else "Could not parse empty Session payload" |> Error.asParseError "State.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add session.Id session map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // CLIENTS let! clients = let arr = Array.zeroCreate fb.ClientsLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -639,21 +639,21 @@ type State = else "Could not parse empty Client payload" |> Error.asParseError "Client.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add client.Id client map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // PLAYERS let! players = let arr = Array.zeroCreate fb.CuePlayersLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -667,21 +667,21 @@ type State = else "Could not parse empty CuePlayer payload" |> Error.asParseError "CuePlayer.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add player.Id player map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd // DISCOVERED SERVICES let! discoveredServices = let arr = Array.zeroCreate fb.DiscoveredServicesLength Array.fold - (fun (m: Either>) _ -> either { + (fun (m: DiscoResult>) _ -> result { let! (i, map) = m #if FABLE_COMPILER @@ -695,14 +695,14 @@ type State = else "Could not parse empty DiscoveredService payload" |> Error.asParseError "DiscoveredService.FromFB" - |> Either.fail + |> Result.fail #endif return (i + 1, Map.add service.Id service map) }) - (Right (0, Map.empty)) + (Ok (0, Map.empty)) arr - |> Either.map snd + |> Result.map snd return { Project = project @@ -722,7 +722,7 @@ type State = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> StateFB.GetRootAsStateFB |> State.FromFB @@ -1608,23 +1608,23 @@ type Transaction = Transaction of StateMachine list // ** FromFB static member FromFB(batch: TransactionFB) = - either { + result { let input = Array.zeroCreate batch.CommandsLength let! (_,commands) = #if FABLE_COMPILER Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult< int * StateMachine array>) _ -> result { let! (idx, arr) = m let! cmd = batch.Commands(idx) |> StateMachine.FromFB do arr.[idx] <- cmd return (idx + 1, arr) }) - (Right (0, input)) + (Ok (0, input)) input #else Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult< int * StateMachine array>) _ -> result { let! (idx, arr) = m let cmdish = batch.Commands(idx) if cmdish.HasValue then @@ -1636,9 +1636,9 @@ type Transaction = Transaction of StateMachine list return! "Could not parse empty CommandBatch *value* payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail }) - (Right (0, input)) + (Ok (0, input)) input #endif return Transaction (List.ofArray commands) @@ -1677,7 +1677,7 @@ type SlicesMap = SlicesMap of Map static member FromFB(fb: SlicesMapFB) = [ 0 .. fb.SlicesLength - 1 ] |> List.fold - (fun (m: Either>) (idx: int) -> either { + (fun (m: DiscoResult>) (idx: int) -> result { let! output = m #if FABLE_COMPILER let! parsed = fb.Slices(idx) |> Slices.FromFB @@ -1692,11 +1692,11 @@ type SlicesMap = SlicesMap of Map return! "Could not parse empty SlicesFB value" |> Error.asParseError "SlicesMap" - |> Either.fail + |> Result.fail #endif }) - (Right Map.empty) - |> Either.map SlicesMap + (Ok Map.empty) + |> Result.map SlicesMap // * SlicesMap module @@ -2246,13 +2246,13 @@ type StateMachine = match fb.Action with | x when x = StateMachineActionFB.UpdateFB -> let project = fb.ProjectFB |> DiscoProject.FromFB - Either.map UpdateProject project + Result.map UpdateProject project | x when x = StateMachineActionFB.RemoveFB -> - Right UnloadProject + Ok UnloadProject | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // __ __ _ // | \/ | ___ _ __ ___ | |__ ___ _ __ @@ -2263,15 +2263,15 @@ type StateMachine = let mem = fb.RaftMemberFB |> RaftMember.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddMachine mem + Result.map AddMachine mem | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateMachine mem + Result.map UpdateMachine mem | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveMachine mem + Result.map RemoveMachine mem | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // __ __ _ // | \/ | ___ _ __ ___ | |__ ___ _ __ @@ -2282,15 +2282,15 @@ type StateMachine = let mem = fb.ClusterMemberFB |> ClusterMember.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddMember mem + Result.map AddMember mem | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateMember mem + Result.map UpdateMember mem | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveMember mem + Result.map RemoveMember mem | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ _ _ // / ___| (_) ___ _ __ | |_ @@ -2301,15 +2301,15 @@ type StateMachine = let client = fb.DiscoClientFB |> DiscoClient.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddClient client + Result.map AddClient client | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateClient client + Result.map UpdateClient client | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveClient client + Result.map RemoveClient client | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ // / ___|_ __ ___ _ _ _ __ @@ -2321,15 +2321,15 @@ type StateMachine = let group = fb.PinGroupFB |> PinGroup.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddPinGroup group + Result.map AddPinGroup group | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdatePinGroup group + Result.map UpdatePinGroup group | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemovePinGroup group + Result.map RemovePinGroup group | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // __ __ _ // | \/ | __ _ _ __ _ __ (_)_ __ __ _ @@ -2341,15 +2341,15 @@ type StateMachine = let mapping = fb.PinMappingFB |> PinMapping.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddPinMapping mapping + Result.map AddPinMapping mapping | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdatePinMapping mapping + Result.map UpdatePinMapping mapping | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemovePinMapping mapping + Result.map RemovePinMapping mapping | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // __ ___ _ _ // \ \ / (_) __| | __ _ ___| |_ @@ -2361,15 +2361,15 @@ type StateMachine = let widget = fb.PinWidgetFB |> PinWidget.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddPinWidget widget + Result.map AddPinWidget widget | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdatePinWidget widget + Result.map UpdatePinWidget widget | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemovePinWidget widget + Result.map RemovePinWidget widget | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ // | _ \(_)_ __ @@ -2380,15 +2380,15 @@ type StateMachine = let pin = fb.PinFB |> Pin.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddPin pin + Result.map AddPin pin | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdatePin pin + Result.map UpdatePin pin | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemovePin pin + Result.map RemovePin pin | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ _ // / ___|| (_) ___ ___ ___ @@ -2399,11 +2399,11 @@ type StateMachine = let slices = fb.SlicesMapFB |> SlicesMap.FromFB match fb.Action with | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateSlices slices + Result.map UpdateSlices slices | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ // / ___| _ ___ @@ -2414,15 +2414,15 @@ type StateMachine = let cue = fb.CueFB |> Cue.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddCue cue + Result.map AddCue cue | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateCue cue + Result.map UpdateCue cue | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveCue cue + Result.map RemoveCue cue | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ _ _ // / ___| _ ___| | (_)___| |_ @@ -2433,15 +2433,15 @@ type StateMachine = let cuelist = fb.CueListFB |> CueList.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddCueList cuelist + Result.map AddCueList cuelist | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateCueList cuelist + Result.map UpdateCueList cuelist | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveCueList cuelist + Result.map RemoveCueList cuelist | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ ____ _ // / ___| _ ___| _ \| | __ _ _ _ ___ _ __ @@ -2453,15 +2453,15 @@ type StateMachine = let cuelist = fb.CuePlayerFB |> CuePlayer.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddCuePlayer cuelist + Result.map AddCuePlayer cuelist | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateCuePlayer cuelist + Result.map UpdateCuePlayer cuelist | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveCuePlayer cuelist + Result.map RemoveCuePlayer cuelist | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // _ _ // | | | |___ ___ _ __ @@ -2472,15 +2472,15 @@ type StateMachine = let user = fb.UserFB |> User.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddUser user + Result.map AddUser user | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateUser user + Result.map UpdateUser user | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveUser user + Result.map RemoveUser user | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ // / ___| ___ ___ ___(_) ___ _ __ @@ -2491,15 +2491,15 @@ type StateMachine = let session = fb.SessionFB |> Session.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddSession session + Result.map AddSession session | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateSession session + Result.map UpdateSession session | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveSession session + Result.map RemoveSession session | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail /// _____ _____ _ /// | ___|__| ____|_ __ | |_ _ __ _ _ @@ -2511,19 +2511,19 @@ type StateMachine = let fsEntryUpdate = fb.FsEntryUpdateFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - either { + result { let! id = Id.decodeHostId fsEntryUpdate let! entry = FsEntry.FromFB fsEntryUpdate.Entry return AddFsEntry (id,entry) } | x when x = StateMachineActionFB.UpdateFB -> - either { + result { let! id = Id.decodeHostId fsEntryUpdate let! entry = FsEntry.FromFB fsEntryUpdate.Entry return UpdateFsEntry (id,entry) } | x when x = StateMachineActionFB.RemoveFB -> - either { + result { let! id = Id.decodeHostId fsEntryUpdate let! path = FsPath.FromFB fsEntryUpdate.Path return RemoveFsEntry (id,path) @@ -2531,7 +2531,7 @@ type StateMachine = | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail /// _____ _____ /// | ___|_|_ _| __ ___ ___ @@ -2542,19 +2542,19 @@ type StateMachine = let fsTreeUpdate = fb.FsTreeUpdateFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - either { + result { let! tree = FsTree.FromFB fsTreeUpdate.Tree return AddFsTree tree } | x when x = StateMachineActionFB.RemoveFB -> - either { + result { let! hostId = Id.decodeHostId fsTreeUpdate return RemoveFsTree hostId } | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ _ // | _ \(_)___ ___ _____ _____ _ __ ___ __| | @@ -2565,15 +2565,15 @@ type StateMachine = let discoveredService = fb.DiscoveredServiceFB |> DiscoveredService.FromFB match fb.Action with | x when x = StateMachineActionFB.AddFB -> - Either.map AddDiscoveredService discoveredService + Result.map AddDiscoveredService discoveredService | x when x = StateMachineActionFB.UpdateFB -> - Either.map UpdateDiscoveredService discoveredService + Result.map UpdateDiscoveredService discoveredService | x when x = StateMachineActionFB.RemoveFB -> - Either.map RemoveDiscoveredService discoveredService + Result.map RemoveDiscoveredService discoveredService | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ _ // / ___| _ __ __ _ _ __ ___| |__ ___ | |_ @@ -2584,7 +2584,7 @@ type StateMachine = | x when x = StateMachinePayloadFB.StateFB && fb.Action = StateMachineActionFB.DataSnapshotFB -> fb.StateFB |> State.FromFB - |> Either.map DataSnapshot + |> Result.map DataSnapshot // _ _____ _ // | | ___ __ _| ____|_ _____ _ __ | |_ @@ -2595,7 +2595,7 @@ type StateMachine = | x when x = StateMachinePayloadFB.LogEventFB -> fb.LogEventFB |> LogEvent.FromFB - |> Either.map LogMsg + |> Result.map LogMsg // ____ _ _ // / ___|| |_ _ __(_)_ __ __ _ @@ -2608,11 +2608,11 @@ type StateMachine = | x when x = StateMachineActionFB.SetLogLevelFB -> fb.StringFB.Value |> LogLevel.TryParse - |> Either.map SetLogLevel + |> Result.map SetLogLevel | x -> sprintf "Could not parse unknown StateMachineActionFB %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail // ____ _ _ // / ___| | ___ ___| | __ @@ -2621,7 +2621,7 @@ type StateMachine = // \____|_|\___/ \___|_|\_\ | x when x = StateMachinePayloadFB.ClockFB -> UpdateClock(fb.ClockFB.Value) - |> Either.succeed + |> Result.succeed // ____ _ _ // | __ ) __ _| |_ ___| |__ @@ -2629,7 +2629,7 @@ type StateMachine = // | |_) | (_| | || (__| | | | // |____/ \__,_|\__\___|_| |_| | x when x = StateMachinePayloadFB.TransactionFB -> - either { + result { let fb = fb.TransactionFB let! batch = Transaction.FromFB fb return CommandBatch batch @@ -2643,7 +2643,7 @@ type StateMachine = | _ -> fb.Action |> AppCommand.FromFB - |> Either.map Command + |> Result.map Command #else @@ -2659,7 +2659,7 @@ type StateMachine = // |_| |_| \___// |\___|\___|\__| // |__/ | StateMachinePayloadFB.ProjectFB -> - either { + result { match fb.Action with | StateMachineActionFB.UpdateFB -> let projectish = fb.Payload() @@ -2667,17 +2667,17 @@ type StateMachine = if projectish.HasValue then projectish.Value |> DiscoProject.FromFB - |> Either.map UpdateProject + |> Result.map UpdateProject else "Could not parse empty project payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail | StateMachineActionFB.RemoveFB -> return UnloadProject | x -> return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ @@ -2686,7 +2686,7 @@ type StateMachine = // | |__| |_| | __/ // \____\__,_|\___| | StateMachinePayloadFB.CueFB -> - either { + result { let! cue = let cueish = fb.Payload() if cueish.HasValue then @@ -2695,7 +2695,7 @@ type StateMachine = else "Could not parse empty cue payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddCue cue) | StateMachineActionFB.UpdateFB -> return (UpdateCue cue) @@ -2705,7 +2705,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ _ _ @@ -2714,7 +2714,7 @@ type StateMachine = // | |___| | | __/ | | | |_ // \____|_|_|\___|_| |_|\__| | StateMachinePayloadFB.DiscoClientFB -> - either { + result { let! client = let clientish = fb.Payload() if clientish.HasValue then @@ -2723,7 +2723,7 @@ type StateMachine = else "Could not parse empty client payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddClient client) | StateMachineActionFB.UpdateFB -> return (UpdateClient client) @@ -2732,7 +2732,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ _ _ @@ -2741,7 +2741,7 @@ type StateMachine = // | |__| |_| | __/ |___| \__ \ |_ // \____\__,_|\___|_____|_|___/\__| | StateMachinePayloadFB.CueListFB -> - either { + result { let! cuelist = let cuelistish = fb.Payload() if cuelistish.HasValue then @@ -2750,7 +2750,7 @@ type StateMachine = else "Could not parse empty cuelist payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddCueList cuelist) | StateMachineActionFB.UpdateFB -> return (UpdateCueList cuelist) @@ -2759,7 +2759,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ ____ _ @@ -2769,7 +2769,7 @@ type StateMachine = // \____\__,_|\___|_| |_|\__,_|\__, |\___|_| // |___/ | StateMachinePayloadFB.CuePlayerFB -> - either { + result { let! player = let playerish = fb.Payload() if playerish.HasValue then @@ -2778,7 +2778,7 @@ type StateMachine = else "Could not parse empty player payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddCuePlayer player) | StateMachineActionFB.UpdateFB -> return (UpdateCuePlayer player) @@ -2787,7 +2787,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ @@ -2797,7 +2797,7 @@ type StateMachine = // \____|_| \___/ \__,_| .__/ // |_| | StateMachinePayloadFB.PinGroupFB -> - either { + result { let! group = let groupish = fb.Payload() if groupish.HasValue then @@ -2806,7 +2806,7 @@ type StateMachine = else "Could not parse empty groupe payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddPinGroup group) | StateMachineActionFB.UpdateFB -> return (UpdatePinGroup group) @@ -2815,7 +2815,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // __ __ _ @@ -2825,7 +2825,7 @@ type StateMachine = // |_| |_|\__,_| .__/| .__/|_|_| |_|\__, | // |_| |_| |___/ | StateMachinePayloadFB.PinMappingFB -> - either { + result { let! mapping = let mappingish = fb.Payload() if mappingish.HasValue then @@ -2834,7 +2834,7 @@ type StateMachine = else "Could not parse empty mapping payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddPinMapping mapping) | StateMachineActionFB.UpdateFB -> return (UpdatePinMapping mapping) @@ -2843,7 +2843,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // __ ___ _ _ @@ -2853,7 +2853,7 @@ type StateMachine = // \_/\_/ |_|\__,_|\__, |\___|\__| // |___/ | StateMachinePayloadFB.PinWidgetFB -> - either { + result { let! widget = let widgetish = fb.Payload() if widgetish.HasValue then @@ -2862,7 +2862,7 @@ type StateMachine = else "Could not parse empty widget payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddPinWidget widget) | StateMachineActionFB.UpdateFB -> return (UpdatePinWidget widget) @@ -2871,7 +2871,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ @@ -2880,7 +2880,7 @@ type StateMachine = // | __/| | | | | // |_| |_|_| |_| | StateMachinePayloadFB.PinFB -> - either { + result { let! pin = let pinish = fb.Payload() if pinish.HasValue then @@ -2889,7 +2889,7 @@ type StateMachine = else "Could not parse empty pin payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddPin pin) | StateMachineActionFB.UpdateFB -> return (UpdatePin pin) @@ -2898,7 +2898,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ _ @@ -2907,7 +2907,7 @@ type StateMachine = // ___) | | | (_| __/\__ \ // |____/|_|_|\___\___||___/ | StateMachinePayloadFB.SlicesMapFB -> - either { + result { let! slices = let slicesMapish = fb.Payload() if slicesMapish.HasValue then @@ -2916,14 +2916,14 @@ type StateMachine = else "Could not parse empty slices payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.UpdateFB -> return (UpdateSlices slices) | x -> return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } /// __ __ _ @@ -2932,7 +2932,7 @@ type StateMachine = /// | | | | __/ | | | | | |_) | __/ | /// |_| |_|\___|_| |_| |_|_.__/ \___|_| | StateMachinePayloadFB.RaftMemberFB -> - either { + result { let! mem = let memish = fb.Payload() if memish.HasValue then @@ -2941,7 +2941,7 @@ type StateMachine = else "Could not parse empty mem payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddMachine mem) | StateMachineActionFB.UpdateFB -> return (UpdateMachine mem) @@ -2950,7 +2950,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } /// __ __ _ @@ -2959,7 +2959,7 @@ type StateMachine = /// | | | | __/ | | | | | |_) | __/ | /// |_| |_|\___|_| |_| |_|_.__/ \___|_| | StateMachinePayloadFB.ClusterMemberFB -> - either { + result { let! mem = let memish = fb.Payload() if memish.HasValue then @@ -2968,7 +2968,7 @@ type StateMachine = else "Could not parse empty mem payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddMember mem) | StateMachineActionFB.UpdateFB -> return (UpdateMember mem) @@ -2977,7 +2977,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } /// _____ _____ _ @@ -2987,15 +2987,15 @@ type StateMachine = /// |_| |___/_____|_| |_|\__|_| \__, | /// |___/ | StateMachinePayloadFB.FsEntryUpdateFB -> - either { + result { let! fsEntryUpdate = let fsEntryish = fb.Payload() if fsEntryish.HasValue then - Either.succeed fsEntryish.Value + Result.succeed fsEntryish.Value else "Could not parse empty FsEntryUpdateFB payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail let! hostId = Id.decodeHostId fsEntryUpdate match fb.Action with | StateMachineActionFB.AddFB -> @@ -3007,7 +3007,7 @@ type StateMachine = else "Could not parse empty FsEntryFB payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail return AddFsEntry (hostId, entry) | StateMachineActionFB.UpdateFB -> let! entry = @@ -3018,7 +3018,7 @@ type StateMachine = else "Could not parse empty FsEntryFB payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail return UpdateFsEntry(hostId, entry) | StateMachineActionFB.RemoveFB -> let! path = @@ -3029,13 +3029,13 @@ type StateMachine = else "Could not parse empty FsPathFB payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail return RemoveFsEntry (hostId, path) | x -> return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } /// _____ _____ @@ -3044,15 +3044,15 @@ type StateMachine = /// | _|\__ \| || | | __/ __/ /// |_| |___/|_||_| \___|\___| | StateMachinePayloadFB.FsTreeUpdateFB -> - either { + result { let! fsTreeUpdate = let updateish = fb.Payload() if updateish.HasValue then - Either.succeed updateish.Value + Result.succeed updateish.Value else "Could not parse empty FsTreeUpdateFB payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> let! tree = @@ -3063,7 +3063,7 @@ type StateMachine = else "Could not parse empty FsTreeFB payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail return AddFsTree tree | StateMachineActionFB.RemoveFB -> let! fsTreeId = Id.decodeHostId fsTreeUpdate @@ -3072,7 +3072,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // _ _ @@ -3081,7 +3081,7 @@ type StateMachine = // | |_| \__ \ __/ | // \___/|___/\___|_| | StateMachinePayloadFB.UserFB -> - either { + result { let! user = let userish = fb.Payload() if userish.HasValue then @@ -3090,7 +3090,7 @@ type StateMachine = else "Could not parse empty user payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddUser user) | StateMachineActionFB.UpdateFB -> return (UpdateUser user) @@ -3099,7 +3099,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ @@ -3108,7 +3108,7 @@ type StateMachine = // ___) | __/\__ \__ \ | (_) | | | | // |____/ \___||___/___/_|\___/|_| |_| | StateMachinePayloadFB.SessionFB -> - either { + result { let! session = let sessionish = fb.Payload() if sessionish.HasValue then @@ -3117,7 +3117,7 @@ type StateMachine = else "Could not parse empty session payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddSession session) | StateMachineActionFB.UpdateFB -> return (UpdateSession session) @@ -3126,7 +3126,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ _ @@ -3135,7 +3135,7 @@ type StateMachine = // | |_| | \__ \ (_| (_) \ V / __/ | | __/ (_| | // |____/|_|___/\___\___/ \_/ \___|_| \___|\__,_| | StateMachinePayloadFB.DiscoveredServiceFB -> - either { + result { let! discoveredService = let discoveredServiceish = fb.Payload() if discoveredServiceish.HasValue then @@ -3144,7 +3144,7 @@ type StateMachine = else "Could not parse empty discoveredService payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail match fb.Action with | StateMachineActionFB.AddFB -> return (AddDiscoveredService discoveredService) | StateMachineActionFB.UpdateFB -> return (UpdateDiscoveredService discoveredService) @@ -3153,7 +3153,7 @@ type StateMachine = return! sprintf "Could not parse command. Unknown ActionTypeFB: %A" x |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // __ __ _ @@ -3162,7 +3162,7 @@ type StateMachine = // | | | | \__ \ (__ // |_| |_|_|___/\___| | StateMachinePayloadFB.LogEventFB -> - either { + result { let logish = fb.Payload() if logish.HasValue then let! log = LogEvent.FromFB logish.Value @@ -3171,7 +3171,7 @@ type StateMachine = return! "Could not parse empty LogEvent payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ _ @@ -3181,7 +3181,7 @@ type StateMachine = // |____/|_| |_|\__,_| .__/|___/_| |_|\___/ \__| // |_| | StateMachinePayloadFB.StateFB -> - either { + result { let stateish = fb.Payload() if stateish.HasValue then let state = stateish.Value @@ -3191,7 +3191,7 @@ type StateMachine = return! "Could not parse empty state payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ _ @@ -3201,7 +3201,7 @@ type StateMachine = // |____/ \__|_| |_|_| |_|\__, | // |___/ | StateMachinePayloadFB.StringFB -> - either { + result { let stringish = fb.Payload () if stringish.HasValue then let value = stringish.Value @@ -3211,7 +3211,7 @@ type StateMachine = return! "Could not parse empty string payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ _ @@ -3220,7 +3220,7 @@ type StateMachine = // | |___| | (_) | (__| < // \____|_|\___/ \___|_|\_\ | StateMachinePayloadFB.ClockFB -> - either { + result { let clockish = fb.Payload () if clockish.HasValue then let clock = clockish.Value @@ -3229,7 +3229,7 @@ type StateMachine = return! "Could not parse empty clock payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ ____ _ _ @@ -3238,7 +3238,7 @@ type StateMachine = // | |__| (_) | | | | | | | | | | | (_| | | | | (_| | |_) | (_| | || (__| | | | // \____\___/|_| |_| |_|_| |_| |_|\__,_|_| |_|\__,_|____/ \__,_|\__\___|_| |_| | StateMachinePayloadFB.TransactionFB -> - either { + result { let batchish = fb.Payload () if batchish.HasValue then let batch = batchish.Value @@ -3248,7 +3248,7 @@ type StateMachine = return! "Could not parse empty CommandBatch payload" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail } // ____ _ @@ -3256,7 +3256,7 @@ type StateMachine = // | | / _ \| '_ ` _ \| '_ ` _ \ / _` | '_ \ / _` | // | |__| (_) | | | | | | | | | | | (_| | | | | (_| | // \____\___/|_| |_| |_|_| |_| |_|\__,_|_| |_|\__,_| - | _ -> either { + | _ -> result { let! cmd = AppCommand.FromFB fb.Action return (Command cmd) } @@ -4048,7 +4048,7 @@ type StateMachine = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult = Binary.createBuffer bytes |> StateMachineFB.GetRootAsStateMachineFB |> StateMachine.FromFB diff --git a/src/Disco/Disco/Core/User.fs b/src/Disco/Disco/Core/User.fs index fdf789bf..a12cd8a6 100644 --- a/src/Disco/Disco/Core/User.fs +++ b/src/Disco/Disco/Core/User.fs @@ -65,7 +65,7 @@ type UserYaml() = yaml member yaml.ToUser() = - either { + result { let! id = DiscoId.TryParse yaml.Id return { Id = id @@ -247,8 +247,8 @@ type User = // ** FromFB - static member FromFB(fb: UserFB) : Either = - either { + static member FromFB(fb: UserFB) : DiscoResult< User> = + result { let! id = Id.decodeId fb return { Id = id @@ -265,7 +265,7 @@ type User = // ** FromBytes - static member FromBytes (bytes: byte[]) : Either = + static member FromBytes (bytes: byte[]) : DiscoResult< User> = UserFB.GetRootAsUserFB(Binary.createBuffer bytes) |> User.FromFB @@ -297,12 +297,12 @@ type User = #if !FABLE_COMPILER && !DISCO_NODES - static member Load(path: FilePath) : Either = + static member Load(path: FilePath) : DiscoResult< User> = DiscoData.load path // ** LoadAll - static member LoadAll(basePath: FilePath) : Either = + static member LoadAll(basePath: FilePath) : DiscoResult< User array> = basePath filepath USER_DIR |> DiscoData.loadAll diff --git a/src/Disco/Disco/Core/Util.fs b/src/Disco/Disco/Core/Util.fs index 3f7f7d7b..46b208e5 100644 --- a/src/Disco/Disco/Core/Util.fs +++ b/src/Disco/Disco/Core/Util.fs @@ -367,11 +367,11 @@ module Time = let parse (str: string) = match DateTime.TryParse(str) with - | (true, date) -> Either.succeed date + | (true, date) -> Result.succeed date | _ -> sprintf "Could not parse date string: %s" str |> Error.asParseError "Time.parse" - |> Either.fail + |> Result.fail // * Process diff --git a/src/Disco/Disco/MockClient/Main.fs b/src/Disco/Disco/MockClient/Main.fs index d5f345fc..d7c0deac 100644 --- a/src/Disco/Disco/MockClient/Main.fs +++ b/src/Disco/Disco/MockClient/Main.fs @@ -611,7 +611,7 @@ Usage: } let result = - either { + result { let server = { Port = if parsed.Contains <@ Port @> @@ -640,7 +640,7 @@ Usage: } match result with - | Right client -> + | Ok client -> let patch : PinGroup = { Id = patchid Name = name "MockClient Patch" @@ -668,7 +668,7 @@ Usage: loop client loaded patch dispose client exit 0 - | Left error -> + | Error error -> Console.Error.WriteLine("Encountered error starting client: {0}", Error.toMessage error) Console.Error.WriteLine("Aborting.") error diff --git a/src/Disco/Disco/Net/Core.fs b/src/Disco/Disco/Net/Core.fs index 143ce4e9..2864c428 100644 --- a/src/Disco/Disco/Net/Core.fs +++ b/src/Disco/Disco/Net/Core.fs @@ -581,7 +581,7 @@ type TcpServerEvent = type ITcpServer = inherit IDisposable abstract Id: PeerId - abstract Start: unit -> Either + abstract Start: unit -> DiscoResult abstract Subscribe: (TcpServerEvent -> unit) -> IDisposable abstract Request: client:Guid -> Request -> unit abstract Respond: Response -> unit @@ -593,7 +593,7 @@ type PubSubEvent = type IPubSub = inherit IDisposable - abstract Start: unit -> Either + abstract Start: unit -> DiscoResult abstract Send: byte array -> unit abstract Subscribe: (PubSubEvent -> unit) -> IDisposable diff --git a/src/Disco/Disco/Net/PubSub.fs b/src/Disco/Disco/Net/PubSub.fs index ad188eff..1f416c1a 100644 --- a/src/Disco/Disco/Net/PubSub.fs +++ b/src/Disco/Disco/Net/PubSub.fs @@ -152,12 +152,12 @@ module rec PubSub = do client.Client.Bind(localEp) do client.JoinMulticastGroup(remoteAddress, externalAddress) do beginReceive state - Either.nothing + Result.nothing with | exn -> exn.Message |> Error.asSocketError (tag "Start") - |> Either.fail + |> Result.fail member pubsub.Send(bytes: byte array) = try diff --git a/src/Disco/Disco/Net/TcpServer.fs b/src/Disco/Disco/Net/TcpServer.fs index 0a9c3e4d..f7a5f659 100644 --- a/src/Disco/Disco/Net/TcpServer.fs +++ b/src/Disco/Disco/Net/TcpServer.fs @@ -364,7 +364,7 @@ module TcpServer = with get () = options.ServerId member server.Start() = - either { + result { try do! Network.ensureAvailability options.Listen options.Port do state.Listener.Bind(state.EndPoint) @@ -374,7 +374,7 @@ module TcpServer = return! exn.Message |> Error.asSocketError (tag "Start") - |> Either.fail + |> Result.fail } member server.Request (client: Guid) (request: Request) = diff --git a/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs b/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs index d057908f..36ce6793 100644 --- a/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/ApiClientNode.fs @@ -112,8 +112,8 @@ module Api = let private serverInfo (state: PluginState) = let ip = match IpAddress.TryParse state.InServerIp.[0] with - | Right ip -> ip - | Left error -> + | Ok ip -> ip + | Error error -> Logger.err "serverInfo" error.Message IPv4Address "127.0.0.1" @@ -146,7 +146,7 @@ module Api = let client = ApiClient.create server myself match client.Start() with - | Right () -> + | Ok () -> let apiobs = client.Subscribe(enqueueEvent state) Logger.info "startClient" "successfully started ApiClient" { state with @@ -154,7 +154,7 @@ module Api = Status = ServiceStatus.Starting ApiClient = client Disposables = [ apiobs ] } - | Left error -> + | Error error -> Logger.err "startClient" error.Message { state with Initialized = true diff --git a/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs b/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs index 3d5ffe22..42a5d98e 100644 --- a/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs @@ -53,14 +53,14 @@ type ClientIdNode() = self.InStr.[0] |> DiscoId.TryParse |> function - | Right id -> id - | Left _ -> + | Ok id -> id + | Error _ -> DISCO_CLIENT_ID_ENV_VAR |> Environment.GetEnvironmentVariable |> DiscoId.TryParse |> function - | Right id -> id - | Left _ -> DiscoId.Create() + | Ok id -> id + | Error _ -> DiscoId.Create() do Logger.initialize { MachineId = id diff --git a/src/Disco/Disco/Nodes/Nodes/GraphNode.fs b/src/Disco/Disco/Nodes/Nodes/GraphNode.fs index bd3699dc..9a635cd7 100644 --- a/src/Disco/Disco/Nodes/Nodes/GraphNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/GraphNode.fs @@ -183,11 +183,11 @@ module rec Graph = try str |> IOBoxType.Parse - |> Either.succeed + |> Result.succeed with exn -> exn.Message |> Error.asParseError "IOBoxType" - |> Either.fail + |> Result.fail // ** ValueType @@ -214,12 +214,12 @@ module rec Graph = try str |> ValueType.Parse - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asParseError "ValueType.TryParse" - |> Either.fail + |> Result.fail static member IsBool (vt: ValueType) = match vt with @@ -250,11 +250,11 @@ module rec Graph = try str |> Behavior.Parse - |> Either.succeed + |> Result.succeed with exn -> exn.Message |> Error.asParseError "Behavior.TryParse" - |> Either.fail + |> Result.fail static member IsTrigger (bh: Behavior) = match bh with @@ -281,15 +281,15 @@ module rec Graph = let private findPin (name: string) (pins: IPin2 seq) = Seq.fold - (fun (m: Either) (pin: IPin2) -> + (fun (m: DiscoResult) (pin: IPin2) -> match m with - | Right _ -> m - | Left error -> + | Ok _ -> m + | Error error -> if pin.Name = name then - Right pin + Ok pin else - Left error) - (Left (Other("findPin", (sprintf "could not find pin %A" name)))) + Error error) + (Error (Other("findPin", (sprintf "could not find pin %A" name)))) pins // ** visibleInputPins @@ -327,7 +327,7 @@ module rec Graph = // ** parseValueType let private parseValueType (node: INode2) = - either { + result { let! vtp = findPin Settings.VALUE_TYPE_PIN node.Pins return! ValueType.TryParse vtp.[0] } @@ -335,7 +335,7 @@ module rec Graph = // ** parseBehavior let private parseBehavior (node: INode2) = - either { + result { let! bhp = findPin Settings.BEHAVIOR_PIN node.Pins return! Behavior.TryParse bhp.[0] } @@ -344,13 +344,13 @@ module rec Graph = let private isTrigger (node: INode2) = match parseBehavior node with - | Right bh -> Behavior.IsTrigger bh + | Ok bh -> Behavior.IsTrigger bh | _ -> false // ** parseName let private parseName (node: INode2) = - either { + result { let! np = findPin Settings.DESCRIPTIVE_NAME_PIN node.Pins return if isNull np.[0] @@ -403,7 +403,7 @@ module rec Graph = |> node.FindPin |> fun pin -> pin.[0] |> function - | "Input" -> Either.succeed VecSize.Dynamic + | "Input" -> Result.succeed VecSize.Dynamic | _ -> let cols = try @@ -424,7 +424,7 @@ module rec Graph = with | _ -> 1us cols * rows * pages |> VecSize.Fixed - |> Either.succeed + |> Result.succeed // ** parseBoolValues @@ -458,37 +458,37 @@ module rec Graph = // ** parseMin let private parseMin (node: INode2) = - either { + result { let! min = findPin Settings.MIN_PIN node.Pins let! value = try min.[0] |> Int32.Parse - |> Either.succeed + |> Result.succeed with _ -> - Either.succeed -99999999 + Result.succeed -99999999 return value } // ** parseMax let private parseMax (node: INode2) = - either { + result { let! max = findPin Settings.MAX_PIN node.Pins let! value = try max.[0] |> Int32.Parse - |> Either.succeed + |> Result.succeed with _ -> - Either.succeed 99999999 + Result.succeed 99999999 return value } // ** parseUnits let private parseUnits (node: INode2) = - either { + result { let! units = findPin Settings.UNITS_PIN node.Pins return if isNull units.[0] then "" else units.[0] } @@ -496,15 +496,15 @@ module rec Graph = // ** parsePrecision let private parsePrecision (node: INode2) = - either { + result { let! precision = findPin Settings.PRECISION_PIN node.Pins let! value = try precision.[0] |> UInt32.Parse - |> Either.succeed + |> Result.succeed with _ -> - Either.succeed 4ul + Result.succeed 4ul return value } @@ -610,7 +610,7 @@ module rec Graph = // ** parsePinType let private parsePinType (node: INode2) = - either { + result { let! boxtype = IOBoxType.TryParse (node.NodeInfo.ToString()) match boxtype with | IOBoxType.Value -> @@ -627,7 +627,7 @@ module rec Graph = return! sprintf "unsupported type %A" x |> Error.asParseError "parsePinType" - |> Either.fail + |> Result.fail } // ** addCommand @@ -655,7 +655,7 @@ module rec Graph = let pp = node.FindPin Settings.PAGES_PIN let tp = node.FindPin Settings.TAG_PIN let trig = isTrigger node - let tipe = parsePinType node |> Either.defaultValue PinType.Number + let tipe = parsePinType node |> Result.defaultValue PinType.Number let props = parseEnumProperties node let vecsizeUpdate _ _ = @@ -748,7 +748,7 @@ module rec Graph = // ** parseValuePin let private parseValuePin clientId nodeId groupId (node:INode2) (pin: IPin2) = - either { + result { let path = generateNodePath node pin let pinId = generatePinId nodeId groupId pin let cnf = parseConfiguration pin @@ -823,13 +823,13 @@ module rec Graph = // ** parseSeqWith - type private Parser = IPin2 -> Either + type private Parser = IPin2 -> DiscoResult let private parseSeqWith (parse: Parser) (pins: IPin2 seq) : (IPin2 * Pin) list = Seq.fold (fun lst pin -> parse pin |> function - | Right parsed -> (pin, parsed) :: lst - | Left error -> + | Ok parsed -> (pin, parsed) :: lst + | Error error -> error |> string |> Logger.err "parseSeqWith" @@ -852,7 +852,7 @@ module rec Graph = // ** parseStringType let private parseStringType (node: INode2) = - either { + result { let! st = findPin Settings.STRING_TYPE_PIN node.Pins return! Disco.Core.Behavior.TryParse st.[0] } @@ -860,22 +860,22 @@ module rec Graph = // ** parseMaxChars let private parseMaxChars (node: INode2) = - either { + result { let! mc = findPin Settings.MAXCHAR_PIN node.Pins let! value = try mc.[0] |> Int32.Parse - |> Either.succeed + |> Result.succeed with _ -> - Either.succeed -1 + Result.succeed -1 return value } // ** parseStringPin let private parseStringPin clientId nodeId groupId (node:INode2) (pin: IPin2) = - either { + result { let path = generateNodePath node pin let id = generatePinId nodeId groupId pin let cnf = parseConfiguration pin @@ -917,7 +917,7 @@ module rec Graph = // ** parseEnumPin let private parseEnumPin clientId nodeId groupId (node: INode2) (pin: IPin2) = - either { + result { let path = generateNodePath node pin let id = generatePinId nodeId groupId pin let cnf = parseConfiguration pin @@ -957,7 +957,7 @@ module rec Graph = // ** parseColorPin let private parseColorPin clientId nodeId groupId (node:INode2) (pin: IPin2) = - either { + result { let path = generateNodePath node pin let id = generatePinId nodeId groupId pin let cnf = parseConfiguration pin @@ -995,7 +995,7 @@ module rec Graph = // ** parseINode2 let private parseINode2 clientId nodeId groupId (node: INode2) = - either { + result { let! boxtype = IOBoxType.TryParse (string node.NodeInfo) match boxtype with | IOBoxType.Value -> return parseValueBox clientId nodeId groupId node @@ -1006,7 +1006,7 @@ module rec Graph = return! sprintf "unsupported type %A" x |> Error.asParseError "parseINode2" - |> Either.fail + |> Result.fail } // ** parseGroupName @@ -1100,10 +1100,10 @@ module rec Graph = /// parse all visibile pin on this node and match parseINode2 clientId nodeId groupId node with - | Left error -> + | Error error -> Logger.err (tag "nodeAdded") error.Message state - | Right pins -> + | Ok pins -> Seq.fold (fun (state: PluginState) (pin:IPin2, parsed: Pin) -> addPin state nodeId node pin parsed) @@ -1197,7 +1197,7 @@ module rec Graph = let private pinNameChange (state: PluginState) groupId pinId (node:INode2) = parseName node - |> Either.defaultValue "" + |> Result.defaultValue "" |> name |> Pin.setName |> updatePinWith state groupId pinId (Some UpdatePin) @@ -1213,7 +1213,7 @@ module rec Graph = let private pinVecSizeChange (state: PluginState) groupId pinId node = parseVecSize node - |> Either.defaultValue VecSize.Dynamic + |> Result.defaultValue VecSize.Dynamic |> Pin.setVecSize |> updatePinWith state groupId pinId (Some UpdatePin) @@ -1225,9 +1225,9 @@ module rec Graph = | None -> state | Some nodeId -> match parseINode2 state.ClientId nodeId groupId node with - | Right [] -> state - | Left error -> Logger.err "processing" error.Message; state - | Right parsed -> + | Ok [] -> state + | Error error -> Logger.err "processing" error.Message; state + | Ok parsed -> List.fold (fun (state:PluginState) (pin,parsed) -> pin @@ -1267,9 +1267,9 @@ module rec Graph = let cnf = parseConfiguration pin let tipe, props = match parsePinType node with - | Right PinType.Enum -> PinType.Enum, Some (parseEnumProperties node) - | Right tipe -> tipe, None - | Left _ -> PinType.String, None /// default is string + | Ok PinType.Enum -> PinType.Enum, Some (parseEnumProperties node) + | Ok tipe -> tipe, None + | Error _ -> PinType.String, None /// default is string { PinId = id GroupId = groupId NodePath = node.GetNodePath(false) diff --git a/src/Disco/Disco/Nodes/Nodes/LoggingNode.fs b/src/Disco/Disco/Nodes/Nodes/LoggingNode.fs index b88c0e2a..19c88725 100644 --- a/src/Disco/Disco/Nodes/Nodes/LoggingNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/LoggingNode.fs @@ -88,7 +88,7 @@ type LoggingNode() = if self.InUpdate.[0] && not (Util.isNullReference self.InClientId.[0]) then match LogLevel.TryParse self.InLevel.[0].Name with - | Right level -> Logger.log level "Log" self.InLog.[0] + | Ok level -> Logger.log level "Log" self.InLog.[0] | _ -> () if logs.IsEmpty then diff --git a/src/Disco/Disco/Raft/Log.fs b/src/Disco/Disco/Raft/Log.fs index 3785d01d..4c5e4013 100644 --- a/src/Disco/Disco/Raft/Log.fs +++ b/src/Disco/Disco/Raft/Log.fs @@ -94,9 +94,9 @@ type Log = /// ### Signature: /// - logs: LogFB array /// - /// Returns: Either - static member FromFB (logs: LogFB array) : Either = - either { + /// Returns: DiscoResult + static member FromFB (logs: LogFB array) : DiscoResult = + result { let! entries = LogEntry.FromFB logs match entries with | Some entries as value -> diff --git a/src/Disco/Disco/Raft/LogEntry.fs b/src/Disco/Disco/Raft/LogEntry.fs index b0ea8940..87844b73 100644 --- a/src/Disco/Disco/Raft/LogEntry.fs +++ b/src/Disco/Disco/Raft/LogEntry.fs @@ -384,12 +384,12 @@ type LogEntry = /// - fb: LogFB FlatBuffer object /// - sibling: an sibling (None also legal, for the first mem), or the previous error /// - /// Returns: Either + /// Returns: DiscoResult static member ParseLogFB (fb: LogFB) - (sibling: Either) - : Either = + (sibling: DiscoResult) + : DiscoResult = match fb.EntryType with - | LogTypeFB.ConfigurationFB -> either { + | LogTypeFB.ConfigurationFB -> result { // the previous log entry. An error, if occurred previously let! previous = sibling @@ -403,7 +403,7 @@ type LogEntry = let! mems = let arr = Array.zeroCreate logentry.MembersLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (i, arr) = m let! mem = let value = logentry.Members(i) @@ -412,13 +412,13 @@ type LogEntry = else "Could not parse empty MemberFB value" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail arr.[i] <- mem return (i + 1, arr) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd let! id = Id.decodeId logentry @@ -429,10 +429,10 @@ type LogEntry = else return! "Could not parse empty LogTypeFB.ConfigurationFB" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail } - | LogTypeFB.JointConsensusFB -> either { + | LogTypeFB.JointConsensusFB -> result { // the previous entry, or an error. short-circuits here on error. let! previous = sibling @@ -445,7 +445,7 @@ type LogEntry = let! changes = let arr = Array.zeroCreate logentry.ChangesLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (i, changes) = m // pull the index and array out let! change = let value = logentry.Changes(i) @@ -455,13 +455,13 @@ type LogEntry = else "Could not parse empty ConfigChangeFB value" |> Error.asParseError "StateMachine.FromFB" - |> Either.fail + |> Result.fail changes.[i] <- change return (i + 1, changes) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd let! id = Id.decodeId logentry return (id, 1 * logentry.Index, 1 * logentry.Term, changes, previous) |> JointConsensus @@ -470,11 +470,11 @@ type LogEntry = return! "Could not parse empty LogTypeFB.JointConsensusFB" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail } - | LogTypeFB.LogEntryFB -> either { + | LogTypeFB.LogEntryFB -> result { let! previous = sibling let entry = fb.Entry() @@ -491,15 +491,15 @@ type LogEntry = return! "Could not parse empty StateMachineFB" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty LogTypeFB.LogEntry" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail } - | LogTypeFB.SnapshotFB -> either { + | LogTypeFB.SnapshotFB -> result { // Snapshots don't have ancestors, so move ahead right away let entry = fb.Entry() if entry.HasValue then @@ -513,7 +513,7 @@ type LogEntry = let! mems = let arr = Array.zeroCreate logentry.MembersLength Array.fold - (fun (m: Either) _ -> either { + (fun (m: DiscoResult) _ -> result { let! (i, mems) = m let! mem = @@ -524,14 +524,14 @@ type LogEntry = else "Could not parse empty RaftMemberFB" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail mems.[i] <- mem return (i + 1, mems) }) - (Right (0, arr)) + (Ok (0, arr)) arr - |> Either.map snd + |> Result.map snd return Some $ Snapshot( @@ -546,18 +546,18 @@ type LogEntry = return! "Could not parse empty StateMachineFB" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty LogTypeFB.SnapshotFB" |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail } | x -> sprintf "Could not parse unknown LogTypeFB; %A" x |> Error.asParseError "StateMachine.ParseLogFB" - |> Either.fail + |> Result.fail // ** FromFB @@ -573,8 +573,8 @@ type LogEntry = /// - log: previous RaftLogEntry value to reconstruct the chain of events /// /// Returns: RaftLogEntry option - static member FromFB (logs: LogFB array) : Either = - Array.foldBack LogEntry.ParseLogFB logs (Right None) + static member FromFB (logs: LogFB array): DiscoResult = + Array.foldBack LogEntry.ParseLogFB logs (Ok None) // ** AssetPath @@ -595,7 +595,7 @@ type LogEntry = member log.Save (basePath: FilePath) = match log with | Snapshot(id, idx, term, lastidx, lastterm, mems, _) -> - either { + result { let serializer = Serializer() let path = basePath Asset.path log use! repo = Git.Repo.repository basePath @@ -615,7 +615,7 @@ type LogEntry = | _ -> "Only snapshots can be saved" |> Error.asAssetError "LogEntry.Save" - |> Either.fail + |> Result.fail #endif diff --git a/src/Disco/Disco/Raft/Member.fs b/src/Disco/Disco/Raft/Member.fs index 5fe3267b..9d38f92d 100644 --- a/src/Disco/Disco/Raft/Member.fs +++ b/src/Disco/Disco/Raft/Member.fs @@ -53,12 +53,12 @@ type MemberStatus = static member TryParse (str: string) = try - str |> MemberStatus.Parse |> Either.succeed + str |> MemberStatus.Parse |> Result.succeed with | exn -> sprintf "Could not parse MemberStatus: %s" exn.Message |> Error.asParseError "MemberStatus.TryParse" - |> Either.fail + |> Result.fail // ** ToOffset @@ -73,22 +73,22 @@ type MemberStatus = static member FromFB (fb: MemberStatusFB) = #if FABLE_COMPILER match fb with - | x when x = MemberStatusFB.JoiningFB -> Right Joining - | x when x = MemberStatusFB.RunningFB -> Right Running - | x when x = MemberStatusFB.FailedFB -> Right Failed + | x when x = MemberStatusFB.JoiningFB -> Ok Joining + | x when x = MemberStatusFB.RunningFB -> Ok Running + | x when x = MemberStatusFB.FailedFB -> Ok Failed | x -> sprintf "Could not parse MemberStatus: %A" x |> Error.asParseError "MemberStatus.FromFB" - |> Either.fail + |> Result.fail #else match fb with - | MemberStatusFB.JoiningFB -> Right Joining - | MemberStatusFB.RunningFB -> Right Running - | MemberStatusFB.FailedFB -> Right Failed + | MemberStatusFB.JoiningFB -> Ok Joining + | MemberStatusFB.RunningFB -> Ok Running + | MemberStatusFB.FailedFB -> Ok Failed | x -> sprintf "Could not parse MemberStatus: %A" x |> Error.asParseError "MemberStatus.FromFB" - |> Either.fail + |> Result.fail #endif // * RaftMemberYaml @@ -150,11 +150,11 @@ type MemberState = static member TryParse str = try MemberState.Parse str - |> Either.succeed + |> Result.succeed with exn -> exn.Message |> Error.asParseError "RaftState.TryParse" - |> Either.fail + |> Result.fail // ** ToOffset @@ -169,19 +169,19 @@ type MemberState = static member FromFB(fb: MemberStateFB) = match fb with #if FABLE_COMPILER - | x when x = MemberStateFB.FollowerFB -> Right Follower - | x when x = MemberStateFB.LeaderFB -> Right Leader - | x when x = MemberStateFB.CandidateFB -> Right Candidate + | x when x = MemberStateFB.FollowerFB -> Ok Follower + | x when x = MemberStateFB.LeaderFB -> Ok Leader + | x when x = MemberStateFB.CandidateFB -> Ok Candidate #else - | MemberStateFB.FollowerFB -> Right Follower - | MemberStateFB.LeaderFB -> Right Leader - | MemberStateFB.CandidateFB -> Right Candidate + | MemberStateFB.FollowerFB -> Ok Follower + | MemberStateFB.LeaderFB -> Ok Leader + | MemberStateFB.CandidateFB -> Ok Candidate #endif | other -> other |> String.format "unknown raft state: {0}" |> Error.asParseError "RaftState.FromFB" - |> Either.fail + |> Result.fail // * RaftMember @@ -271,8 +271,8 @@ type RaftMember = // ** FromYaml - static member FromYaml (yaml: RaftMemberYaml) : Either = - either { + static member FromYaml (yaml: RaftMemberYaml): DiscoResult = + result { let! id = DiscoId.TryParse yaml.Id let! ip = IpAddress.TryParse yaml.IpAddress let! mcastip = IpAddress.TryParse yaml.MulticastAddress @@ -317,8 +317,8 @@ type RaftMember = // ** FromFB - static member FromFB (fb: RaftMemberFB) : Either = - either { + static member FromFB (fb: RaftMemberFB): DiscoResult = + result { let! id = Id.decodeId fb let! state = MemberState.FromFB fb.State let! status = MemberStatus.FromFB fb.Status @@ -405,8 +405,8 @@ type ConfigChange = // ** FromFB - static member FromFB (fb: ConfigChangeFB) : Either = - either { + static member FromFB (fb: ConfigChangeFB): DiscoResult = + result { #if FABLE_COMPILER let! mem = fb.Member |> RaftMember.FromFB match fb.Type with @@ -416,7 +416,7 @@ type ConfigChange = return! sprintf "Could not parse ConfigChangeTypeFB %A" x |> Error.asParseError "ConfigChange.FromFB" - |> Either.fail + |> Result.fail #else let nullable = fb.Member if nullable.HasValue then @@ -428,12 +428,12 @@ type ConfigChange = return! sprintf "Could not parse ConfigChangeTypeFB %A" x |> Error.asParseError "ConfigChange.FromFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty ConfigChangeFB payload" |> Error.asParseError "ConfigChange.FromFB" - |> Either.fail + |> Result.fail #endif } @@ -461,18 +461,18 @@ type ConfigChange = static member FromYaml (yml: ConfigChangeYaml) = match yml.ChangeType with - | "MemberAdded" -> either { + | "MemberAdded" -> result { let! mem = Yaml.fromYaml yml.Member return MemberAdded(mem) } - | "MemberRemoved" -> either { + | "MemberRemoved" -> result { let! mem = Yaml.fromYaml yml.Member return MemberRemoved(mem) } | x -> sprintf "Could not parse %s as ConfigChange" x |> Error.asParseError "ConfigChange.FromYaml" - |> Either.fail + |> Result.fail #endif diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index cdefc4c1..6e30383b 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -81,7 +81,7 @@ module rec Raft = do! voteFor None do! setLeader nid do! becomeFollower () - return Right resp + return Ok resp // 2) Else, if the current mem's term value is lower than the requests // term, we take become follower and set our own term to higher value. elif term < msg.Term then @@ -91,7 +91,7 @@ module rec Raft = return resp |> AppendResponse.setTerm msg.Term - |> Either.succeed + |> Result.succeed // 3) Else, finally, if the msg's Term is lower than our own we reject the // the request entirely. elif msg.Term < term then @@ -99,9 +99,9 @@ module rec Raft = return resp |> AppendResponse.setCurrentIndex idx - |> Either.fail + |> Result.fail else - return Either.succeed resp + return Result.succeed resp } // ** handleConflicts @@ -297,7 +297,7 @@ module rec Raft = let! result = createResponse nid msg // check terms et al match, fail otherwise match result with - | Right resp -> + | Ok resp -> // this is not the first AppendEntry we're receiving if msg.PrevLogIdx > 0 then let! entry = entryAt msg.PrevLogIdx @@ -311,7 +311,7 @@ module rec Raft = return resp else return! processEntry nid msg resp - | Left err -> return err + | Error err -> return err } // ** receiveAppendEntriesResponse diff --git a/src/Disco/Disco/Raft/RaftMonad.fs b/src/Disco/Disco/Raft/RaftMonad.fs index c0140e86..23714899 100644 --- a/src/Disco/Disco/Raft/RaftMonad.fs +++ b/src/Disco/Disco/Raft/RaftMonad.fs @@ -30,7 +30,7 @@ open FlatBuffers [] type RaftMonad<'Env,'State,'T,'Error> = - MkRM of ('Env -> 'State -> Either<'Error * 'State,'T * 'State>) + MkRM of ('Env -> 'State -> Result<'T * 'State,'Error * 'State>) // * RaftM @@ -44,17 +44,17 @@ module RaftMonad = // ** get /// get current Raft state - let get = MkRM (fun _ s -> Right (s, s)) + let get = MkRM (fun _ s -> Ok (s, s)) // ** put /// update Raft/State to supplied value - let put s = MkRM (fun _ _ -> Right ((), s)) + let put s = MkRM (fun _ _ -> Ok ((), s)) // ** read /// get the read-only environment value - let read: RaftM<_,_> = MkRM (fun l s -> Right (l, s)) + let read: RaftM<_,_> = MkRM (fun l s -> Ok (l, s)) // ** apply @@ -73,28 +73,28 @@ module RaftMonad = /// run monadic action against supplied state and evironment and return new state let evalRaft (s: 's) (l: 'e) (m: RaftMonad<'e,'s,'a,'err>) = match runRaft s l m with - | Right (_,state) | Left (_,state) -> state + | Ok (_,state) | Error (_,state) -> state // ** returnM /// Lift a regular value into a RaftMonad by wrapping it in a closure. - /// This variant wraps it in a `Right` value. This means the computation will, + /// This variant wraps it in a `Ok` value. This means the computation will, /// if possible, continue to the next step. let returnM value : RaftMonad<'e,'s,'t,'err> = - MkRM (fun _ state -> Right(value, state)) + MkRM (fun _ state -> Ok(value, state)) // ** ignoreM let ignoreM _ : RaftMonad<'e,'s,unit,'err> = - MkRM (fun _ state -> Right((), state)) + MkRM (fun _ state -> Ok((), state)) // ** failM /// Lift a regular value into a RaftMonad by wrapping it in a closure. - /// This variant wraps it in a `Left` value. This means the computation will + /// This variant wraps it in a `Error` value. This means the computation will /// not continue past this step and no regular value will be returned. let failM l = - MkRM (fun _ s -> Left (l, s)) + MkRM (fun _ s -> Error (l, s)) // ** returnFromM @@ -105,7 +105,7 @@ module RaftMonad = // ** zeroM let zeroM () = - MkRM (fun _ state -> Right((), state)) + MkRM (fun _ state -> Ok((), state)) // ** delayM @@ -120,8 +120,8 @@ module RaftMonad = RaftMonad<'env,'state,'b,'err> = MkRM (fun env state -> match apply env state m with - | Right (value,state') -> f value |> apply env state' - | Left err -> Left err) + | Ok (value,state') -> f value |> apply env state' + | Error err -> Error err) // ** (>>=) diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index f513b1ee..6d583ca5 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -275,19 +275,19 @@ ConfigChangeEntry = %s // ** FromYaml - static member FromYaml (yaml: RaftStateYaml) : Either = - either { + static member FromYaml (yaml: RaftStateYaml): DiscoResult = + result { let! id = DiscoId.TryParse yaml.Member let! leader = if isNull yaml.Leader - then Right None - else DiscoId.TryParse yaml.Leader |> Either.map Some + then Ok None + else DiscoId.TryParse yaml.Leader |> Result.map Some let! votedfor = if isNull yaml.VotedFor - then Right None - else DiscoId.TryParse yaml.VotedFor |> Either.map Some + then Ok None + else DiscoId.TryParse yaml.VotedFor |> Result.map Some return { Member = Member.create id diff --git a/src/Disco/Disco/Raft/Types.fs b/src/Disco/Disco/Raft/Types.fs index 76a6d041..5cc11976 100644 --- a/src/Disco/Disco/Raft/Types.fs +++ b/src/Disco/Disco/Raft/Types.fs @@ -46,7 +46,7 @@ type EntryResponse = // ** FromFB static member FromFB(fb: EntryResponseFB) = - either { + result { let! id = Id.decodeId fb return { Id = id @@ -122,8 +122,8 @@ type VoteRequest = // ** FromFB - static member FromFB (fb: VoteRequestFB) : Either = - either { + static member FromFB (fb: VoteRequestFB): DiscoResult = + result { let candidate = fb.Candidate if candidate.HasValue then let! mem = RaftMember.FromFB candidate.Value @@ -135,7 +135,7 @@ type VoteRequest = return! "Could not parse empty MemberFB" |> Error.asParseError "VoteRequest.FromFB" - |> Either.fail + |> Result.fail } // ** optics @@ -189,15 +189,15 @@ type VoteResponse = // ** FromFB - static member FromFB (fb: VoteResponseFB) : Either = - either { + static member FromFB (fb: VoteResponseFB): DiscoResult = + result { let! reason = let reason = fb.Reason if reason.HasValue then DiscoError.FromFB reason.Value - |> Either.map Some + |> Result.map Some else - Right None + Ok None return { Term = 1 * fb.Term Granted = fb.Granted @@ -297,11 +297,11 @@ type AppendEntries = // ** FromFB - static member FromFB (fb: AppendEntriesFB) : Either = - either { + static member FromFB (fb: AppendEntriesFB): DiscoResult = + result { let! entries = if fb.EntriesLength = 0 then - Either.succeed None + Result.succeed None else let raw = Array.zeroCreate fb.EntriesLength for i in 0 .. (fb.EntriesLength - 1) do @@ -404,7 +404,7 @@ type AppendResponse = // ** FromFB static member FromFB (fb: AppendResponseFB) = - Either.succeed { + Result.succeed { Term = 1 * fb.Term Success = fb.Success CurrentIndex = 1 * fb.CurrentIndex @@ -501,7 +501,7 @@ type InstallSnapshot = // ** FromFB static member FromFB (fb: InstallSnapshotFB) = - either { + result { let! decoded = if fb.DataLength > 0 then let raw = Array.zeroCreate fb.DataLength @@ -513,7 +513,7 @@ type InstallSnapshot = else "Invalid InstallSnapshot (no log data)" |> Error.asParseError "InstallSnapshot.FromFB" - |> Either.fail + |> Result.fail match decoded with | Some entries -> @@ -529,7 +529,7 @@ type InstallSnapshot = return! "Invalid InstallSnapshot (no log data)" |> Error.asParseError "InstallSnapshot.FromFB" - |> Either.fail + |> Result.fail } // * InstallSnapshot module diff --git a/src/Disco/Disco/RaspberryPi/Main.fs b/src/Disco/Disco/RaspberryPi/Main.fs index ac9e6150..ab499fc7 100644 --- a/src/Disco/Disco/RaspberryPi/Main.fs +++ b/src/Disco/Disco/RaspberryPi/Main.fs @@ -147,7 +147,7 @@ module Main = let client = ApiClient.create server client match client.Start() with - | Right () -> + | Ok () -> let gpio = startUpdater() let obs = client.Subscribe (handleWith pinid gpio.Update) @@ -194,7 +194,7 @@ module Main = dispose client exit 0 - | Left error -> + | Error error -> Console.Error.WriteLine("Encountered error starting client: {0}", Error.toMessage error) Console.Error.WriteLine("Aborting.") error diff --git a/src/Disco/Disco/Service/ApiServer.fs b/src/Disco/Disco/Service/ApiServer.fs index 81885e25..ec0d034f 100644 --- a/src/Disco/Disco/Service/ApiServer.fs +++ b/src/Disco/Disco/Service/ApiServer.fs @@ -113,9 +113,9 @@ module ApiServer = |> state.Server.Request (Guid.ofId client) // match result with - // | Right ApiResponse.OK -> () + // | Ok ApiResponse.OK -> () - // | Right (ApiResponse.NOK error) -> + // | Ok (ApiResponse.NOK error) -> // error // |> string // |> Error.asClientError (tag "requestInstallSnapshot") @@ -124,7 +124,7 @@ module ApiServer = // |> Msg.SetClientStatus // |> agent.Post - // | Right other -> + // | Ok other -> // other // |> sprintf "Unexpected reply from Client %A" // |> Error.asClientError (tag "requestInstallSnapshot") @@ -133,7 +133,7 @@ module ApiServer = // |> Msg.SetClientStatus // |> agent.Post - // | Left error -> + // | Error error -> // error // |> string // |> Error.asClientError (tag "requestInstallSnapshot") @@ -147,7 +147,7 @@ module ApiServer = let private processSubscriptionEvent (mem: PeerId) (agent: ApiAgent) = function | PubSubEvent.Request(id, bytes) -> match Binary.decode bytes with - | Right command -> + | Ok command -> match command with // Special case for tests: // @@ -167,7 +167,7 @@ module ApiServer = | CallCue _ | UpdateSlices _ -> Msg.Update(Origin.Api, command) |> agent.Post | _ -> () - | Left _ -> () // not sure if I should log here.. + | Error _ -> () // not sure if I should log here.. // ** handleStart @@ -324,7 +324,7 @@ module ApiServer = let private handleServerRequest (state: ServerState) (req: Request) (agent: ApiAgent) = match req.Body |> Binary.decode with - | Right (Register client) -> + | Ok (Register client) -> client.Id |> sprintf "%O requested to be registered" |> Logger.info (tag "handleServerRequest") @@ -338,7 +338,7 @@ module ApiServer = |> Response.fromRequest req |> state.Server.Respond - | Right (UnRegister client) -> + | Ok (UnRegister client) -> client.Id |> sprintf "%O requested to be un-registered" |> Logger.info (tag "handleServerRequest") @@ -352,15 +352,15 @@ module ApiServer = |> Response.fromRequest req |> state.Server.Respond - | Right (Update sm) -> + | Ok (Update sm) -> let id = DiscoId.FromGuid req.PeerId (Origin.Client id, sm) |> Msg.Update |> agent.Post - | Right _ -> () // ignore Ping et al + | Ok _ -> () // ignore Ping et al - | Left error -> + | Error error -> error |> String.format "error decoding request: {0}" |> Logger.err (tag "handleServerRequest") @@ -390,7 +390,7 @@ module ApiServer = // | \| | | | | ' / // | |\ | |_| | . \ // |_| \_|\___/|_|\_\ - | Right (ApiResponse.NOK error) -> + | Ok (ApiResponse.NOK error) -> error |> sprintf "NOK in client request. reason: %O" |> Logger.err (tag "handleClientResponse") @@ -400,14 +400,14 @@ module ApiServer = |> Msg.SetClientStatus |> agent.Post - | Right (ApiResponse.Registered _) - | Right (ApiResponse.Unregistered _) -> () + | Ok (ApiResponse.Registered _) + | Ok (ApiResponse.Unregistered _) -> () // ____ _ _____ // | _ \ ___ ___ ___ __| | ___ | ____|_ __ _ __ ___ _ __ // | | | |/ _ \/ __/ _ \ / _` |/ _ \ | _| | '__| '__/ _ \| '__| // | |_| | __/ (_| (_) | (_| | __/ | |___| | | | | (_) | | // |____/ \___|\___\___/ \__,_|\___| |_____|_| |_| \___/|_| - | Left error -> + | Error error -> error |> sprintf "error returned in client request. reason: %O" |> Logger.err (tag "handleClientResponse") @@ -483,7 +483,7 @@ module ApiServer = let private start (mem: ClusterMember) (store: IAgentStore) (agent: ApiAgent) = - either { + result { let pubsub = PubSub.create mem let server = TcpServer.create { @@ -493,9 +493,9 @@ module ApiServer = } match server.Start() with - | Right () -> + | Ok () -> match pubsub.Start() with - | Right () -> + | Ok () -> let srv = server.Subscribe (Msg.ServerEvent >> agent.Post) let pbsb = pubsub.Subscribe(processSubscriptionEvent mem.Id agent) @@ -510,19 +510,19 @@ module ApiServer = agent.Start() agent.Post Msg.Start - | Left error -> + | Error error -> dispose server dispose pubsub - return! Either.fail error + return! Result.fail error - | Left error -> - return! Either.fail error + | Error error -> + return! Result.fail error } // ** create let create (mem: ClusterMember) callbacks = - either { + result { let cts = new CancellationTokenSource() let store = AgentStore.create () diff --git a/src/Disco/Disco/Service/AssetService.fs b/src/Disco/Disco/Service/AssetService.fs index 55cf6194..3cd9466e 100644 --- a/src/Disco/Disco/Service/AssetService.fs +++ b/src/Disco/Disco/Service/AssetService.fs @@ -296,8 +296,8 @@ module AssetService = // ** create let create (machine: DiscoMachine) = - either { - do! Directory.createDirectory machine.AssetDirectory |> Either.map ignore + result { + do! Directory.createDirectory machine.AssetDirectory |> Result.map ignore let subscriptions = Subscriptions() let store = AgentStore.create() @@ -321,9 +321,9 @@ module AssetService = flusher <- Periodically.run 2000 (flushClock agent) agent |> startCrawler machine - |> Either.succeed + |> Result.succeed - member self.Stop() = Either.nothing + member self.Stop() = Result.nothing member self.State = store.State.Files @@ -352,7 +352,7 @@ let machine = AssetFilter = ".file" } -let service = AssetService.create machine |> Either.get +let service = AssetService.create machine |> Result.get service.Subscribe (printfn "%O") service.Start() diff --git a/src/Disco/Disco/Service/CommandActions.fs b/src/Disco/Disco/Service/CommandActions.fs index 4d4d3dee..06a43513 100644 --- a/src/Disco/Disco/Service/CommandActions.fs +++ b/src/Disco/Disco/Service/CommandActions.fs @@ -21,7 +21,7 @@ open System.Collections.Concurrent // * Channel -type private Channel = AsyncReplyChannel> +type private Channel = AsyncReplyChannel> // * tag @@ -44,18 +44,18 @@ let private serializeJson = /// -XPOST \ /// -d '"GetServiceInfo"' \ /// http://localhost:7000/api/command -let getServiceInfo (disco: IDisco): Either = - let notLoaded () = null |> serializeJson |> Either.succeed +let getServiceInfo (disco: IDisco): DiscoResult = + let notLoaded () = null |> serializeJson |> Result.succeed match disco.DiscoService with | Some service -> match Config.findMember service.Config disco.Machine.MachineId with - | Right mem -> + | Ok mem -> { webSocket = sprintf "ws://%O:%i" mem.IpAddress mem.WsPort version = Build.VERSION buildNumber = Build.BUILD_NUMBER } |> serializeJson - |> Either.succeed - | Left _ -> notLoaded() + |> Result.succeed + | Error _ -> notLoaded() | None -> notLoaded() // * listProjects @@ -68,23 +68,23 @@ let getServiceInfo (disco: IDisco): Either = /// -d '"ListProjects"' \ /// http://localhost:7000/api/command /// -let listProjects (cfg: DiscoMachine): Either = +let listProjects (cfg: DiscoMachine): DiscoResult = cfg.WorkSpace |> Directory.getDirectories |> Array.choose (fun dir -> match DiscoProject.Load(dir, cfg) with - | Right project -> + | Ok project -> project.Name |> String.format "Found valid project \"{0}\" in current WorkSpace." |> Logger.info (tag "listProjects") Some { Name = project.Name; Id = project.Id } - | Left _ -> + | Error _ -> dir |> String.format "\"{0}\" does not contain a valid project.yaml" |> Logger.info (tag "listProjects") None) |> serializeJson - |> Either.succeed + |> Result.succeed // * buildProject @@ -94,7 +94,7 @@ let buildProject (machine: DiscoMachine) (path: FilePath) (raftDir: FilePath) (mem: ClusterMember) = - either { + result { let! project = Project.create path name machine let site = @@ -119,7 +119,7 @@ let buildProject (machine: DiscoMachine) /// Given the user (usually the admin user) and Project value, initialize the Raft intermediate /// state in the data directory and commit the result to git. -let initializeRaft (project: DiscoProject) = either { +let initializeRaft (project: DiscoProject) = result { let! raft = createRaft project.Config let! _ = saveRaft project.Config raft return () @@ -127,7 +127,7 @@ let initializeRaft (project: DiscoProject) = either { // * createProject -let createProject (machine: DiscoMachine) (opts: CreateProjectOptions) = either { +let createProject (machine: DiscoMachine) (opts: CreateProjectOptions) = result { let dir = machine.WorkSpace filepath opts.name let raftDir = dir filepath RAFT_DIRECTORY @@ -135,7 +135,7 @@ let createProject (machine: DiscoMachine) (opts: CreateProjectOptions) = either do! if Directory.exists dir then rmDir dir - else Either.nothing + else Result.nothing do! mkDir dir do! mkDir raftDir @@ -157,7 +157,7 @@ let createProject (machine: DiscoMachine) (opts: CreateProjectOptions) = either // * getProjectSites let getProjectSites machine projectName = - either { + result { let! path = Project.checkPath machine projectName let! (state: State) = Asset.loadWithMachine path machine // TODO: Check username and password? @@ -182,7 +182,7 @@ let machineStatus (disco: IDisco) = | Some service -> Busy(service.Project.Id, service.Project.Name) | None -> MachineStatus.Idle |> serializeJson - |> Either.succeed + |> Result.succeed // * machineConfig @@ -196,7 +196,7 @@ let machineStatus (disco: IDisco) = let machineConfig () = MachineConfig.get() |> serializeJson - |> Either.succeed + |> Result.succeed // * cloneProject @@ -213,7 +213,7 @@ let cloneProject (name: Name) (uri: Url) = let target = machine.WorkSpace filepath (unwrap name) let success = sprintf "Successfully cloned project from: %A" uri Git.Repo.clone target (unwrap uri) - |> Either.map (konst (serializeJson success)) + |> Result.map (konst (serializeJson success)) // * pullProject @@ -225,7 +225,7 @@ let cloneProject (name: Name) (uri: Url) = /// -XPOST \ /// -d '{"PullProject":["dfb6eff5-e4b8-465d-9ad0-ee58bd508cad","meh","git://192.168.2.106:6000/meh/.git"]}' \ /// http://localhost:7000/api/command -let pullProject (id: string) (name: Name) (uri: Url) = either { +let pullProject (id: string) (name: Name) (uri: Url) = result { let machine = MachineConfig.get() let target = machine.WorkSpace filepath (unwrap name) use! repo = Git.Repo.repository target @@ -246,7 +246,7 @@ let pullProject (id: string) (name: Name) (uri: Url) = either { return! "Clonflict while pulling from " + unwrap uri |> Error.asGitError "pullProject" - |> Either.fail + |> Result.fail | _ -> return sprintf "Successfully pulled changes from: %A" url @@ -272,8 +272,8 @@ let startAgent (cfg: DiscoMachine) (disco: IDisco) = dispose disco exit 0 } - Right "Disposing service..." - | Command.UnloadProject -> disco.UnloadProject() |> Either.map (konst "Project unloaded") + Ok "Disposing service..." + | Command.UnloadProject -> disco.UnloadProject() |> Result.map (konst "Project unloaded") | ListProjects -> listProjects cfg | GetServiceInfo -> getServiceInfo disco | MachineStatus -> machineStatus disco @@ -281,7 +281,7 @@ let startAgent (cfg: DiscoMachine) (disco: IDisco) = | CreateProject opts -> createProject cfg opts | SaveProject -> disco.SaveProject() - |> Either.map (fun _ -> "Successfully saved project") + |> Result.map (fun _ -> "Successfully saved project") | CloneProject (name, gitUri) -> cloneProject name gitUri | PullProject (id, name, gitUri) -> pullProject id name gitUri | LoadProject(projectName, Some { Id = siteId; Name = name }) -> @@ -290,14 +290,14 @@ let startAgent (cfg: DiscoMachine) (disco: IDisco) = Measure.name Constants.ADMIN_USER_NAME, Measure.password Constants.ADMIN_DEFAULT_PASSWORD, Some (name, siteId)) - |> Either.map (fun _ -> "Loaded project " + unwrap projectName) + |> Result.map (fun _ -> "Loaded project " + unwrap projectName) | LoadProject(projectName, _) -> disco.LoadProject( projectName, Measure.name Constants.ADMIN_USER_NAME, Measure.password Constants.ADMIN_DEFAULT_PASSWORD, None) - |> Either.map (fun _ -> "Loaded project " + unwrap projectName) + |> Result.map (fun _ -> "Loaded project " + unwrap projectName) | GetProjectSites projectName -> getProjectSites cfg projectName replyChannel.Reply res @@ -310,7 +310,7 @@ let startAgent (cfg: DiscoMachine) (disco: IDisco) = let postCommand (agent: (MailboxProcessor option) ref) (cmd: Command) = let err msg = - Error.asOther (tag "postCommand") msg |> Either.fail + Error.asOther (tag "postCommand") msg |> Result.fail match !agent with | Some agent -> async { diff --git a/src/Disco/Disco/Service/CommandLine.fs b/src/Disco/Disco/Service/CommandLine.fs index 8a3378a6..12781591 100644 --- a/src/Disco/Disco/Service/CommandLine.fs +++ b/src/Disco/Disco/Service/CommandLine.fs @@ -148,7 +148,7 @@ module CommandLine = (machine: DiscoMachine) (projectDir: FilePath option) (frontend: FilePath option) = - either { + result { let agentRef = ref None let post = CommandActions.postCommand agentRef let termSupportsColors = Console.isColorTerm() @@ -183,9 +183,9 @@ module CommandLine = Commands.Command.LoadProject(name, site) |> CommandActions.postCommand agentRef |> Async.RunSynchronously - |> Either.map ignore + |> Result.map ignore | None -> - Either.succeed () + Result.succeed () do vmSetup () @@ -218,6 +218,6 @@ module CommandLine = let help () = parser.PrintUsage(header, "disco.exe", true) |> flip (printfn "%s\n%s") SubCommand.Doc - |> Either.succeed + |> Result.succeed #endif diff --git a/src/Disco/Disco/Service/Disco.fs b/src/Disco/Disco/Service/Disco.fs index 0c6804ae..a3463bf2 100644 --- a/src/Disco/Disco/Service/Disco.fs +++ b/src/Disco/Disco/Service/Disco.fs @@ -54,13 +54,13 @@ module Disco = let ids = Array.map Member.id mems if not (Array.contains disco.Machine.MachineId ids) then match disco.UnloadProject() with - | Right () -> Logger.info "onShutdown" "Unloaded project" - | Left error -> Logger.err "onShutdown" error.Message + | Ok () -> Logger.info "onShutdown" "Unloaded project" + | Error error -> Logger.err "onShutdown" error.Message | _ -> () // ** create - let create post (options: DiscoOptions) = either { + let create post (options: DiscoOptions) = result { let status = ref ServiceStatus.Stopped let disco = ref None let eventSubscription = ref None @@ -71,9 +71,9 @@ module Disco = let! discovery = options.Machine |> DiscoveryService.create - |> fun service -> service.Start() |> Either.map (konst service) - |> Either.map Some - |> Either.orElse None + |> fun service -> service.Start() |> Result.map (konst service) + |> Result.map Some + |> Result.orElse None do! httpServer.Start() return { @@ -90,7 +90,7 @@ module Disco = member self.DiscoService with get () = !disco - member self.LoadProject(name, username, password, site) = either { + member self.LoadProject(name, username, password, site) = result { status := ServiceStatus.Starting Option.iter dispose !disco // in case there was already something loaded Option.iter dispose !eventSubscription // and its subscription as well @@ -103,16 +103,16 @@ module Disco = SiteId = site } match discoService.Start() with - | Right () -> + | Ok () -> eventSubscription := subscribeDiscovery discoService discovery shutdownSubscription := self |> onShutdown |> discoService.Subscribe |> Some let mem = discoService.RaftServer.Raft.Member disco := Some discoService status := ServiceStatus.Running return () - | Left error -> + | Error error -> status := ServiceStatus.Failed error - return! Either.fail error + return! Result.fail error } member self.SaveProject() = @@ -121,13 +121,13 @@ module Disco = AppCommand.Save |> StateMachine.Command |> disco.Append - |> Either.succeed + |> Result.succeed | None -> "No project loaded" |> Error.asOther (tag "Save") - |> Either.fail + |> Result.fail - member self.UnloadProject() = either { + member self.UnloadProject() = result { match !disco, !eventSubscription with | Some discoService, subscription -> Option.iter dispose !shutdownSubscription @@ -140,7 +140,7 @@ module Disco = return! "No project was loaded" |> Error.asOther (tag "UnloadProject") - |> Either.fail + |> Result.fail } member self.Dispose() = diff --git a/src/Disco/Disco/Service/DiscoService.fs b/src/Disco/Disco/Service/DiscoService.fs index 6564b0b8..1583242a 100644 --- a/src/Disco/Disco/Service/DiscoService.fs +++ b/src/Disco/Disco/Service/DiscoService.fs @@ -114,11 +114,11 @@ module DiscoService = /// Persiste a state machine command to disk and log results. let private persistWithLogging (store: IAgentStore) sm = match Persistence.persistEntry store.State.Store.State sm with - | Right () -> + | Ok () -> string sm |> String.format "Successfully persisted command {0} to disk" |> Logger.debug (tag "statePersistor") - | Left error -> + | Error error -> error |> String.format "Error persisting command to disk: {0}" |> Logger.err (tag "statePersistor") @@ -159,13 +159,13 @@ module DiscoService = // | |__| (_) | | | | | | | | | | | | |_ // \____\___/|_| |_| |_|_| |_| |_|_|\__| match Config.getMembers state.Store.State.Project.Config with - | Left error -> + | Error error -> error.Message |> String.format "Error committing changes to disk: {0}" |> Logger.err (tag "statePersistor") - | Right members -> + | Ok members -> match Persistence.commitChanges state.Store.State with - | Right (repo, commit) -> + | Ok (repo, commit) -> commit.Sha |> String.format "Successfully committed changes in: {0}" |> Logger.debug (tag "statePersistor") @@ -180,7 +180,7 @@ module DiscoService = sprintf "could not push to %s: %O" name err |> Logger.err (tag "statePersistor")) dispose repo - | Left error -> + | Error error -> error |> String.format "Error committing changes to disk: {0}" |> Logger.err (tag "statePersistor") @@ -263,8 +263,8 @@ module DiscoService = match cmd with | DiscoEvent.Append(_, LogMsg log) -> match LogFile.write store.State.LogFile log with - | Right _ -> () - | Left error -> + | Ok _ -> () + | Error error -> error |> string |> Logger.err (tag "logPersistor") @@ -502,7 +502,7 @@ module DiscoService = | DiscoEvent.PersistSnapshot log -> match Persistence.persistSnapshot store.State.Store.State log with - | Left error -> Logger.err (tag "persistSnapshot") (string error) + | Error error -> Logger.err (tag "persistSnapshot") (string error) | _ -> () | DiscoEvent.RaftError error -> Logger.err (tag "processEvents") error.Message @@ -561,7 +561,7 @@ module DiscoService = | Append (Origin.Web id, AddSession session) -> session |> store.State.SocketServer.BuildSession id - |> Either.iter (AddSession >> handleAppend store) + |> Result.iter (AddSession >> handleAppend store) // replicate a RemoveSession command if the session exists | SessionClosed id -> @@ -641,7 +641,7 @@ module DiscoService = Constants.SNAPSHOT_FILENAME + Constants.ASSET_EXTENSION match DiscoData.read path with - | Right str -> + | Ok str -> try let yml = Yaml.deserialize str let id = DiscoId.Parse yml.Id @@ -658,7 +658,7 @@ module DiscoService = |> Logger.err (tag "retrieveSnapshot") None - | Left error -> + | Error error -> error |> string |> Logger.err (tag "retrieveSnapshot") @@ -668,7 +668,7 @@ module DiscoService = let private persistSnapshot (state: DiscoState) (log: LogEntry) = match Persistence.persistSnapshot state.Store.State log with - | Left error -> Logger.err (tag "persistSnapshot") (string error) + | Error error -> Logger.err (tag "persistSnapshot") (string error) | _ -> () state @@ -703,7 +703,7 @@ module DiscoService = | _ -> "Login rejected" |> Error.asProjectError (tag "loadProject") - |> Either.fail + |> Result.fail // ** updateSite @@ -740,7 +740,7 @@ module DiscoService = // ** makeState let private makeState store state serviceOptions _ = - either { + result { let subscriptions = Subscriptions() let state = updateSite state serviceOptions @@ -818,7 +818,7 @@ module DiscoService = // ** makeStore let private makeStore (serviceOptions: DiscoServiceOptions) = - either { + result { let store = AgentStore.create() let logDir = @@ -833,7 +833,7 @@ module DiscoService = let! (state: State) = serviceOptions.Machine |> Asset.loadWithMachine path - |> Either.map State.initialize + |> Result.map State.initialize let! updated = state.Users @@ -849,12 +849,12 @@ module DiscoService = // ** start let private start (store: IAgentStore) = - either { + result { store.State.Dispatcher.Start() // start all services let result = - either { + result { do! store.State.ApiServer.Start() do! store.State.SocketServer.Start() do! store.State.GitServer.Start() @@ -863,7 +863,7 @@ module DiscoService = } match result with - | Right _ -> + | Ok _ -> { store.State with Status = ServiceStatus.Running } |> store.Update @@ -871,7 +871,7 @@ module DiscoService = |> DiscoEvent.Status |> Observable.onNext store.State.Subscriptions return () - | Left error -> + | Error error -> { store.State with Status = ServiceStatus.Failed error } |> store.Update @@ -879,7 +879,7 @@ module DiscoService = |> DiscoEvent.Status |> Observable.onNext store.State.Subscriptions dispose store.State - return! Either.fail error + return! Result.fail error } // ** disposeService @@ -961,28 +961,28 @@ module DiscoService = // member self.LeaveCluster () = // Tracing.trace (tag "LeaveCluster") <| fun () -> // match postCommand agent "LeaveCluster" Msg.Leave with - // | Right Reply.Ok -> Right () - // | Left error -> Left error - // | Right other -> + // | Ok Reply.Ok -> Ok () + // | Error error -> Error error + // | Ok other -> // String.format "Unexpected response from DiscoAgent: {0}" other // |> Error.asOther (tag "LeaveCluster") - // |> Either.fail + // |> Result.fail // member self.JoinCluster ip port = // Tracing.trace (tag "JoinCluster") <| fun () -> // match postCommand agent "JoinCluster" (fun chan -> Msg.Join(chan,ip, port)) with - // | Right Reply.Ok -> Right () - // | Left error -> Left error - // | Right other -> + // | Ok Reply.Ok -> Ok () + // | Error error -> Error error + // | Ok other -> // String.format "Unexpected response from DiscoAgent: {0}" other // |> Error.asOther (tag "JoinCluster") - // |> Either.fail + // |> Result.fail } // ** create let create (disco: DiscoServiceOptions) = - either { + result { let! store = makeStore disco return makeService store } diff --git a/src/Disco/Disco/Service/DiscoveryService.fs b/src/Disco/Disco/Service/DiscoveryService.fs index f5701fa7..ee9e5e5e 100644 --- a/src/Disco/Disco/Service/DiscoveryService.fs +++ b/src/Disco/Disco/Service/DiscoveryService.fs @@ -89,7 +89,7 @@ module DiscoveryService = |> Discovery.toDiscoveredService match service with - | Right parsed -> + | Ok parsed -> parsed.Id |> sprintf "resolved new service %O" |> Logger.debug (tag "addResolved") @@ -97,7 +97,7 @@ module DiscoveryService = parsed |> Msg.Discovered |> agent.Post - | Left _ -> () + | Error _ -> () // ** serviceAdded @@ -142,11 +142,11 @@ module DiscoveryService = let service = Discovery.toDiscoverableService discoverable service.Response.Add(serviceRegistered agent discoverable) service.Register() - Either.succeed service + Result.succeed service with | exn -> exn.Message |> Error.asOther (tag "registerService") - |> Either.fail + |> Result.fail // ** unregisterService @@ -165,12 +165,12 @@ module DiscoveryService = let browser = new ServiceBrowser() browser.ServiceAdded.AddHandler(new ServiceBrowseEventHandler(serviceAdded agent)) browser.ServiceRemoved.AddHandler(new ServiceBrowseEventHandler(serviceRemoved agent)) - browser |> Either.succeed + browser |> Result.succeed with | exn -> exn.Message |> Error.asOther (tag "makeBrowser") - |> Either.fail + |> Result.fail // ** handleStop @@ -205,8 +205,8 @@ module DiscoveryService = { ServiceType = ServiceType.WebSocket; Port = machine.WsPort } |] ExtraMetadata = Array.empty } match registerService agent discoverable with - | Right service -> { state with RegisterService = Some service } - | Left error -> + | Ok service -> { state with RegisterService = Some service } + | Error error -> error |> sprintf "error registering busy service: %O" |> Logger.err (tag "handleRegister") @@ -229,8 +229,8 @@ module DiscoveryService = { ServiceType = ServiceType.WebSocket; Port = machine.WsPort } |] ExtraMetadata = Array.empty } match registerService agent discoverable with - | Right service -> { state with RegisterService = Some service } - | Left error -> + | Ok service -> { state with RegisterService = Some service } + | Error error -> error |> sprintf "error registering idle service: %O" |> Logger.err (tag "handleUnRegister") @@ -316,14 +316,14 @@ module DiscoveryService = { new IDiscoveryService with member self.Start() = - either { + result { let! browser = makeBrowser agent store.Update { state with Browser = browser } do! try browser |> startBrowser - |> Either.succeed + |> Result.succeed with | exn -> tryDispose browser ignore @@ -334,7 +334,7 @@ module DiscoveryService = Logger.err (tag "Start") msg msg |> Error.asOther (tag "Start") - |> Either.fail + |> Result.fail agent.Post Msg.Start return () diff --git a/src/Disco/Disco/Service/GitServer.fs b/src/Disco/Disco/Service/GitServer.fs index 4f749881..d951c796 100644 --- a/src/Disco/Disco/Service/GitServer.fs +++ b/src/Disco/Disco/Service/GitServer.fs @@ -130,7 +130,7 @@ module GitServer = member self.Subscribe(callback: DiscoEvent -> unit) = Observable.subscribe callback subscriptions - member self.Start () = either { + member self.Start () = result { do! Network.ensureIpAddress mem.IpAddress do! Network.ensureAvailability mem.IpAddress mem.GitPort diff --git a/src/Disco/Disco/Service/HttpServer.fs b/src/Disco/Disco/Service/HttpServer.fs index 7327991e..6d331e5c 100644 --- a/src/Disco/Disco/Service/HttpServer.fs +++ b/src/Disco/Disco/Service/HttpServer.fs @@ -129,9 +129,9 @@ module HttpServer = |> postCommand return match res with - | Left err -> + | Result.Error err -> Error.toMessage err |> Actions.respondWithCors ctx HTTP_500.status - | Right msg -> + | Ok msg -> msg |> Actions.respondWithCors ctx HTTP_200.status } choose [ @@ -154,7 +154,7 @@ module HttpServer = // ** makeConfig let private makeConfig machine (basePath: FilePath) (cts: CancellationTokenSource) = - either { + result { try let logger = let reg = Regex("\{(\w+)(?:\:(.*?))?\}") @@ -212,7 +212,7 @@ module HttpServer = // ** create let create (machine: DiscoMachine) (frontend: FilePath option) (postCommand: CommandAgent) = - either { + result { let status = ref ServiceStatus.Stopped let basePath = @@ -224,7 +224,7 @@ module HttpServer = return { new IHttpServer with - member self.Start () = either { + member self.Start () = result { try let _, server = basePath filepath "index.html" @@ -238,7 +238,7 @@ module HttpServer = return! exn.Message |> Error.asSocketError (tag "create") - |> Either.fail + |> Result.fail } member self.Dispose () = diff --git a/src/Disco/Disco/Service/Interfaces.fs b/src/Disco/Disco/Service/Interfaces.fs index d38a2208..ecc0901c 100644 --- a/src/Disco/Disco/Service/Interfaces.fs +++ b/src/Disco/Disco/Service/Interfaces.fs @@ -68,7 +68,7 @@ type IDiscoveryService = inherit IDisposable abstract Services: Map abstract Subscribe: (DiscoveryEvent -> unit) -> IDisposable - abstract Start: unit -> Either + abstract Start: unit -> DiscoResult abstract Register: project:DiscoProject -> unit abstract UnRegister: unit -> unit @@ -97,7 +97,7 @@ type IGitServer = inherit IDisposable abstract Status : ServiceStatus abstract Subscribe : (DiscoEvent -> unit) -> IDisposable - abstract Start : unit -> Either + abstract Start : unit -> DiscoResult // * IFsWatcher @@ -116,7 +116,7 @@ type IRaftSnapshotCallbacks = type IRaftServer = inherit IDisposable inherit ISink - abstract Start : unit -> Either + abstract Start : unit -> DiscoResult abstract Member : RaftMember abstract MemberId : MemberId abstract Append : StateMachine -> unit @@ -143,18 +143,18 @@ type IWebSocketServer = abstract Sessions : Map abstract Broadcast : StateMachine -> unit abstract Multicast : except:SessionId -> StateMachine -> unit - abstract BuildSession : SessionId -> Session -> Either + abstract BuildSession : SessionId -> Session -> Result abstract Subscribe : (DiscoEvent -> unit) -> System.IDisposable - abstract Start : unit -> Either + abstract Start : unit -> DiscoResult // * IAssetService type IAssetService = inherit IDisposable abstract State: FsTree option - abstract Start: unit -> Either + abstract Start: unit -> DiscoResult abstract Subscribe: (DiscoEvent -> unit) -> IDisposable - abstract Stop: unit -> Either + abstract Stop: unit -> DiscoResult // * IApiServerCallbacks @@ -166,7 +166,7 @@ type IApiServerCallbacks = type IApiServer = inherit IDisposable inherit ISink - abstract Start: unit -> Either + abstract Start: unit -> DiscoResult abstract Subscribe: (DiscoEvent -> unit) -> IDisposable abstract Clients: Map abstract SendSnapshot: unit -> unit @@ -176,7 +176,7 @@ type IApiServer = type IHttpServer = inherit System.IDisposable - abstract Start: unit -> Either + abstract Start: unit -> DiscoResult // * DiscoServiceOptions @@ -205,12 +205,12 @@ type IDiscoService = abstract AssetService: IAssetService abstract RemoveMachine: MemberId -> unit abstract SocketServer: IWebSocketServer - abstract Start: unit -> Either + abstract Start: unit -> DiscoResult abstract State: State abstract Status: ServiceStatus abstract Subscribe: (DiscoEvent -> unit) -> IDisposable - // abstract JoinCluster : IpAddress -> uint16 -> Either - // abstract LeaveCluster : unit -> Either + // abstract JoinCluster : IpAddress -> uint16 -> DiscoResult + // abstract LeaveCluster : unit -> DiscoResult // * DiscoOptions @@ -227,6 +227,6 @@ type IDisco = abstract HttpServer: IHttpServer abstract DiscoveryService: IDiscoveryService option abstract DiscoService: IDiscoService option - abstract SaveProject: unit -> Either - abstract LoadProject: Name * UserName * Password * (Name * SiteId) option -> Either - abstract UnloadProject: unit -> Either + abstract SaveProject: unit -> DiscoResult + abstract LoadProject: Name * UserName * Password * (Name * SiteId) option -> DiscoResult + abstract UnloadProject: unit -> DiscoResult diff --git a/src/Disco/Disco/Service/Main.fs b/src/Disco/Disco/Service/Main.fs index b8db3443..ebe13de1 100644 --- a/src/Disco/Disco/Service/Main.fs +++ b/src/Disco/Disco/Service/Main.fs @@ -128,7 +128,7 @@ module Main = match target with | Some path when Directory.exists path && Directory.contains (path fileName) path -> match MachineConfig.load target with - | Right config -> config + | Ok config -> config | _ -> MachineConfig.create address None | _ -> MachineConfig.create address None @@ -150,14 +150,14 @@ module Main = if yes then MachineConfig.save target result - |> Either.map + |> Result.map (fun _ -> match target with | Some path -> printfn "Wrote machine configuration to: %A" path | None -> printfn "Wrote machine configuration to: ./etc/machinecfg.yaml") else printfn "Aborted." - Either.nothing + Result.nothing // ** setupDefaults @@ -184,13 +184,13 @@ module Main = match target with | Some path when Directory.exists path && Directory.contains (path fileName) path -> match MachineConfig.load target with - | Right config -> config + | Ok config -> config | _ -> MachineConfig.create address None | _ -> MachineConfig.create address None machine |> MachineConfig.save target - |> Either.map + |> Result.map (fun _ -> match target with | Some path -> printfn "Wrote machine configuration to: %A" path @@ -215,8 +215,8 @@ module Main = |> Option.map filepath |> MachineConfig.load match machine with - | Left error -> Error.exitWith error - | Right machine -> + | Error error -> Error.exitWith error + | Ok machine -> do MachineConfig.set machine let validation = MachineConfig.validate machine if not validation.IsEmpty then diff --git a/src/Disco/Disco/Service/NetUtils.fs b/src/Disco/Disco/Service/NetUtils.fs index c046e1b5..b9c56494 100644 --- a/src/Disco/Disco/Service/NetUtils.fs +++ b/src/Disco/Disco/Service/NetUtils.fs @@ -100,7 +100,7 @@ module NetUtils = /// - request: RaftRequest to send /// - client: client socket to use /// - /// Returns: Either + /// Returns: DiscoResult let performRequest (request: RaftRequest) (client: ITcpClient) = try rawRequest request client diff --git a/src/Disco/Disco/Service/Persistence.fs b/src/Disco/Disco/Service/Persistence.fs index 7eb375d5..cf13bc46 100644 --- a/src/Disco/Disco/Service/Persistence.fs +++ b/src/Disco/Disco/Service/Persistence.fs @@ -35,9 +35,9 @@ module Persistence = /// ### Signature: /// - options: RaftOptions /// - /// Returns: Either + /// Returns: DiscoResult let createRaft (options: DiscoConfig) = - either { + result { let! mem = Config.selfMember options let! mems = Config.getMembers options let state = @@ -63,9 +63,9 @@ module Persistence = /// ### Signature: /// - options: Project Config /// - /// Returns: Either - let loadRaft (options: DiscoConfig) : Either = - either { + /// Returns: DiscoResult + let loadRaft (options: DiscoConfig): DiscoResult = + result { let! mem = Config.selfMember options let! mems = Config.getMembers options let count = Map.fold (fun m _ _ -> m + 1) 0 mems @@ -93,10 +93,10 @@ module Persistence = /// ### Signature: /// - options: Project Config /// - /// Returns: Either + /// Returns: DiscoResult let getRaft (options: DiscoConfig) = match loadRaft options with - | Right raft -> Either.succeed raft + | Ok raft -> Result.succeed raft | _ -> createRaft options // ** saveRaft @@ -110,19 +110,19 @@ module Persistence = /// - config: DiscoConfig /// - raft: Raft state value /// - /// Returns: Either + /// Returns: DiscoResult let saveRaft (config: DiscoConfig) (raft: RaftState) = try raft |> Yaml.encode |> Payload |> DiscoData.write (Config.metadataPath config) - |> Either.succeed + |> Result.succeed with | exn -> sprintf "Project Save Error: %s" exn.Message |> Error.asProjectError "Persistence.saveRaft" - |> Either.fail + |> Result.fail // ** persistEntry @@ -134,7 +134,7 @@ module Persistence = /// - project: DiscoProject to work on /// - sm: StateMachine command /// - /// Returns: Either + /// Returns: DiscoResult let persistEntry (state: State) (sm: StateMachine) = let basePath = state.Project.Path let inline save t = Asset.save basePath t @@ -241,7 +241,7 @@ module Persistence = let path = PinGroup.absolutePath basePath pin.ClientId pin.PinGroupId if File.exists path then File.delete path - else Either.nothing + else Result.nothing | RemovePin pin -> @@ -254,7 +254,7 @@ module Persistence = let path = PinGroup.absolutePath basePath pin.ClientId pin.PinGroupId if File.exists path then File.delete path - else Either.nothing + else Result.nothing | Command AppCommand.Save -> save state @@ -264,7 +264,7 @@ module Persistence = // | |_| | |_| | | | __/ | // \___/ \__|_| |_|\___|_| - | _ -> Either.nothing + | _ -> Result.nothing // ** commitChanges @@ -276,9 +276,9 @@ module Persistence = /// - project: DiscoProject to work on /// - sm: StateMachine command /// - /// Returns: Either + /// Returns: DiscoResult let commitChanges (state: State) = - either { + result { let signature = User.Admin.Signature let! repo = state.Project |> Project.repository do! Git.Repo.stageAll repo @@ -292,13 +292,13 @@ module Persistence = repo |> Git.Config.remotes |> Map.map (konst (Git.Repo.push repo)) - |> Map.filter (konst (Either.isFail)) - |> Map.map (konst (Either.error)) + |> Map.filter (konst (Result.isFail)) + |> Map.map (konst (Result.error)) // ** persistSnapshot let persistSnapshot (state: State) (log: Disco.Raft.LogEntry) = - either { + result { let path = state.Project.Path do! state.Save(path) use! repo = Project.repository state.Project @@ -330,7 +330,7 @@ module Persistence = Git.Config.updateRemote repo remote uri | Some remote -> - Either.succeed remote + Result.succeed remote // ** ensureRemote @@ -352,7 +352,7 @@ module Persistence = Git.Config.updateRemote repo remote uri | Some remote -> - Either.succeed remote + Result.succeed remote // ** ensureRemotes @@ -372,6 +372,6 @@ module Persistence = if not (Git.Branch.isTracking branch) then Git.Branch.setTracked repo branch remote else - Either.nothing + Result.nothing #endif diff --git a/src/Disco/Disco/Service/RaftRequest.fs b/src/Disco/Disco/Service/RaftRequest.fs index 424fab4d..ded447b1 100644 --- a/src/Disco/Disco/Service/RaftRequest.fs +++ b/src/Disco/Disco/Service/RaftRequest.fs @@ -136,10 +136,10 @@ type RaftRequest = // ** FromBytes - static member FromBytes (bytes: byte array) : Either = + static member FromBytes (bytes: byte array) : DiscoResult = let msg = RaftMsgFB.GetRootAsRaftMsgFB(new ByteBuffer(bytes)) match msg.MsgType with - | RaftMsgTypeFB.RequestVoteFB -> either { + | RaftMsgTypeFB.RequestVoteFB -> result { let entry = msg.Msg() if entry.HasValue then let rv = entry.Value @@ -152,15 +152,15 @@ type RaftRequest = return! "Could not parse empty VoteRequestFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail else return! "Could not parse empty RequestVoteFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.RequestAppendEntriesFB -> either { + | RaftMsgTypeFB.RequestAppendEntriesFB -> result { let entry = msg.Msg() if entry.HasValue then let ae = entry.Value @@ -173,15 +173,15 @@ type RaftRequest = return! "Could not parse empty AppendEntriesFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail else return! "Could not parse empty RequestAppendEntriesFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.RequestInstallSnapshotFB -> either { + | RaftMsgTypeFB.RequestInstallSnapshotFB -> result { let entry = msg.Msg() if entry.HasValue then let is = entry.Value @@ -194,15 +194,15 @@ type RaftRequest = return! "Could not parse empty InstallSnapshotFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail else return! "Could not parse empty RequestInstallSnapshotFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.RequestAppendEntryFB -> either { + | RaftMsgTypeFB.RequestAppendEntryFB -> result { let entry = msg.Msg() if entry.HasValue then let is = entry.Value @@ -214,15 +214,15 @@ type RaftRequest = return! "Could not parse empty AppendEntryFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail else return! "Could not parse empty RequestAppendEntryFB body" |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail } - // | RaftMsgTypeFB.HandShakeFB -> either { + // | RaftMsgTypeFB.HandShakeFB -> result { // let entry = msg.Msg() // if entry.HasValue then // let hs = entry.Value @@ -234,15 +234,15 @@ type RaftRequest = // return! // "Could not parse empty RaftMemberFB body" // |> Error.asParseError "RaftRequest.FromBytes" - // |> Either.fail + // |> Result.fail // else // return! // "Could not parse empty HandShakeFB body" // |> Error.asParseError "RaftRequest.FromBytes" - // |> Either.fail + // |> Result.fail // } - // | RaftMsgTypeFB.HandWaiveFB -> either { + // | RaftMsgTypeFB.HandWaiveFB -> result { // let entry = msg.Msg() // if entry.HasValue then // let hw = entry.Value @@ -254,18 +254,18 @@ type RaftRequest = // return! // "Could not parse empty RaftMemberFB body" // |> Error.asParseError "RaftRequest.FromBytes" - // |> Either.fail + // |> Result.fail // else // return! // "Could not parse empty HandShakeFB body" // |> Error.asParseError "RaftRequest.FromBytes" - // |> Either.fail + // |> Result.fail // } | x -> sprintf "Could not parse unknown RaftMsgTypeFB: %A" x |> Error.asParseError "RaftRequest.FromBytes" - |> Either.fail + |> Result.fail // * RaftResponse @@ -326,9 +326,9 @@ type RaftResponse = // ** FromFB - static member FromFB(msg: RaftMsgFB) : Either = + static member FromFB(msg: RaftMsgFB) : DiscoResult = match msg.MsgType with - | RaftMsgTypeFB.RespondVoteFB -> either { + | RaftMsgTypeFB.RespondVoteFB -> result { let entry = msg.Msg() if entry.HasValue then let fb = entry.Value @@ -341,15 +341,15 @@ type RaftResponse = return! "Could not parse empty VoteResponseFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty RespondVoteFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.RespondAppendEntriesFB -> either { + | RaftMsgTypeFB.RespondAppendEntriesFB -> result { let entry = msg.Msg() if entry.HasValue then let fb = entry.Value @@ -362,15 +362,15 @@ type RaftResponse = return! "Could not parse empty AppendResponseFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty RespodnAppendEntriesFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.RespondInstallSnapshotFB -> either { + | RaftMsgTypeFB.RespondInstallSnapshotFB -> result { let entry = msg.Msg() if entry.HasValue then let fb = entry.Value @@ -383,15 +383,15 @@ type RaftResponse = return! "Could not parse empty AppendResponseFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty RespondInstallSnapshotFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.RespondAppendEntryFB -> either { + | RaftMsgTypeFB.RespondAppendEntryFB -> result { let entry = msg.Msg() if entry.HasValue then let fb = entry.Value @@ -403,15 +403,15 @@ type RaftResponse = return! "Could not parse empty AppendResponseFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty RespondInstallSnapshotFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.ErrorResponseFB -> either { + | RaftMsgTypeFB.ErrorResponseFB -> result { let entry = msg.Msg() if entry.HasValue then let rv = entry.Value @@ -424,15 +424,15 @@ type RaftResponse = return! "Could not parse empty ErrorFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty ErrorResponseFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail } - | RaftMsgTypeFB.RedirectFB -> either { + | RaftMsgTypeFB.RedirectFB -> result { let entry = msg.Msg() if entry.HasValue then let rd = entry.Value @@ -444,15 +444,15 @@ type RaftResponse = return! "Could not parse empty RaftMemberFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail else return! "Could not parse empty RedirectFB body" |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail } - // | RaftMsgTypeFB.WelcomeFB -> either { + // | RaftMsgTypeFB.WelcomeFB -> result { // let entry = msg.Msg() // if entry.HasValue then // let wl = entry.Value @@ -464,21 +464,21 @@ type RaftResponse = // return! // "Could not parse empty RaftMemberFB body" // |> Error.asParseError "RaftResponse.FromFB" - // |> Either.fail + // |> Result.fail // else // return! // "Could not parse empty WelcomeFB body" // |> Error.asParseError "RaftResponse.FromFB" - // |> Either.fail + // |> Result.fail // } // | RaftMsgTypeFB.ArrivederciFB -> - // Right Arrivederci + // Ok Arrivederci | x -> sprintf "Could not parse unknown RaftMsgTypeFB: %A" x |> Error.asParseError "RaftResponse.FromFB" - |> Either.fail + |> Result.fail // ** ToBytes @@ -486,6 +486,6 @@ type RaftResponse = // ** FromBytes - static member FromBytes (bytes: byte array) : Either = + static member FromBytes (bytes: byte array) : DiscoResult = let msg = RaftMsgFB.GetRootAsRaftMsgFB(ByteBuffer(bytes)) RaftResponse.FromFB msg diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index 56123aad..4df74925 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -305,7 +305,7 @@ module rec RaftServer = // self.State // |> RaftContext.getRaft // |> saveRaft options - // |> Either.mapError + // |> Result.mapError // (fun err -> // printfn "Could not persit vote change. %A" err) // |> ignore @@ -321,7 +321,7 @@ module rec RaftServer = // self.State // |> RaftContext.getRaft // |> saveRaft options - // |> Either.mapError + // |> Result.mapError // (fun err -> // printfn "Could not persit vote change. %A" err) // |> ignore @@ -345,13 +345,13 @@ module rec RaftServer = |> runRaft state.Raft state.Callbacks match result with - | Right (appended, raftState) -> + | Ok (appended, raftState) -> (appended, updateRaft state raftState) - |> Either.succeed + |> Result.succeed - | Left (err, raftState) -> + | Error (err, raftState) -> (err, updateRaft state raftState) - |> Either.fail + |> Result.fail // ** appendCommand @@ -370,12 +370,12 @@ module rec RaftServer = |> Log.mkConfig state.Raft.CurrentTerm |> appendEntry state match result with - | Right (entry, newstate) -> + | Ok (entry, newstate) -> entry.Id |> String.format "appended new Configuration in {0}" |> Logger.info (tag "onConfigDone") newstate - | Left (error, newstate) -> + | Error (error, newstate) -> error |> String.format "error appending new Configruation: {0}" |> Logger.err (tag "onConfigDone") @@ -391,7 +391,7 @@ module rec RaftServer = /// - state: current RaftServerState to work against /// - mems: the changes to make to the current cluster configuration /// - /// Returns: Either + let private addMembers (state: RaftServerState) (mems: RaftMember array) = if RaftState.isLeader state.Raft then mems @@ -402,7 +402,7 @@ module rec RaftServer = let msg = "Unable to add new member. Not leader." let error = Error.asRaftError (tag "addMembers") msg Logger.err (tag "addMembers") msg - Either.fail (error, state) + Result.fail (error, state) // ** removeMembers @@ -442,12 +442,12 @@ module rec RaftServer = let msg = sprintf "Unable to remove member. Not found: %A" (string id) let error = Error.asRaftError (tag "removeMember") msg Logger.err (tag "removeMember") msg - Either.fail (error, state) + Result.fail (error, state) else let msg = "Unable to remove mem. Not leader." let error = Error.asRaftError (tag "removeMember") msg Logger.err (tag "removeMember") msg - Either.fail (error, state) + Result.fail (error, state) // ** processAppendEntries @@ -459,7 +459,7 @@ module rec RaftServer = Raft.receiveAppendEntries (Some sender) ae |> runRaft state.Raft state.Callbacks match result with - | Right (response, newstate) -> + | Ok (response, newstate) -> (state.Raft.Member.Id, response) |> AppendEntriesResponse |> Binary.encode @@ -467,7 +467,7 @@ module rec RaftServer = |> state.Server.Respond updateRaft state newstate - | Left (err, newstate) -> + | Error (err, newstate) -> (state.Raft.Member.Id, err) |> ErrorResponse |> Binary.encode @@ -483,7 +483,7 @@ module rec RaftServer = (agent: RaftAgent) = if RaftState.isLeader state.Raft then // I'm leader, so I try to append command match appendCommand state cmd with - | Right (entry, newstate) -> // command was appended, now queue a message and the later + | Ok (entry, newstate) -> // command was appended, now queue a message and the later entry // response to check its committed status, eventually |> AppendEntryResponse // timing out or responding to the server |> Binary.encode @@ -491,7 +491,7 @@ module rec RaftServer = |> fun response -> Msg.ReqCommitted(DateTime.Now, entry, response) |> agent.Post newstate - | Left (err, newstate) -> // Request was unsuccessful, respond immeditately + | Error (err, newstate) -> // Request was unsuccessful, respond immeditately (state.Raft.Member.Id, err) |> ErrorResponse |> Binary.encode @@ -526,14 +526,14 @@ module rec RaftServer = Raft.receiveVoteRequest sender vr |> runRaft state.Raft state.Callbacks match result with - | Right (response, newstate) -> + | Ok (response, newstate) -> (state.Raft.Member.Id, response) |> RequestVoteResponse |> Binary.encode |> Response.fromRequest raw |> state.Server.Respond updateRaft state newstate - | Left (err, newstate) -> + | Error (err, newstate) -> (state.Raft.Member.Id, err) |> ErrorResponse |> Binary.encode @@ -548,14 +548,14 @@ module rec RaftServer = Raft.receiveInstallSnapshot is |> runRaft state.Raft state.Callbacks match result with - | Right (response, newstate) -> + | Ok (response, newstate) -> (state.Raft.Member.Id, response) |> InstallSnapshotResponse |> Binary.encode |> Response.fromRequest raw |> state.Server.Respond updateRaft state newstate - | Left (error, newstate) -> + | Error (error, newstate) -> (state.Raft.Member.Id, error) |> ErrorResponse |> Binary.encode @@ -572,7 +572,7 @@ module rec RaftServer = /// ### Signature: /// - state: RaftServerState /// - /// Returns: Either + /// Results: DiscoResult let private doRedirect (state: RaftServerState) (raw: Request) = match RaftState.getLeader state.Raft with | Some mem -> @@ -609,7 +609,7 @@ module rec RaftServer = Tracing.trace (tag "processHandshake") <| fun () -> if RaftState.isLeader state.Raft then match addMembers state [| mem |] with - | Right (entry, newstate) -> + | Ok (entry, newstate) -> let response = // response to check its committed status, eventually mem |> Welcome @@ -619,7 +619,7 @@ module rec RaftServer = |> Msg.ReqCommitted |> agent.Post newstate - | Left (err, newstate) -> + | Error (err, newstate) -> err |> ErrorResponse |> Binary.encode @@ -638,7 +638,7 @@ module rec RaftServer = Tracing.trace (tag "processHandwaive") <| fun () -> if RaftState.isLeader state.Raft then match removeMember state mem.Id with - | Right (entry, newstate) -> + | Ok (entry, newstate) -> let response = // response to check its committed status, eventually Arrivederci |> Binary.encode @@ -647,7 +647,7 @@ module rec RaftServer = |> Msg.ReqCommitted |> agent.Post newstate - | Left (err, newstate) -> + | Error (err, newstate) -> err |> ErrorResponse |> Binary.encode @@ -669,8 +669,8 @@ module rec RaftServer = |> runRaft state.Raft state.Callbacks match result with - | Right (_, newstate) -> updateRaft state newstate - | Left (err, newstate) -> + | Ok (_, newstate) -> updateRaft state newstate + | Error (err, newstate) -> err |> DiscoEvent.RaftError |> Msg.Notify @@ -688,8 +688,8 @@ module rec RaftServer = |> runRaft state.Raft state.Callbacks match result with - | Right (_, newstate) -> updateRaft state newstate - | Left (err, newstate) -> + | Ok (_, newstate) -> updateRaft state newstate + | Error (err, newstate) -> err |> DiscoEvent.RaftError |> Msg.Notify @@ -748,7 +748,7 @@ module rec RaftServer = let private tryJoin (state: RaftServerState) (ip: IpAddress) (port: uint16) = let rec _tryJoin retry peer = - either { + result { if retry < int state.Options.Raft.MaxRetries then use client = mkReqSocket peer @@ -775,7 +775,7 @@ module rec RaftServer = | ErrorResponse err -> sprintf "Unexpected error occurred. %A" err |> Logger.err "tryJoin" - return! Either.fail err + return! Result.fail err | resp -> sprintf "Unexpected response. %A" resp @@ -783,14 +783,14 @@ module rec RaftServer = return! "Unexpected response" |> Error.asRaftError (tag "tryJoin") - |> Either.fail + |> Result.fail else "Too many unsuccesful connection attempts." |> Logger.err "tryJoin" return! "Too many unsuccesful connection attempts." |> Error.asRaftError (tag "tryJoin") - |> Either.fail + |> Result.fail } Tracing.trace (tag "tryJoin") <| fun () -> @@ -813,14 +813,14 @@ module rec RaftServer = let leader = tryJoin state ip port match leader with - | Right leader -> + | Ok leader -> sprintf "Reached leader: %A Adding to mems." leader.Id |> Logger.info (tag "tryJoinCluster") do! addMember leader do! Raft.becomeFollower () - | Left err -> + | Error err -> sprintf "Joining cluster failed. %A" err |> Logger.err (tag "tryJoinCluster") @@ -841,9 +841,9 @@ module rec RaftServer = /// - appState: RaftServerState TVar /// /// Returns: unit - let private tryLeave (state: RaftServerState) : Either = + let private tryLeave (state: RaftServerState): DiscoResult = let rec _tryLeave retry mem = - either { + result { if retry < int state.Options.Raft.MaxRetries then use client = mkReqSocket mem @@ -859,19 +859,19 @@ module rec RaftServer = return! "Too many retries, aborting." |> Error.asRaftError (tag "tryLeave") - |> Either.fail + |> Result.fail | Arrivederci -> return true - | ErrorResponse err -> return! Either.fail err + | ErrorResponse err -> return! Result.fail err | resp -> return! "Unexpected response" |> Error.asRaftError (tag "tryLeave") - |> Either.fail + |> Result.fail else return! "Too many unsuccesful connection attempts." |> Error.asRaftError (tag "tryLeave") - |> Either.fail + |> Result.fail } Tracing.trace (tag "tryLeave") <| fun () -> @@ -883,11 +883,11 @@ module rec RaftServer = | _ -> "Member data for leader id not found" |> Error.asRaftError (tag "tryLeave") - |> Either.fail + |> Result.fail | _ -> "No known Leader" |> Error.asRaftError (tag "tryLeave") - |> Either.fail + |> Result.fail *) // ** leaveCluster @@ -901,16 +901,16 @@ module rec RaftServer = match tryLeave state with - | Right true -> + | Ok true -> // FIXME: this might need more consequences than this "Successfully left cluster." |> Logger.info (tag "tryLeaveCluster") - | Right false -> + | Ok false -> "Could not leave cluster." |> Logger.err (tag "tryLeaveCluster") - | Left err -> + | Error err -> err |> sprintf "Could not leave cluster. %A" |> Logger.err (tag "tryLeaveCluster") @@ -952,10 +952,10 @@ module rec RaftServer = let private handleJoin (state: RaftServerState) (ip: IpAddress) (port: UInt16) = Tracing.trace (tag "handleJoin") <| fun () -> match tryJoinCluster state ip port with - | Right (_, newstate) -> + | Ok (_, newstate) -> notify state.Subscriptions DiscoEvent.JoinedCluster updateRaft state newstate - | Left (error, newstate) -> + | Error (error, newstate) -> error |> DiscoEvent.RaftError |> notify state.Subscriptions @@ -969,11 +969,11 @@ module rec RaftServer = let private handleLeave (state: RaftServerState) = Tracing.trace (tag "handleLeave") <| fun () -> match tryLeaveCluster state with - | Right (_, newstate) -> + | Ok (_, newstate) -> notify state.Subscriptions DiscoEvent.LeftCluster updateRaft state newstate - | Left (error, newstate) -> + | Error (error, newstate) -> error |> string |> Logger.err (tag "handleLeave") @@ -987,8 +987,8 @@ module rec RaftServer = let private handleForceElection (state: RaftServerState) (agent: RaftAgent) = match forceElection state with - | Right (_, newstate) -> updateRaft state newstate - | Left (err, newstate) -> + | Ok (_, newstate) -> updateRaft state newstate + | Error (err, newstate) -> err |> sprintf "Unable to force an election: %A" |> Logger.err (tag "handleForceElection") @@ -1002,12 +1002,12 @@ module rec RaftServer = let private handleAddCmd (state: RaftServerState) (agent: RaftAgent) (cmd: StateMachine) = match appendCommand state cmd with - | Right (_, newstate) -> + | Ok (_, newstate) -> // (DateTime.Now, entry) // |> Msg.IsCommitted // |> agent.Post newstate - | Left (err, newstate) -> + | Error (err, newstate) -> err |> string |> Logger.err (tag "handleAddCmd") @@ -1033,12 +1033,12 @@ module rec RaftServer = |> Option.map (registerPeerSocket agent) |> Option.iter (addPeerSocket state.Connections) match addMembers state [| mem |] with - | Right (_, newstate) -> + | Ok (_, newstate) -> // (DateTime.Now, entry) // |> Msg.IsCommitted // |> agent.Post newstate - | Left (err, newstate) -> + | Error (err, newstate) -> err |> string |> Logger.err (tag "handleAddMember") @@ -1054,12 +1054,12 @@ module rec RaftServer = (agent: RaftAgent) (id: MemberId) = match removeMember state id with - | Right (_, newstate) -> + | Ok (_, newstate) -> // (DateTime.Now, entry) // |> Msg.IsCommitted // |> agent.Post newstate - | Left (err, newstate) -> + | Error (err, newstate) -> err |> string |> Logger.err (tag "handleRemoveMember") @@ -1082,10 +1082,10 @@ module rec RaftServer = let delta = DateTime.Now - ts match result with - | Right (true, newstate) -> // the entry was committed, hence we reply to the caller + | Ok (true, newstate) -> // the entry was committed, hence we reply to the caller entry |> Reply.Entry - |> Either.succeed + |> Result.succeed |> chan.Reply delta.TotalMilliseconds @@ -1096,11 +1096,11 @@ module rec RaftServer = |> updateRaft data |> Loaded - | Right (false, newstate) -> // the entry was not yet committed + | Ok (false, newstate) -> // the entry was not yet committed if int delta.TotalMilliseconds > Constants.COMMAND_TIMEOUT then "Command timed out" // failed miserably |> Error.asRaftError "handleIsCommitted" - |> Either.fail + |> Result.fail |> chan.Reply delta.TotalMilliseconds @@ -1118,9 +1118,9 @@ module rec RaftServer = |> updateRaft data |> Loaded - | Left (err, newstate) -> // encountered an error during check. request failed + | Error (err, newstate) -> // encountered an error during check. request failed err - |> Either.fail + |> Result.fail |> chan.Reply newstate @@ -1131,7 +1131,7 @@ module rec RaftServer = // ** processRequest let private processRequest (data: RaftServerState) (agent: RaftAgent) (raw: Request) = - either { + result { let! request = Binary.decode raw.Body let newstate = match request with @@ -1148,8 +1148,8 @@ module rec RaftServer = let private handleServerRequest (state: RaftServerState) (raw: Request) agent = match processRequest state agent raw with - | Right newdata -> newdata - | Left error -> + | Ok newdata -> newdata + | Error error -> (state.Raft.Member.Id, error) |> ErrorResponse |> Binary.encode @@ -1190,7 +1190,7 @@ module rec RaftServer = let delta = DateTime.Now - ts match result with - | Right (true, newstate) -> + | Ok (true, newstate) -> state.Server.Respond raw delta @@ -1200,7 +1200,7 @@ module rec RaftServer = updateRaft state newstate - | Right (false, newstate) -> + | Ok (false, newstate) -> if int delta.TotalMilliseconds > Constants.COMMAND_TIMEOUT then "AppendEntry timed out" |> Error.asRaftError "handleReqCommitted" @@ -1219,7 +1219,7 @@ module rec RaftServer = |> Msg.ReqCommitted |> agent.Post updateRaft state newstate - | Left (err, newstate) -> + | Error (err, newstate) -> (state.Raft.Member.Id, err) |> ErrorResponse |> Binary.encode @@ -1231,14 +1231,14 @@ module rec RaftServer = let private handleServerResponse (state: RaftServerState) agent (raw: Response) = match Binary.decode raw.Body with - | Right response -> + | Ok response -> match response with | RequestVoteResponse (sender, vote) -> processVoteResponse state sender vote agent | AppendEntriesResponse (sender, ar) -> processAppendEntriesResponse state sender ar agent | InstallSnapshotResponse (sender, ar) -> processSnapshotResponse state sender ar agent | ErrorResponse (sender, error) -> processErrorResponse state sender error | _ -> state - | Left error -> + | Error error -> error |> string |> Logger.err (tag "handleRawRespose") @@ -1255,8 +1255,8 @@ module rec RaftServer = } |> runRaft state.Raft state.Callbacks |> function - | Right (_, newstate) -> updateRaft state newstate - | Left (err,_) -> + | Ok (_, newstate) -> updateRaft state newstate + | Error (err,_) -> err |> String.format "Could not set new state on member: {0}" |> Logger.err (tag "handleClientState") @@ -1266,18 +1266,18 @@ module rec RaftServer = let private handleClientResponse (state: RaftServerState) (raw: Response) agent = match raw.Body |> Binary.decode with - | Right (AppendEntryResponse entry) -> + | Ok (AppendEntryResponse entry) -> // FIXME: // this will likely take some more thought and handling sprintf "successfully appended entry in %O" entry.Id |> Logger.debug (tag "handleClientResponse") state - | Right (AppendEntriesResponse(id, ar)) -> processAppendEntriesResponse state id ar agent - | Right (RequestVoteResponse(id, vr)) -> processVoteResponse state id vr agent - | Right (InstallSnapshotResponse(id, ar)) -> processSnapshotResponse state id ar agent - | Right (ErrorResponse(id, error)) -> processErrorResponse state id error - | Right (Redirect leader) -> processRedirect state leader - | Left error -> + | Ok (AppendEntriesResponse(id, ar)) -> processAppendEntriesResponse state id ar agent + | Ok (RequestVoteResponse(id, vr)) -> processVoteResponse state id vr agent + | Ok (InstallSnapshotResponse(id, ar)) -> processSnapshotResponse state id ar agent + | Ok (ErrorResponse(id, error)) -> processErrorResponse state id error + | Ok (Redirect leader) -> processRedirect state leader + | Error error -> error |> sprintf "Error decoding response: %O" |> Logger.err (tag "handleClientResponse") @@ -1322,14 +1322,14 @@ module rec RaftServer = do! Raft.becomeFollower () } |> runRaft state callbacks - |> Either.mapError fst - |> Either.map snd + |> Result.mapError fst + |> Result.map snd // ** handleStart let private handleStart (state: RaftServerState) (agent: RaftAgent) = match initializeRaft state.Callbacks state.Raft with - | Right initialized -> + | Ok initialized -> // periodic function let interval = int state.Options.Raft.PeriodicInterval let periodic = startPeriodic interval agent @@ -1339,7 +1339,7 @@ module rec RaftServer = Status = ServiceStatus.Running Raft = initialized Disposables = periodic :: state.Disposables } - | Left error -> + | Error error -> sprintf "Fatal, could not initialize Raft: %O" error |> Logger.err (tag "handleStart") agent.Post Msg.Started @@ -1392,7 +1392,7 @@ module rec RaftServer = // ** create let create (config: DiscoConfig) callbacks = - either { + result { let cts = new CancellationTokenSource() let connections = new Connections() let store = AgentStore.create() @@ -1434,7 +1434,7 @@ module rec RaftServer = // we must start the agent, so the dispose logic will work as expected do agent.Start() match server.Start() with - | Right () -> + | Ok () -> let srvobs = server.Subscribe(Msg.ServerEvent >> agent.Post) Map.iter @@ -1461,22 +1461,22 @@ module rec RaftServer = if result then match store.State.Status with | ServiceStatus.Failed error -> - Either.fail error - | _ -> Either.succeed () + Result.fail error + | _ -> Result.succeed () else "Timeout waiting for started signal" |> Error.asRaftError (tag "Start") - |> Either.fail - | Left error -> + |> Result.fail + | Error error -> error |> sprintf "error starting broker: %O" |> Logger.err (tag "Start") store.Update { store.State with Status = ServiceStatus.Failed error } - Either.fail error + Result.fail error else sprintf "Status error. %O" store.State.Status |> Error.asRaftError (tag "Start") - |> Either.fail + |> Result.fail member self.Raft with get () = store.State.Raft diff --git a/src/Disco/Disco/Service/WebSocket.fs b/src/Disco/Disco/Service/WebSocket.fs index 6ce69273..9ffa3307 100644 --- a/src/Disco/Disco/Service/WebSocket.fs +++ b/src/Disco/Disco/Service/WebSocket.fs @@ -60,18 +60,18 @@ module WebSocketServer = IpAddress = IpAddress.Parse socket.ConnectionInfo.ClientIpAddress UserAgent = ua } if connections.TryUpdate(socketId, (socket, Some updated), current) then - Either.succeed updated + Result.succeed updated elif connections.TryUpdate(socketId, (socket, Some updated), current) then - Either.succeed updated + Result.succeed updated else "Updating connections failed after one retry" |> Error.asSocketError (tag "buildSession") - |> Either.fail + |> Result.fail | false, _ -> socketId |> String.format "No connection found for {0}" |> Error.asSocketError (tag "buildSession") - |> Either.fail + |> Result.fail // ** ucast @@ -85,22 +85,22 @@ module WebSocketServer = |> Binary.encode |> socket.Send |> ignore - |> Either.succeed + |> Result.succeed with exn -> exn.Message |> Error.asSocketError (tag "send") - |> Either.fail + |> Result.fail else sid |> String.format "Socket {0} not available" |> Error.asSocketError (tag "send") - |> Either.fail + |> Result.fail | false, _ -> sid |> string |> sprintf "Could not send message to session %s. Not found." |> Error.asSocketError (tag "send") - |> Either.fail + |> Result.fail // ** bcast @@ -117,16 +117,16 @@ module WebSocketServer = |> Seq.choose (fun id -> match ucast connections id msg with - | Right () -> None - | Left error -> + | Ok () -> None + | Error error -> error.Message |> String.format "Error broadcasting message: {0}" |> Logger.err (tag "bcast") Some id) |> Seq.toList |> function - | [ ] -> Either.nothing - | result -> Either.fail result + | [ ] -> Result.nothing + | result -> Result.fail result // ** mcast @@ -143,22 +143,22 @@ module WebSocketServer = let private mcast (connections: Connections) (id: SessionId) (msg: StateMachine) : - Either = + Result = connections.Keys |> Seq.filter (fun sid -> id <> sid) |> Seq.choose (fun id -> match ucast connections id msg with - | Right () -> None - | Left error -> + | Ok () -> None + | Error error -> error.Message |> String.format "Error multicasting message: {0}" |> Logger.err (tag "mcast") Some id) |> Seq.toList |> function - | [ ] -> Either.nothing - | result -> Either.fail result + | [ ] -> Result.nothing + | result -> Result.fail result // ** onNewSocket @@ -214,8 +214,8 @@ module WebSocketServer = socket.OnBinary <- fun bytes -> let sid = getConnectionId socket match Binary.decode bytes with - | Right cmd -> DiscoEvent.Append(Origin.Web sid, cmd) |> agent.Post - | Left err -> + | Ok cmd -> DiscoEvent.Append(Origin.Web sid, cmd) |> agent.Post + | Error err -> err |> string |> sprintf "Could not decode message: %s" @@ -262,7 +262,7 @@ module WebSocketServer = // ** create let create (mem: ClusterMember) = - either { + result { let status = ref ServiceStatus.Stopped let connections = Connections() let subscriptions = Subscriptions() @@ -305,13 +305,13 @@ module WebSocketServer = match ev with | DiscoEvent.Append (_, cmd) -> bcast connections cmd - |> Either.mapError handleBroadcastErrors + |> Result.mapError handleBroadcastErrors |> ignore | _ -> () member self.Send (id: SessionId) (cmd: StateMachine) = ucast connections id cmd - |> Either.mapError + |> Result.mapError (Error.message >> sprintf "Error sending to %A: %s" id >> konst [ id ] @@ -320,12 +320,12 @@ module WebSocketServer = member self.Broadcast (cmd: StateMachine) = bcast connections cmd - |> Either.mapError handleBroadcastErrors + |> Result.mapError handleBroadcastErrors |> ignore member self.Multicast (except: SessionId) (cmd: StateMachine) = mcast connections except cmd - |> Either.mapError handleBroadcastErrors + |> Result.mapError handleBroadcastErrors |> ignore member self.BuildSession (id: SessionId) (session: Session) = @@ -357,12 +357,12 @@ module WebSocketServer = status := ServiceStatus.Running "WebSocketServer successfully started" |> Logger.debug (tag "Start") - |> Either.succeed + |> Result.succeed with | exn -> exn.Message |> Error.asSocketError (tag "Start") - |> Either.fail + |> Result.fail member self.Dispose () = if Service.isRunning !status then diff --git a/src/Disco/Disco/Tests/Core/ApiTests.fs b/src/Disco/Disco/Tests/Core/ApiTests.fs index d6e18938..f1144ab6 100644 --- a/src/Disco/Disco/Tests/Core/ApiTests.fs +++ b/src/Disco/Disco/Tests/Core/ApiTests.fs @@ -54,7 +54,7 @@ module ApiTests = let test_server_should_not_start_when_bind_fails = testCase "server should not start when bind fails" <| fun _ -> - either { + result { let mutable store = Store(mkState ()) let mem = ClusterMember.create (DiscoId.Create()) @@ -72,14 +72,14 @@ module ApiTests = } do! match server2.Start() with - | Right () -> Left (Other("test","should have failed")) - | Left _ -> Right() + | Ok () -> Error (Other("test","should have failed")) + | Error _ -> Ok() } |> noError let test_server_should_replicate_state_snapshot_to_client = testCase "server should replicate state snapshot to client" <| fun _ -> - either { + result { let mutable store = Store(mkState ()) let mem = ClusterMember.create (DiscoId.Create()) @@ -147,7 +147,7 @@ module ApiTests = let test_server_should_replicate_state_machine_commands_to_client = testCase "should replicate state machine commands to client" <| fun _ -> - either { + result { let store = Store(mkState ()) let mem = ClusterMember.create (DiscoId.Create()) @@ -230,7 +230,7 @@ module ApiTests = let test_client_should_replicate_state_machine_commands_to_server = testCase "client should replicate state machine commands to server" <| fun _ -> - either { + result { use clientRegistered = new WaitEvent() use clientSnapshot = new WaitEvent() use clientUpdate = new WaitEvent() @@ -353,7 +353,7 @@ module ApiTests = let test_server_should_dispose_properly = testCase "server should dispose properly" <| fun _ -> - either { + result { let store = Store(mkState ()) let mem = ClusterMember.create (DiscoId.Create()) @@ -367,7 +367,7 @@ module ApiTests = let test_client_should_dispose_properly = testCase "client should dispose properly" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let mem = Machine.toClusterMember machine diff --git a/src/Disco/Disco/Tests/Core/AssetServiceTests.fs b/src/Disco/Disco/Tests/Core/AssetServiceTests.fs index 77d38d05..efd1ad1a 100644 --- a/src/Disco/Disco/Tests/Core/AssetServiceTests.fs +++ b/src/Disco/Disco/Tests/Core/AssetServiceTests.fs @@ -43,12 +43,12 @@ module AssetServiceTests = do File.writeText contents None filePath let machine = { DiscoMachine.Default with AssetDirectory = basePath } let filters = FsTree.parseFilters machine.AssetFilter - let fsTree = FsTree.read machine.MachineId basePath filters |> Either.get + let fsTree = FsTree.read machine.MachineId basePath filters |> Result.get machine, fsTree let testInitialCrawl = testCase "should crawl asset directory correctly" <| fun _ -> - either { + result { let machine, tree = createAssetDirectory() use crawlDone = new WaitEvent() use! service = AssetService.create machine @@ -68,7 +68,7 @@ module AssetServiceTests = let testAddEntry = testCase "add entry should work" <| fun _ -> - either { + result { let machine, tree = createAssetDirectory() use crawlDone = new WaitEvent() use addDone = new WaitEvent() @@ -104,7 +104,7 @@ module AssetServiceTests = let testChangeEntry = testCase "change entry should work" <| fun _ -> - either { + result { let machine, tree = createAssetDirectory() use crawlDone = new WaitEvent() use changeDone = new WaitEvent() @@ -147,7 +147,7 @@ module AssetServiceTests = let testRemoveEntres = testCase "remove entries should work" <| fun _ -> - either { + result { let machine, tree = createAssetDirectory() use crawlDone = new WaitEvent() use removeDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/AssetTests.fs b/src/Disco/Disco/Tests/Core/AssetTests.fs index c6689280..2b8c7fbf 100644 --- a/src/Disco/Disco/Tests/Core/AssetTests.fs +++ b/src/Disco/Disco/Tests/Core/AssetTests.fs @@ -31,22 +31,22 @@ module AssetTests = member self.ToYaml() = self member self.Save(basePath: FilePath) = - either { + result { let path = basePath Asset.path self let data = Yaml.encode self let! info = DiscoData.write path (Payload data) return () } - static member Load(path: FilePath) : Either = - either { + static member Load(path: FilePath): DiscoResult = + result { let! data = DiscoData.read path return Yaml.deserialize data } let test_write_read_asset_correctly = testCase "should write and read asset correctly" <| fun _ -> - either { + result { let path = tmpPath() let payload = string (DiscoId.Create()) let! info = DiscoData.write path (Payload payload) @@ -57,7 +57,7 @@ module AssetTests = let test_save_load_asset_correctly = testCase "should save and load asset correctly" <| fun _ -> - either { + result { let path = tmpPath() let asset = TestAsset() do! Asset.save path asset @@ -69,7 +69,7 @@ module AssetTests = let test_save_with_commit_adds_and_commits_an_asset = testCase "should save an asset with commit even if its new" <| fun _ -> - either { + result { let path = tmpPath() let! repo = Git.Repo.init path let signature = User.Admin.Signature diff --git a/src/Disco/Disco/Tests/Core/ConfigTests.fs b/src/Disco/Disco/Tests/Core/ConfigTests.fs index 4cd72667..e8eb241c 100644 --- a/src/Disco/Disco/Tests/Core/ConfigTests.fs +++ b/src/Disco/Disco/Tests/Core/ConfigTests.fs @@ -21,7 +21,7 @@ module ConfigTests = // let loadSaveTest = testCase "Save/Load MachineConfig with default path should render equal values" <| fun _ -> - either { + result { let config = MachineConfig.create "127.0.0.1" None do! MachineConfig.save None config @@ -34,7 +34,7 @@ module ConfigTests = let loadSaveCustomPathTest = testCase "Save/Load MachineConfig with default path should render equal values" <| fun _ -> - either { + result { let path = tmpPath() let config = MachineConfig.create "127.0.0.1" None diff --git a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs index 1cbf5669..31e17867 100644 --- a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs +++ b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs @@ -25,7 +25,7 @@ module AddPreviousMemberShouldPull = let test = testCase "ensure previous member pulls from leader" <| fun _ -> - either { + result { use configurationDone = new WaitEvent() use updateDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/ClonesFromLeader.fs b/src/Disco/Disco/Tests/Core/Disco/ClonesFromLeader.fs index 355b6b10..2b1b321f 100644 --- a/src/Disco/Disco/Tests/Core/Disco/ClonesFromLeader.fs +++ b/src/Disco/Disco/Tests/Core/Disco/ClonesFromLeader.fs @@ -25,7 +25,7 @@ module ClonesFromLeader = let test = testCase "ensure disco server clones changes from leader" <| fun _ -> - either { + result { use checkGitStarted = new WaitEvent() use electionDone = new WaitEvent() use appendDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/Common.fs b/src/Disco/Disco/Tests/Core/Disco/Common.fs index a4c7881e..ef8078cb 100644 --- a/src/Disco/Disco/Tests/Core/Disco/Common.fs +++ b/src/Disco/Disco/Tests/Core/Disco/Common.fs @@ -34,7 +34,7 @@ module Common = WorkSpace = tmpPath() Path.getRandomFileName() } let mkProject (machine: DiscoMachine) (site: ClusterConfig) = - either { + result { let name = Path.GetRandomFileName() let path = machine.WorkSpace filepath name @@ -71,7 +71,7 @@ module Common = |> Map.ofList } let mkCluster (num: int) = - either { + result { let baseport = 4000us let machines = @@ -88,13 +88,13 @@ module Common = (fun (i, project') machine -> if i = 0 then match mkProject machine site with - | Right project -> (i + 1, project) - | Left error -> failwithf "unable to create project: %O" error + | Ok project -> (i + 1, project) + | Error error -> failwithf "unable to create project: %O" error else let path = project'.Path match copyDir path (machine.WorkSpace (project'.Name |> unwrap |> filepath)) with - | Right () -> (i + 1, project') - | Left error -> failwithf "error copying project: %O" error) + | Ok () -> (i + 1, project') + | Error error -> failwithf "error copying project: %O" error) (0, Unchecked.defaultof) machines |> snd diff --git a/src/Disco/Disco/Tests/Core/Disco/CorrectPinPersistance.fs b/src/Disco/Disco/Tests/Core/Disco/CorrectPinPersistance.fs index 2051b095..e9a07ec4 100644 --- a/src/Disco/Disco/Tests/Core/Disco/CorrectPinPersistance.fs +++ b/src/Disco/Disco/Tests/Core/Disco/CorrectPinPersistance.fs @@ -34,7 +34,7 @@ module CorrectPinPersistance = then pending testName else testCase testName <| fun _ -> - either { + result { use started = new WaitEvent() use appendDone = new WaitEvent() use createDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/EnsureClientCommandForward.fs b/src/Disco/Disco/Tests/Core/Disco/EnsureClientCommandForward.fs index 9941ced5..03a2374f 100644 --- a/src/Disco/Disco/Tests/Core/Disco/EnsureClientCommandForward.fs +++ b/src/Disco/Disco/Tests/Core/Disco/EnsureClientCommandForward.fs @@ -25,7 +25,7 @@ module EnsureClientCommandForward = let test = testCase "ensure client commands are forwarded to leader" <| fun _ -> - either { + result { use electionDone = new WaitEvent() use clientReady = new WaitEvent() use clientAppendDone = new WaitEvent() @@ -167,7 +167,7 @@ module EnsureClientCommandForward = { Id = DiscoId.Create(); Name = name "Cue 3"; Slices = [||] } ] - do! either { + do! result { if service1.RaftServer.IsLeader then for cue in cues do client2.AddCue cue diff --git a/src/Disco/Disco/Tests/Core/Disco/EnsureClientUpdateNoLoop.fs b/src/Disco/Disco/Tests/Core/Disco/EnsureClientUpdateNoLoop.fs index 57b0167e..b551b2eb 100644 --- a/src/Disco/Disco/Tests/Core/Disco/EnsureClientUpdateNoLoop.fs +++ b/src/Disco/Disco/Tests/Core/Disco/EnsureClientUpdateNoLoop.fs @@ -25,7 +25,7 @@ module EnsureClientUpdateNoLoop = let test = testCase "ensure client slice update does not loop" <| fun _ -> - either { + result { use electionDone = new WaitEvent() use appendDone = new WaitEvent() use clientRegistered = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/EnsureClientsReplicated.fs b/src/Disco/Disco/Tests/Core/Disco/EnsureClientsReplicated.fs index f4867aca..4ca24157 100644 --- a/src/Disco/Disco/Tests/Core/Disco/EnsureClientsReplicated.fs +++ b/src/Disco/Disco/Tests/Core/Disco/EnsureClientsReplicated.fs @@ -25,7 +25,7 @@ module EnsureClientsReplicated = let test = testCase "ensure connected clients are forwarded to leader" <| fun _ -> - either { + result { use electionDone = new WaitEvent() use addClientDone = new WaitEvent() use appendDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/EnsureCueResolver.fs b/src/Disco/Disco/Tests/Core/Disco/EnsureCueResolver.fs index 82f8a8f9..b5f69390 100644 --- a/src/Disco/Disco/Tests/Core/Disco/EnsureCueResolver.fs +++ b/src/Disco/Disco/Tests/Core/Disco/EnsureCueResolver.fs @@ -25,7 +25,7 @@ module EnsureCueResolver = let test = testCase "ensure cue resolver works" <| fun _ -> - either { + result { use checkGitStarted = new WaitEvent() use electionDone = new WaitEvent() use appendDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/EnsureMappingResolver.fs b/src/Disco/Disco/Tests/Core/Disco/EnsureMappingResolver.fs index f4597327..5f41f59a 100644 --- a/src/Disco/Disco/Tests/Core/Disco/EnsureMappingResolver.fs +++ b/src/Disco/Disco/Tests/Core/Disco/EnsureMappingResolver.fs @@ -25,7 +25,7 @@ module EnsureMappingResolver = let test = testCase "ensure mapping resolver works" <| fun _ -> - either { + result { use electionDone = new WaitEvent() use counter = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/PinBecomesDirty.fs b/src/Disco/Disco/Tests/Core/Disco/PinBecomesDirty.fs index 3da1876b..30657b65 100644 --- a/src/Disco/Disco/Tests/Core/Disco/PinBecomesDirty.fs +++ b/src/Disco/Disco/Tests/Core/Disco/PinBecomesDirty.fs @@ -25,7 +25,7 @@ module PinBecomesDirty = let test = testCase "pin becomes dirty" <| fun _ -> - either { + result { use started = new WaitEvent() use updateDone = new WaitEvent() use saveDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/PinBecomesOnlineOnClientConnect.fs b/src/Disco/Disco/Tests/Core/Disco/PinBecomesOnlineOnClientConnect.fs index 109ccafd..17451d8d 100644 --- a/src/Disco/Disco/Tests/Core/Disco/PinBecomesOnlineOnClientConnect.fs +++ b/src/Disco/Disco/Tests/Core/Disco/PinBecomesOnlineOnClientConnect.fs @@ -25,7 +25,7 @@ module PinBecomesOnlineOnClientConnect = let test = testCase "pin becomes online on client connect" <| fun _ -> - either { + result { use started = new WaitEvent() use appendDone = new WaitEvent() use clientRegistered = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs b/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs index 7faf16cc..74ff111c 100644 --- a/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs +++ b/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs @@ -25,7 +25,7 @@ module RemoveMemberShouldSplitCluster = let test = testCase "ensure follower forwards fstree to leader" <| fun _ -> - either { + result { use electionDone = new WaitEvent() use appendDone = new WaitEvent() use pushDone = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/Disco/StateShouldBeCleanedOnClientRemove.fs b/src/Disco/Disco/Tests/Core/Disco/StateShouldBeCleanedOnClientRemove.fs index c3f481ea..c30fde61 100644 --- a/src/Disco/Disco/Tests/Core/Disco/StateShouldBeCleanedOnClientRemove.fs +++ b/src/Disco/Disco/Tests/Core/Disco/StateShouldBeCleanedOnClientRemove.fs @@ -25,7 +25,7 @@ module StateShouldBeCleanedOnClientRemove = let test = testCase "state should be clean on client remove" <| fun _ -> - either { + result { use started = new WaitEvent() use batchDone = new WaitEvent() use clientRegistered = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/FsTests.fs b/src/Disco/Disco/Tests/Core/FsTests.fs index 73719c1a..5344852d 100644 --- a/src/Disco/Disco/Tests/Core/FsTests.fs +++ b/src/Disco/Disco/Tests/Core/FsTests.fs @@ -25,19 +25,19 @@ module FsTests = FileSystem.rmDir (filepath path) |> ignore let withTree (f: FsTree -> unit) = - withTmpDir (fun path -> FsTree.create (DiscoId.Create()) path Array.empty |> Either.get |> f) + withTmpDir (fun path -> FsTree.create (DiscoId.Create()) path Array.empty |> Result.get |> f) let test_should_have_correct_base_path = testCase "should have correct base path" <| fun _ -> withTmpDir <| fun path -> - let tree = FsTree.create (DiscoId.Create()) path Array.empty |> Either.get + let tree = FsTree.create (DiscoId.Create()) path Array.empty |> Result.get Expect.equal (FsTree.basePath tree) (FsPath.parse path) "Should have correct base path" let test_should_handle_base_path_with_slash = testCase "should handle base path with slash" <| fun _ -> withTmpDir <| fun path -> let withSlash = filepath (unwrap path + "/") - let tree = FsTree.create (DiscoId.Create()) withSlash Array.empty |> Either.get + let tree = FsTree.create (DiscoId.Create()) withSlash Array.empty |> Result.get Expect.equal (FsTree.basePath tree) (FsPath.parse path) "Should have correct base path" let test_fspath_is_sane = diff --git a/src/Disco/Disco/Tests/Core/GitTests.fs b/src/Disco/Disco/Tests/Core/GitTests.fs index 1d35af34..e8874bcc 100644 --- a/src/Disco/Disco/Tests/Core/GitTests.fs +++ b/src/Disco/Disco/Tests/Core/GitTests.fs @@ -36,7 +36,7 @@ module GitTests = let project = let p = Project.create tmpdir "Test Project" machine - |> Either.get + |> Result.get in { p with Config = config } machine, tmpdir, project, mem, project @@ -88,7 +88,7 @@ module GitTests = let test_server_startup = testCase "Server startup" <| fun _ -> - either { + result { let uuid, tmpdir, project, mem, path = mkEnvironment 10000us @@ -101,7 +101,7 @@ module GitTests = let test_server_startup_should_error_on_eaddrinuse = testCase "Server should fail on EADDRINUSE" <| fun _ -> - either { + result { let uuid, tmpdir, project, mem, path = mkEnvironment 10001us @@ -121,8 +121,8 @@ module GitTests = use gitserver2 = GitServer.create mem path do! match gitserver2.Start() with - | Right () -> Left (Other("test","Should have failed to start")) - | Left error -> Right () + | Ok () -> Error (Other("test","Should have failed to start")) + | Error error -> Ok () expect "Should not be runnning" true Service.isStopped gitserver2.Status } @@ -130,7 +130,7 @@ module GitTests = let test_server_availability = testCase "Server availability" <| fun _ -> - either { + result { let port = 10002us let started = new WaitEvent() @@ -157,7 +157,7 @@ module GitTests = |> unwrap |> Git.Repo.clone target - expect "Should have successfully clone project" true Either.isSuccess repo + expect "Should have successfully clone project" true Result.isSuccess repo } |> noError diff --git a/src/Disco/Disco/Tests/Core/NetTests.fs b/src/Disco/Disco/Tests/Core/NetTests.fs index 7a5506e9..89e0ca4d 100644 --- a/src/Disco/Disco/Tests/Core/NetTests.fs +++ b/src/Disco/Disco/Tests/Core/NetTests.fs @@ -29,7 +29,7 @@ module NetIntegrationTests = let test_client_should_automatically_reconnect = testCase "client should automatically reconnect" <| fun _ -> - either { + result { let ip = IpAddress.Localhost let prt = port 5555us @@ -69,7 +69,7 @@ module NetIntegrationTests = let test_server_request_handling = testCase "server request handling" <| fun _ -> - either { + result { let rand = new System.Random() use stopper = new WaitEvent() @@ -199,7 +199,7 @@ module NetIntegrationTests = let test_duplicate_server_fails_gracefully = testCase "duplicate server fails gracefully" <| fun _ -> - either { + result { let ip = IpAddress.Localhost let prt = port 5555us @@ -219,14 +219,14 @@ module NetIntegrationTests = return! match server2.Start() with - | Right _ -> Left(Other("test","should have failed")) - | Left _ -> Right () + | Ok _ -> Error(Other("test","should have failed")) + | Error _ -> Ok () } |> noError let test_pub_socket_disposes_properly = testCase "pub socket disposes properly" <| fun _ -> - either { + result { let mem = DiscoId.Create() |> ClusterMember.create use pub = PubSub.create mem do! pub.Start() diff --git a/src/Disco/Disco/Tests/Core/PersistenceTests.fs b/src/Disco/Disco/Tests/Core/PersistenceTests.fs index c268522c..ceb397aa 100644 --- a/src/Disco/Disco/Tests/Core/PersistenceTests.fs +++ b/src/Disco/Disco/Tests/Core/PersistenceTests.fs @@ -20,7 +20,7 @@ module PersistenceTests = Pin.Sink.toggle (mk()) (rndname()) group (mk()) [| true |] let mkProject () = - either { + result { let root = tmpPath() let name = rndstr() do! MachineConfig.init (konst "127.0.0.1") None (Some root) @@ -31,7 +31,7 @@ module PersistenceTests = } let mkState () = - either { + result { let! (machine, project) = mkProject () return machine, @@ -51,9 +51,9 @@ module PersistenceTests = let test_persist_add_pinwidgets_correctly = testCase "persist add pinwidgets correctly" <| fun _ -> - either { + result { let widget = mkPinWidget() - let! (machine, state) = mkState () |> Either.map (State.addPinWidget widget |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addPinWidget widget |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinWidget widget) let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinWidget" true (Map.containsKey widget.Id) state.PinWidgets @@ -63,11 +63,11 @@ module PersistenceTests = let test_persist_add_pinmappings_correctly = testCase "persist add pinmappings correctly" <| fun _ -> - either { + result { let mapping = mkPinMapping() let! (machine, state) = mkState () - |> Either.map (State.addPinMapping mapping |> Tuple.mapSnd) + |> Result.map (State.addPinMapping mapping |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinMapping mapping) let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain PinMapping" true (Map.containsKey mapping.Id) state.PinMappings @@ -77,9 +77,9 @@ module PersistenceTests = let test_persist_add_pingroups_correctly = testCase "persist add pingroups correctly" <| fun _ -> - either { + result { let group = mkPinGroup() - let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) let! loaded = Asset.loadWithMachine state.Project.Path machine @@ -94,9 +94,9 @@ module PersistenceTests = let test_persist_remove_pinwidgets_correctly = testCase "persist remove pinwidgets correctly" <| fun _ -> - either { + result { let widget = mkPinWidget() - let! (machine, state) = mkState () |> Either.map (State.addPinWidget widget |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addPinWidget widget |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinWidget widget) let! loaded = Asset.loadWithMachine state.Project.Path machine @@ -114,11 +114,11 @@ module PersistenceTests = let test_persist_remove_pinmappings_correctly = testCase "persist remove pinmappings correctly" <| fun _ -> - either { + result { let mapping = mkPinMapping() let! (machine, state) = mkState () - |> Either.map (State.addPinMapping mapping |> Tuple.mapSnd) + |> Result.map (State.addPinMapping mapping |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinMapping mapping) let! loaded = Asset.loadWithMachine state.Project.Path machine @@ -140,9 +140,9 @@ module PersistenceTests = let test_persist_remove_pingroups_correctly = testCase "persist remove pingroups correctly" <| fun _ -> - either { + result { let group = mkPinGroup() - let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) let! loaded = Asset.loadWithMachine state.Project.Path machine @@ -168,9 +168,9 @@ module PersistenceTests = let test_persist_add_cueplayers_correctly = testCase "persist add cueplayers correctly" <| fun _ -> - either { + result { let player = mkCuePlayer() - let! (machine, state) = mkState () |> Either.map (State.addCuePlayer player |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addCuePlayer player |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddCuePlayer player) let! loaded = Asset.loadWithMachine state.Project.Path machine expect "state should contain CuePlayer" true (Map.containsKey player.Id) state.CuePlayers @@ -180,9 +180,9 @@ module PersistenceTests = let test_persist_remove_cueplayers_correctly = testCase "persist remove cueplayers correctly" <| fun _ -> - either { + result { let player = mkCuePlayer() - let! (machine, state) = mkState () |> Either.map (State.addCuePlayer player |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addCuePlayer player |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddCuePlayer player) let! loaded = Asset.loadWithMachine state.Project.Path machine @@ -204,7 +204,7 @@ module PersistenceTests = let test_persist_add_pin_correctly = testCase "persist add pin correctly" <| fun _ -> - either { + result { let group = mkPinGroup() let pin = @@ -216,7 +216,7 @@ module PersistenceTests = [| true |] |> Pin.setPersisted true - let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) let! loaded = Asset.loadWithMachine state.Project.Path machine @@ -242,7 +242,7 @@ module PersistenceTests = let test_persist_remove_pin_correctly = testCase "persist remove pin correctly" <| fun _ -> - either { + result { let group = mkPinGroup() let pin = @@ -254,7 +254,7 @@ module PersistenceTests = [| true |] |> Pin.setPersisted true - let! (machine, state) = mkState () |> Either.map (State.addPinGroup group |> Tuple.mapSnd) + let! (machine, state) = mkState () |> Result.map (State.addPinGroup group |> Tuple.mapSnd) let! _ = Persistence.persistEntry state (AddPinGroup group) let! loaded = Asset.loadWithMachine state.Project.Path machine diff --git a/src/Disco/Disco/Tests/Core/ProjectTests.fs b/src/Disco/Disco/Tests/Core/ProjectTests.fs index 7ab46f29..5fdaf952 100644 --- a/src/Disco/Disco/Tests/Core/ProjectTests.fs +++ b/src/Disco/Disco/Tests/Core/ProjectTests.fs @@ -26,7 +26,7 @@ module ProjectTests = // let loadSaveTest = testCase "Save/Load Project should render equal project values" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() @@ -49,7 +49,7 @@ module ProjectTests = let dirtyTest = testCase "Project create should render clean repo" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() @@ -73,20 +73,20 @@ module ProjectTests = let relpathTest = testCase "Project create should only work on absolute paths" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = Path.getRandomFileName() let result = Project.create path (unwrap path) machine - expect "Create should have failed" false Either.isSuccess result + expect "Create should have failed" false Result.isSuccess result return! match result with - | Left (GitError("Git.Repo.stage",_)) -> Right () - | Left other -> Left other - | Right other -> Left (Other("relpathTest", sprintf "Should have failed: %A" other)) + | Error (GitError("Git.Repo.stage",_)) -> Ok () + | Error other -> Error other + | Ok other -> Error (Other("relpathTest", sprintf "Should have failed: %A" other)) } |> noError @@ -98,7 +98,7 @@ module ProjectTests = // let testCustomizedCfg = testCase "Save/Load of Project with customized configs" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() @@ -213,7 +213,7 @@ module ProjectTests = // let saveInitsGit = testCase "Saved Project should be a git repository with yaml file." <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() let name = Path.getFileName path |> unwrap @@ -231,23 +231,23 @@ module ProjectTests = let getRepo = Project.repository - >> Either.isSuccess + >> Result.isSuccess do! expectE "Projects should have repo" true getRepo loaded let checkDirty (project: DiscoProject) = project |> Project.repository - |> Either.bind Git.Repo.isDirty - |> Either.get + |> Result.bind Git.Repo.isDirty + |> Result.get do! expectE "Projects should not be dirty" false checkDirty loaded let commitCount (project: DiscoProject) = project |> Project.repository - |> Either.map Git.Repo.commitCount - |> Either.get + |> Result.map Git.Repo.commitCount + |> Result.get do! expectE "Projects should have initial commit" 1 commitCount loaded } @@ -261,7 +261,7 @@ module ProjectTests = // let savesMultipleCommits = testCase "Saving project should contain multiple commits" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() @@ -307,7 +307,7 @@ module ProjectTests = let upToDatePath = testCase "Saving project should always contain an up-to-date path" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() let name = Path.getFileName path |> unwrap @@ -329,7 +329,7 @@ module ProjectTests = let saveAsset = testCase "Should save an asset in new commit" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() @@ -361,7 +361,7 @@ module ProjectTests = let createDefaultUser = testCase "Should create a default admin user" <| fun _ -> - either { + result { let machine = MachineConfig.create "127.0.0.1" None let path = tmpPath() let name = Path.getFileName path |> unwrap diff --git a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs index 9acef57f..c0732ac7 100644 --- a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs +++ b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs @@ -27,7 +27,7 @@ module RaftIntegrationTests = let test_validate_correct_req_socket_tracking = testCase "validate correct req socket tracking" <| fun _ -> - either { + result { let machine1 = MachineConfig.create "127.0.0.1" None let machine2 = MachineConfig.create "127.0.0.1" None @@ -87,7 +87,7 @@ module RaftIntegrationTests = let test_validate_raft_service_bind_correct_port = testCase "validate raft service bind correct port" <| fun _ -> - either { + result { use started = new WaitEvent() let port = port 12000us let machine = MachineConfig.create "127.0.0.1" None @@ -132,8 +132,8 @@ module RaftIntegrationTests = } do! match follower.Start() with - | Right _ -> Left (Other("test","follower should have failed")) - | Left _ -> Right () + | Ok _ -> Error (Other("test","follower should have failed")) + | Error _ -> Ok () expect "Should be failed" true Service.hasFailed follower.Status } @@ -141,7 +141,7 @@ module RaftIntegrationTests = let test_validate_follower_joins_leader_after_startup = testCase "validate follower joins leader after startup" <| fun _ -> - either { + result { use check1 = new WaitEvent() let setState (id: DiscoId) (are: WaitEvent) = function @@ -209,7 +209,7 @@ module RaftIntegrationTests = let test_log_snapshotting_should_clean_all_logs = testCase "log snapshotting should clean all logs" <| fun _ -> - either { + result { use snapshotCheck = new WaitEvent() use expectedCheck = new WaitEvent() @@ -269,7 +269,7 @@ module RaftIntegrationTests = let test_validate_add_member_works = testCase "validate add member works" <| fun _ -> - either { + result { use added = new WaitEvent() use configured = new WaitEvent() use check1 = new WaitEvent() diff --git a/src/Disco/Disco/Tests/Core/StateTests.fs b/src/Disco/Disco/Tests/Core/StateTests.fs index 52678d7b..009fab13 100644 --- a/src/Disco/Disco/Tests/Core/StateTests.fs +++ b/src/Disco/Disco/Tests/Core/StateTests.fs @@ -16,7 +16,7 @@ module StateTests = let test_apply_fstree_add_correctly = testCase "should apply fstree add correctly" <| fun _ -> - either { + result { let initial = State.Empty let tree = FsTreeTesting.deepTree 2 let state = State.addFsTree tree initial @@ -26,7 +26,7 @@ module StateTests = let test_apply_fsentry_add_correctly = testCase "should apply fsentry add correctly" <| fun _ -> - either { + result { let tree = FsTreeTesting.deepTree 2 let initial = State.addFsTree tree State.Empty let directory = @@ -51,7 +51,7 @@ module StateTests = let test_apply_fsentry_remove_correctly = testCase "should apply fsentry remove correctly" <| fun _ -> - either { + result { let tree = FsTreeTesting.deepTree 2 let initial = State.addFsTree tree State.Empty let entry = diff --git a/src/Disco/Disco/Tests/Core/Synchronization.fs b/src/Disco/Disco/Tests/Core/Synchronization.fs index c588d6fb..ae72c86d 100644 --- a/src/Disco/Disco/Tests/Core/Synchronization.fs +++ b/src/Disco/Disco/Tests/Core/Synchronization.fs @@ -17,7 +17,7 @@ module SynchronizationTests = let test_should_call_monitor_correct_number_of_times = testCase "should call monitor correct number of times" <| fun _ -> - either { + result { use ev = new WaitEvent() async { do! Async.Sleep(1000) diff --git a/src/Disco/Disco/Tests/Core/UtilTests.fs b/src/Disco/Disco/Tests/Core/UtilTests.fs index e528c2b8..6fae958e 100644 --- a/src/Disco/Disco/Tests/Core/UtilTests.fs +++ b/src/Disco/Disco/Tests/Core/UtilTests.fs @@ -23,7 +23,7 @@ module UtilTests = let test_rmdir_should_delete_recursively = testCase "rmdir should delete recursively with read-only items" <| fun _ -> - either { + result { let! dir = Path.getRandomFileName() |> Directory.createDirectory diff --git a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs index 0f93f4ec..dfcc329c 100644 --- a/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs +++ b/src/Disco/Disco/Tests/Raft/RaftTestUtils.fs @@ -175,7 +175,7 @@ module RaftTestUtils = let defSM = mkTmpDir() |> mkState - |> Either.get + |> Result.get |> StateMachine.DataSnapshot let runWithDefaults action = @@ -225,12 +225,12 @@ module RaftTestUtils = let runWithRaft r c m = runRaft r c m let expectError e = function - | Left (e',_) when e = e' -> () - | Left (e',_) when e <> e' -> + | Error (e',_) when e = e' -> () + | Error (e',_) when e <> e' -> Expecto.Tests.failtestf "Expected error: %A but got: %A" e e' | _ as v -> Expecto.Tests.failtestf "Expected error but got: %A" v let noError = function - | Left (e,_) -> failwithf "ERROR: %A" e + | Error (e,_) -> failwithf "ERROR: %A" e | _ -> () diff --git a/src/Disco/Disco/Tests/TestUtilities.fs b/src/Disco/Disco/Tests/TestUtilities.fs index 2b116e26..d2cb6363 100644 --- a/src/Disco/Disco/Tests/TestUtilities.fs +++ b/src/Disco/Disco/Tests/TestUtilities.fs @@ -42,11 +42,11 @@ module TestUtilities = let waitFor (tag: string) (we: WaitEvent) = if we.WaitOne(TimeSpan.FromMilliseconds DISCO_EVENT_TIMEOUT) - then Either.succeed() + then Result.succeed() else sprintf "Timout after %f waiting for %s" DISCO_EVENT_TIMEOUT tag |> Error.asOther "test" - |> Either.fail + |> Result.fail /// abstract over Assert.Equal to create pipe-lineable assertions let expect (msg : string) (a : 'a) (b : 't -> 'a) (t : 't) = @@ -63,15 +63,15 @@ module TestUtilities = let uuid = Guid.NewGuid() string uuid - let inline expectE (msg: string) (exp: 'b) (f: 'a -> 'b) (input: Either) = - either { + let inline expectE (msg: string) (exp: 'b) (f: 'a -> 'b) (input: DiscoResult<'a>) = + result { let! value = input let result = f value if result <> exp then return! sprintf "Expected %A but got %A in %A" exp result msg |> Error.asOther "expectE" - |> Either.fail + |> Result.fail else return () } @@ -79,10 +79,10 @@ module TestUtilities = let inline count< ^a when ^a : (member Count: int)> (thing: ^a) : int = (^a : (member Count: int) thing) - let inline noError (input: Either) = + let inline noError (input: DiscoResult<'a>) = match input with - | Right _ -> () - | Left error -> + | Ok _ -> () + | Error error -> error |> Error.toMessage |> Tests.failtest @@ -371,8 +371,8 @@ module TestData = [| for n in 0 .. rand.Next(1,10) do yield FsTreeTesting.makeTree (rand.Next(1,3)) (rand.Next(1,10)) |] - let mkState path : Either = - either { + let mkState path : DiscoResult = + result { let! project = mkProject path return { Project = project @@ -399,8 +399,8 @@ module TestData = [| for _ in 0 .. n do yield mkChange () |] - let mkLog _ : Either = - either { + let mkLog _ : DiscoResult = + result { let! state = mkTmpDir() |> mkState return LogEntry(DiscoId.Create(),7,1, DataSnapshot(state), @@ -418,15 +418,15 @@ module TestData = new LibGit2Sharp.Repository(unwrap path) let inline binaryEncDec< ^t when ^t : (member ToBytes: unit -> byte[]) - and ^t : (static member FromBytes: byte[] -> Either) + and ^t : (static member FromBytes: byte[] -> DiscoResult< ^t >) and ^t : equality> (thing: ^t) = - let rething: ^t = thing |> Binary.encode |> Binary.decode |> Either.get + let rething: ^t = thing |> Binary.encode |> Binary.decode |> Result.get expect "Should be equal" thing id rething let inline yamlEncDec< ^i, ^t when ^t : (member ToYaml: unit -> ^i) - and ^t : (static member FromYaml: ^i -> Either) + and ^t : (static member FromYaml: ^i -> DiscoResult< ^t >) and ^t : equality> (thing: ^t) = - let rething: ^t = thing |> Yaml.encode |> Yaml.decode |> Either.get + let rething: ^t = thing |> Yaml.encode |> Yaml.decode |> Result.get expect "Should be equal" thing id rething diff --git a/src/Disco/Projects/Sdk/Sdk.fsproj b/src/Disco/Projects/Sdk/Sdk.fsproj index 9715a496..34d7464a 100644 --- a/src/Disco/Projects/Sdk/Sdk.fsproj +++ b/src/Disco/Projects/Sdk/Sdk.fsproj @@ -406,4 +406,4 @@ - \ No newline at end of file + diff --git a/src/Frontend/lib/react-ui-tree/node.js b/src/Frontend/lib/react-ui-tree/node.js index 38323864..9f59be59 100644 --- a/src/Frontend/lib/react-ui-tree/node.js +++ b/src/Frontend/lib/react-ui-tree/node.js @@ -92,4 +92,4 @@ var Node = React.createClass({ } }); -module.exports = Node; \ No newline at end of file +module.exports = Node; diff --git a/src/Frontend/lib/react-ui-tree/react-ui-tree.js b/src/Frontend/lib/react-ui-tree/react-ui-tree.js index 5fea5266..8aa3f7a1 100644 --- a/src/Frontend/lib/react-ui-tree/react-ui-tree.js +++ b/src/Frontend/lib/react-ui-tree/react-ui-tree.js @@ -230,4 +230,4 @@ module.exports = React.createClass({ this.change(tree); } -}); \ No newline at end of file +}); diff --git a/src/Frontend/src/Frontend/Elmish/ClusterView.fs b/src/Frontend/src/Frontend/Elmish/ClusterView.fs index e4a5122a..df98916d 100644 --- a/src/Frontend/src/Frontend/Elmish/ClusterView.fs +++ b/src/Frontend/src/Frontend/Elmish/ClusterView.fs @@ -91,12 +91,12 @@ let activeConfig dispatch state = OnClick (fun ev -> ev.stopPropagation() match Config.findMember config kv.Key with - | Right mem -> + | Ok mem -> mem |> ClusterMember.toRaftMember |> RemoveMachine |> ClientContext.Singleton.Post - | Left error -> printfn "Cannot find member in config: %O" error) + | Error error -> printfn "Cannot find member in config: %O" error) ] [] ] ] diff --git a/src/Frontend/src/Frontend/Elmish/Cues/CuePlayerView.fs b/src/Frontend/src/Frontend/Elmish/Cues/CuePlayerView.fs index 4906e413..9a438bc7 100644 --- a/src/Frontend/src/Frontend/Elmish/Cues/CuePlayerView.fs +++ b/src/Frontend/src/Frontend/Elmish/Cues/CuePlayerView.fs @@ -70,11 +70,11 @@ let private updateCueList (player: CuePlayer option) (str:string) = | None -> () | Some player -> str |> DiscoId.TryParse |> function - | Either.Left _ -> + | Error _ -> CuePlayer.unsetCueList player |> UpdateCuePlayer |> ClientContext.Singleton.Post - | Either.Right id -> + | Ok id -> CuePlayer.setCueList id player |> UpdateCuePlayer |> ClientContext.Singleton.Post diff --git a/src/Frontend/src/Frontend/Elmish/PlayerListView.fs b/src/Frontend/src/Frontend/Elmish/PlayerListView.fs index 9661b882..7195e437 100644 --- a/src/Frontend/src/Frontend/Elmish/PlayerListView.fs +++ b/src/Frontend/src/Frontend/Elmish/PlayerListView.fs @@ -75,11 +75,11 @@ let private updateName (player:CuePlayer) (value:string) = let private updateCueList (player:CuePlayer) = function | Some id -> match DiscoId.TryParse id with - | Left _ -> + | Error _ -> CuePlayer.unsetCueList player |> UpdateCuePlayer |> ClientContext.Singleton.Post - | Right id -> + | Ok id -> CuePlayer.setCueList id player |> UpdateCuePlayer |> ClientContext.Singleton.Post diff --git a/src/Frontend/src/Frontend/Lib.fs b/src/Frontend/src/Frontend/Lib.fs index 6d35d84a..f6f32153 100644 --- a/src/Frontend/src/Frontend/Lib.fs +++ b/src/Frontend/src/Frontend/Lib.fs @@ -326,7 +326,7 @@ let updatePinValue(pin: Pin, index: int, value: obj) = | _ -> None | ColorPin pin -> match ColorSpace.TryParse(unbox value) with - | Right color -> + | Ok color -> tryUpdateArray index color pin.Values |> Option.map (fun values -> ColorSlices(pin.Id, client, values)) | _ -> None diff --git a/src/Frontend/src/Frontend/Worker.fs b/src/Frontend/src/Frontend/Worker.fs index 85f99fe8..f8980e82 100644 --- a/src/Frontend/src/Frontend/Worker.fs +++ b/src/Frontend/src/Frontend/Worker.fs @@ -176,8 +176,8 @@ type WorkerContext() = sock.OnMessage <- fun (ev: MessageEvent) -> match toBytes ev.Data |> Binary.decode with - | Right sm -> self.OnSocketMessage sm - | Left error -> + | Ok sm -> self.OnSocketMessage sm + | Error error -> sprintf "Unable to parse received message. %A" error |> self.Log LogLevel.Err diff --git a/src/Frontend/src/Tests.Frontend/SerializationTests.fs b/src/Frontend/src/Tests.Frontend/SerializationTests.fs index 95df4d3a..9603ed24 100644 --- a/src/Frontend/src/Tests.Frontend/SerializationTests.fs +++ b/src/Frontend/src/Tests.Frontend/SerializationTests.fs @@ -279,7 +279,7 @@ module SerializationTests = DiscoveredServices = let ser = mkDiscoveredService() in Map.ofArray [| (ser.Id, ser) |] } let inline check thing = - let thong = thing |> Binary.encode |> Binary.decode |> Either.get + let thong = thing |> Binary.encode |> Binary.decode |> Result.get equals thing thong let main () = @@ -349,50 +349,50 @@ module SerializationTests = testSync "Validate PinWidget Serialization" <| fun () -> let widget : PinWidget = mkPinWidget () - let rewidget = widget |> Binary.encode |> Binary.decode |> Either.get + let rewidget = widget |> Binary.encode |> Binary.decode |> Result.get equals widget rewidget testSync "Validate PinMapping Serialization" <| fun () -> let mapping : PinMapping = mkPinMapping () - let remapping = mapping |> Binary.encode |> Binary.decode |> Either.get + let remapping = mapping |> Binary.encode |> Binary.decode |> Result.get equals mapping remapping testSync "Validate Cue Serialization" <| fun () -> let cue : Cue = mkCue () - let recue = cue |> Binary.encode |> Binary.decode |> Either.get + let recue = cue |> Binary.encode |> Binary.decode |> Result.get equals cue recue testSync "Validate CueReference Serialization" <| fun () -> let cueReference : CueReference = mkCueRef () - let recueReference = cueReference |> Binary.encode |> Binary.decode |> Either.get + let recueReference = cueReference |> Binary.encode |> Binary.decode |> Result.get equals cueReference recueReference testSync "Validate CueGroup Serialization" <| fun () -> let cueGroup : CueGroup = mkCueGroup () - let recueGroup = cueGroup |> Binary.encode |> Binary.decode |> Either.get + let recueGroup = cueGroup |> Binary.encode |> Binary.decode |> Result.get equals cueGroup recueGroup test "Validate CueList Serialization" <| fun finish -> let cuelist : CueList = mkCueList () - let recuelist = cuelist |> Binary.encode |> Binary.decode |> Either.get + let recuelist = cuelist |> Binary.encode |> Binary.decode |> Result.get equals cuelist recuelist finish() test "Validate PinGroup Serialization" <| fun finish -> let group : PinGroup = mkPinGroup () - let regroup = group |> Binary.encode |> Binary.decode |> Either.get + let regroup = group |> Binary.encode |> Binary.decode |> Result.get equals group regroup finish() test "Validate Session Serialization" <| fun finish -> let session : Session = mkSession () - let resession = session |> Binary.encode |> Binary.decode |> Either.get + let resession = session |> Binary.encode |> Binary.decode |> Result.get equals session resession finish() test "Validate User Serialization" <| fun finish -> let user : User = mkUser () - let reuser = user |> Binary.encode |> Binary.decode |> Either.get + let reuser = user |> Binary.encode |> Binary.decode |> Result.get equals user reuser finish() @@ -436,7 +436,7 @@ module SerializationTests = test "Validate DiscoProject Binary Serializaton" <| fun finish -> mkProject() |> (fun project -> - let reproject = project |> Binary.encode |> Binary.decode |> Either.get + let reproject = project |> Binary.encode |> Binary.decode |> Result.get if project <> reproject then printfn "project: %O" project printfn "reproject: %O" reproject @@ -491,7 +491,7 @@ module SerializationTests = ] |> List.iter (fun ting -> - let reting = ting |> Binary.encode |> Binary.decode |> Either.get + let reting = ting |> Binary.encode |> Binary.decode |> Result.get if ting <> reting then printfn "ting: %O" ting printfn "reting: %O" reting @@ -518,7 +518,7 @@ module SerializationTests = |> Binary.createBuffer |> ErrorFB.GetRootAsErrorFB |> DiscoError.FromFB - |> Either.get + |> Result.get equals error reerror) finish() diff --git a/src/Unity/Main.fs b/src/Unity/Main.fs index c4e61be6..b0405ae3 100644 --- a/src/Unity/Main.fs +++ b/src/Unity/Main.fs @@ -118,11 +118,11 @@ let startActor(state, client: IApiClient, clientId, print: string->unit) = // Subscribe to API client events apiobs <- client.Subscribe(DiscoEvent >> actor.Post) |> Some match client.Start() with - | Right () -> + | Ok () -> Logger.info "startClient" "Successfully started Unity ApiClient" print(sprintf "Successfully started Disco Client (status %A)" client.Status) actor - | Left error -> + | Error error -> let msg = string error Logger.err "startClient" msg print ("Couldn't start Disco Client: " + msg) From ab4e26b0184ff7babfb4bd36db2473d94a547739 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Tue, 13 Feb 2018 16:57:00 +0100 Subject: [PATCH 16/27] refactor and simplify raft code --- src/Disco/Disco/Raft/Log.fs | 9 +- src/Disco/Disco/Raft/LogEntry.fs | 14 +- src/Disco/Disco/Raft/Raft.fs | 179 +++++++----------- src/Disco/Disco/Raft/RaftMonad.fs | 56 +++++- src/Disco/Disco/Raft/RaftState.fs | 34 ++++ src/Disco/Disco/Service/RaftServer.fs | 6 +- .../Core/Disco/AddPreviousMemberShouldPull.fs | 13 +- .../Disco/Tests/Raft/JointConsensusTests.fs | 14 +- 8 files changed, 187 insertions(+), 138 deletions(-) diff --git a/src/Disco/Disco/Raft/Log.fs b/src/Disco/Disco/Raft/Log.fs index 4c5e4013..1ac074d7 100644 --- a/src/Disco/Disco/Raft/Log.fs +++ b/src/Disco/Disco/Raft/Log.fs @@ -290,14 +290,13 @@ module Log = let make term data = LogEntry.make term data - // ** mkConfig + // ** configuration - let mkConfig term nodes = LogEntry.mkConfig term nodes + let configuration = LogEntry.configuration - // ** mkConfigChange + // ** jointConsensus - let mkConfigChange term changes = - LogEntry.mkConfigChange term changes + let jointConsensus = LogEntry.jointConsensus let calculateChanges oldnodes newnodes = LogEntry.calculateChanges oldnodes newnodes diff --git a/src/Disco/Disco/Raft/LogEntry.fs b/src/Disco/Disco/Raft/LogEntry.fs index 87844b73..05d9fafc 100644 --- a/src/Disco/Disco/Raft/LogEntry.fs +++ b/src/Disco/Disco/Raft/LogEntry.fs @@ -866,7 +866,7 @@ module LogEntry = /// | |_| | | | | |_| | | |___ > < (__| | |_| | (_| | | | | | (_| | /// \__,_|_| |_|\__|_|_|_____/_/\_\___|_|\__,_|\__,_|_|_| |_|\__, | /// |___/ - /// ### Complextiy: O(n) + /// ### Complexity: O(n) let rec untilExcluding idx = function | Snapshot _ as curr -> Some curr @@ -921,23 +921,19 @@ module LogEntry = let make term data = LogEntry(DiscoId.Create(), 0, term, data, None) - // ** mkConfig + // ** configuration /// Add an Configuration log entry onto the queue - /// - /// ### Complexity: 0(1) - let mkConfig term mems = + let configuration term mems = Configuration(DiscoId.Create(), 0, term, mems, None) - // ** mkConfigChange + // ** jointConsensus /// Add an intermediate configuration entry for 2-phase commit onto /// the log queue - /// - /// ### Complexity: 0(1) - let mkConfigChange term changes = + let jointConsensus term changes = JointConsensus(DiscoId.Create(), 0, term, changes, None) // ** calculateChanges diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index 6e30383b..efa326fc 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -23,43 +23,13 @@ module rec Raft = // ** rand - let private rand = new System.Random() - - // ** handleConfiguration - - let private handleConfiguration mems (state: RaftState) = - let parting = - mems - |> Array.map (fun (mem: RaftMember) -> mem.Id) - |> Array.contains state.Member.Id - |> not - - let peers = - if parting - // we have been kicked out of the configuration - then Map [(state.Member.Id, state.Member)] - // we are still part of the new cluster configuration - else - mems - |> Array.map toPair - |> Map.ofArray - - state - |> RaftState.setPeers peers - |> RaftState.setOldPeers None - - // ** handleJointConsensus + let private rand = System.Random() - let private handleJointConsensus (changes) (state:RaftState) = - state - |> RaftState.applyChanges changes - |> RaftState.setOldPeers (Some state.Peers) - - // ** createResponse + // ** createAppendResponse /// Preliminary Checks on the AppendEntry value - let private createResponse (nid: MemberId option) (msg: AppendEntries) = + let private createAppendResponse (nid: MemberId option) (msg: AppendEntries) = raft { let! term = currentTerm () let! current = currentIndex () @@ -190,19 +160,21 @@ module rec Raft = let! current = currentIndex () if current < msg.PrevLogIdx then - do! msg.PrevLogIdx - |> sprintf "Failed (ci: %d) < (prev log idx: %d)" current - |> logError "receiveAppendEntries" + do! logMap Err "receiveAppendEntries" "current index < previous log index" [ + "previous log term", string msg.PrevLogTerm + "current index", string current + "prevous log index", string msg.PrevLogIdx + ] return resp else let term = LogEntry.term entry if term <> msg.PrevLogTerm then - do! sprintf "Failed (term %d) != (prev log term %d) (ci: %d) (prev log idx: %d)" - term - msg.PrevLogTerm - current - msg.PrevLogIdx - |> logError "receiveAppendEntries" + do! logMap Err "receiveAppendEntries" "term mismatch" [ + "term", string term + "previous log term", string msg.PrevLogTerm + "current index", string current + "prevous log index", string msg.PrevLogIdx + ] do! removeEntry msg.PrevLogIdx return AppendResponse.setCurrentIndex (msg.PrevLogIdx - 1) resp else @@ -283,18 +255,15 @@ module rec Raft = // log this if any entries are to be processed if Option.isSome msg.Entries then let! current = currentIndex () - - do! sprintf "from: %A term: %d (ci: %d) (lc-idx: %d) (pli: %d) (plt: %d) (entries: %d)" - nid - msg.Term - current - msg.LeaderCommit - msg.PrevLogIdx - msg.PrevLogTerm - (Option.get msg.Entries |> LogEntry.depth) // let the world know - |> logDebug "receiveAppendEntries" - - let! result = createResponse nid msg // check terms et al match, fail otherwise + do! logMap Debug "receiveAppendEntries" ("from: " + string nid) [ + "term", string msg.Term + "current index", string current + "leader commit", string msg.LeaderCommit + "previous log term", string msg.PrevLogTerm + "prevous log index", string msg.PrevLogIdx + "num entries", string (Option.map LogEntry.depth msg.Entries) + ] + let! result = createAppendResponse nid msg // check terms et al match, fail otherwise match result with | Ok resp -> @@ -555,11 +524,11 @@ module rec Raft = let! term = currentTerm() let! idx = log () >>= (Log.index >> returnM) - do! term - |> sprintf "(id: %A) (idx: %d) (term: %d)" - (LogEntry.id entry) - (idx + 1) - |> logDebug "receiveEntry" + do! logMap Debug "receiveEntry" "" [ + "id", string (LogEntry.id entry) + "index", string (idx + 1) + "term", string term + ] let response = EntryResponse.create 0 0 @@ -588,32 +557,59 @@ module rec Raft = |> failM } - // ** notifyChange - - let notifyChange (cbs: IRaftCallbacks) change = - match change with - | MemberAdded(mem) -> cbs.MemberAdded mem - | MemberRemoved(mem) -> cbs.MemberRemoved mem - // ** applyEntry let applyEntry (cbs: IRaftCallbacks) = function | JointConsensus(_,_,_,changes,_) -> Array.iter (notifyChange cbs) changes cbs.JointConsensus changes - | Configuration(_,_,_,mems,_) -> cbs.Configured mems + | Configuration(_,_,_,mems,_) -> + cbs.Configured mems | LogEntry(_,_,_,data,_) -> cbs.ApplyLog data | Snapshot(_,_,_,_,_,_,data) as snapshot -> cbs.PersistSnapshot snapshot cbs.ApplyLog data + // ** applyLogs + + let applyLogs entries = + raft { + let! env = read + let! state = get + // Apply log chain in the order it arrived + let state, change = + LogEntry.foldr + (fun (state, current) -> function + | Configuration(_,_,_,mems,_) as config -> + // set the peers map + let newstate = RaftState.handleConfiguration mems state + // when a new configuration is added, under certain circumstances a mem change + // might not have been applied yet, so calculate those dangling changes + let changes = RaftState.calculateChanges state.Peers newstate.Peers + // apply the entry by calling the callback + do applyEntry env config + (newstate, None) + | JointConsensus(_,_,_,changes,_) as config -> + let state = RaftState.handleJointConsensus changes state + do applyEntry env config + (state, Some (LogEntry.head config)) + | entry -> + do applyEntry env entry + (state, current)) + (state, state.ConfigChangeEntry) + entries + do! put state + do! setConfigChangeEntry change + } + + // ** applyEntries let applyEntries () = raft { let! state = get - let lai = state.LastAppliedIdx - let coi = state.CommitIndex + let! lai = lastAppliedIndex() + let! coi = commitIndex () if lai <> coi then let logIdx = lai + 1 let! result = entriesUntil logIdx @@ -628,41 +624,10 @@ module rec Raft = do! logInfo "applyEntries" str // Apply log chain in the order it arrived - let state, change = - LogEntry.foldr - (fun (state, current) -> function - | Configuration(_,_,_,mems,_) as config -> - // set the peers map - let newstate = handleConfiguration mems state - // when a new configuration is added, under certain circumstances a mem change - // might not have been applied yet, so calculate those dangling changes - let changes = RaftState.calculateChanges state.Peers newstate.Peers - // apply dangling changes - do Array.iter (notifyChange cbs) changes - // apply the entry by calling the callback - do applyEntry cbs config - (newstate, None) - | JointConsensus(_,_,_,changes,_) as config -> - let state = handleJointConsensus changes state - do applyEntry cbs config - (state, Some (LogEntry.head config)) - | entry -> - do applyEntry cbs entry - (state, current)) - (state, state.ConfigChangeEntry) - entries - - do! match change with - | Some _ -> "setting ConfigChangeEntry to JointConsensus" - | None -> "resetting ConfigChangeEntry" - |> logDebug "applyEntries" - - do! put { state with ConfigChangeEntry = change } + do! applyLogs entries if LogEntry.contains LogEntry.isConfiguration entries then - let selfIncluded (state: RaftState) = - Map.containsKey state.Member.Id state.Peers - let! included = selfIncluded |> zoom + let! included = selfIncluded () if not included then let str = string state.Member.Id @@ -678,17 +643,17 @@ module rec Raft = /// done we need to create a snapshot of the raft log, which won't contain those commands. do! doSnapshot() - let! state = get + let! peers = peers() if not (RaftState.isLeader state) && LogEntry.contains LogEntry.isConfiguration entries then do! logDebug "applyEntries" "not leader and new configuration is applied. Updating mems." - for kv in state.Peers do - if kv.Value.Status <> Running then - do! updateMember { kv.Value with Status = Running; Voting = true } + for KeyValue(_, peer) in peers do + if peer.Status <> Running then + do! updateMember { peer with Status = Running; Voting = true } let idx = LogEntry.index entries do! logDebug "applyEntries" <| sprintf "setting LastAppliedIndex to %d" idx do! setLastAppliedIndex idx - | _ -> + | None -> do! logDebug "applyEntries" (sprintf "no log entries found for index %d" logIdx) } diff --git a/src/Disco/Disco/Raft/RaftMonad.fs b/src/Disco/Disco/Raft/RaftMonad.fs index 23714899..7548bf31 100644 --- a/src/Disco/Disco/Raft/RaftMonad.fs +++ b/src/Disco/Disco/Raft/RaftMonad.fs @@ -206,6 +206,18 @@ module RaftMonad = |> Logger.log level (tag site) |> returnM + // ** logMap + + let logMap level location reason items = + let prefix = + match level with + | Err -> "Failed: (" + reason + ") " + | _ -> reason + items + |> List.fold (fun m (item,value) -> m + "[" + item + "=" + value + "] ") prefix + |> Logger.log level (tag location) + |> returnM + // ** logDebug let logDebug site str = logMsg site Debug str @@ -290,6 +302,20 @@ module RaftMonad = let configChangeEntry () = zoom RaftState.configChangeEntry + // ** setConfigChangeEntry + + let setConfigChangeEntry change = + raft { + let! current = configChangeEntry() + do! modify (RaftState.setConfigChangeEntry change) + match current, change with + | None, Some _ -> + do! logDebug "setConfigChangeEntry" "setting ConfigChangeEntry to JointConsensus" + | Some _, None -> + do! logDebug "setConfigChangeEntry" "resetting ConfigChangeEntry" + | _ -> return () + } + // ** persistVote let persistVote mem = @@ -478,6 +504,12 @@ module RaftMonad = do env.MemberRemoved mem } + // ** notifyChange + + let notifyChange (env: IRaftCallbacks) = function + | MemberAdded mem -> do env.MemberAdded mem + | MemberRemoved mem -> do env.MemberRemoved mem + // ** applyChanges let applyChanges changes = @@ -485,9 +517,7 @@ module RaftMonad = do! modify (RaftState.applyChanges changes) let! env = read for change in changes do - match change with - | MemberAdded mem -> do env.MemberAdded mem - | MemberRemoved mem -> do env.MemberRemoved mem + do notifyChange env change } // ** addMembers @@ -742,3 +772,23 @@ module RaftMonad = // ** numVotesForMeOldConfig let numVotesForMeOldConfig () = zoom RaftState.numVotesForMeOldConfig + + // ** handleConfiguration + + let handleConfiguration mems = modify (RaftState.handleConfiguration mems) + + // ** handleJointConsensus + + let handleJointConsensus changes = modify (RaftState.handleJointConsensus changes) + + // ** calculateChanges + + let calculateChanges oldPeers = + raft { + let! currentPeers = peers() + return RaftState.calculateChanges oldPeers currentPeers + } + + // ** selfIncluded + + let selfIncluded () = zoom RaftState.selfIncluded diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index 6d583ca5..1e341918 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -775,3 +775,37 @@ module RaftState = match state.OldPeers with | Some peers -> numVotesForConfig state.Member state.VotedFor peers | _ -> 0 + + // ** handleConfiguration + + let handleConfiguration mems (state: RaftState) = + let parting = + mems + |> Array.map Member.id + |> Array.contains state.Member.Id + |> not + + let peers = + if parting + // we have been kicked out of the configuration + then Map [(state.Member.Id, state.Member)] + // we are still part of the new cluster configuration + else + mems + |> Array.map toPair + |> Map.ofArray + + state + |> RaftState.setPeers peers + |> RaftState.setOldPeers None + + // ** handleJointConsensus + + let handleJointConsensus (changes) (state:RaftState) = + state + |> RaftState.applyChanges changes + |> RaftState.setOldPeers (Some state.Peers) + + // ** selfIncluded + + let selfIncluded state = Map.containsKey state.Member.Id state.Peers diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index 4df74925..2298a395 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -367,7 +367,7 @@ module rec RaftServer = state.Raft.Peers |> Map.toArray |> Array.map snd - |> Log.mkConfig state.Raft.CurrentTerm + |> Log.configuration state.Raft.CurrentTerm |> appendEntry state match result with | Ok (entry, newstate) -> @@ -396,7 +396,7 @@ module rec RaftServer = if RaftState.isLeader state.Raft then mems |> Array.map ConfigChange.MemberAdded - |> Log.mkConfigChange state.Raft.CurrentTerm + |> Log.jointConsensus state.Raft.CurrentTerm |> appendEntry state else let msg = "Unable to add new member. Not leader." @@ -422,7 +422,7 @@ module rec RaftServer = mems |> Array.map ConfigChange.MemberRemoved - |> Log.mkConfigChange state.Raft.CurrentTerm + |> Log.jointConsensus state.Raft.CurrentTerm |> appendEntry state // ** removeMember diff --git a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs index 31e17867..ccb2ec5a 100644 --- a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs +++ b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs @@ -53,12 +53,17 @@ module AddPreviousMemberShouldPull = use lobs = Logger.subscribe Logger.stdout - let handler = function + let handler mem cmd = + match cmd with + | DiscoEvent.FileSystem _ -> () + | DiscoEvent.Append(_, LogMsg _) -> () + | cmd -> printfn "%s: %O" mem cmd + cmd |> function | DiscoEvent.LeaderChanged leader -> printfn "leader: changed! %A" leader | DiscoEvent.ConfigurationDone members -> configurationDone.Set() | DiscoEvent.Append(_, CommandBatch batch) -> updateDone.Set() | DiscoEvent.Append(_, LogMsg p) -> () - | ev -> () // printfn "ev: %A" ev + | ev -> () let! repo1 = Project.repository project1 @@ -76,7 +81,7 @@ module AddPreviousMemberShouldPull = SiteId = None } - use oobs1 = service1.Subscribe handler + use oobs1 = service1.Subscribe (handler "machine1") do! service1.Start() // ____ @@ -95,7 +100,7 @@ module AddPreviousMemberShouldPull = SiteId = None } - use oobs2 = service2.Subscribe handler + use oobs2 = service2.Subscribe (handler "machine2") do! service2.Start() /// _____ diff --git a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs index 5dec6e22..8ae681e2 100644 --- a/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs +++ b/src/Disco/Disco/Tests/Raft/JointConsensusTests.fs @@ -250,7 +250,7 @@ module JointConsensus = |> Array.take (n / 2) |> Array.map snd |> Log.calculateChanges peers - |> Log.mkConfigChange 1 + |> Log.jointConsensus 1 let! idx = currentIndex () ci := idx @@ -400,7 +400,7 @@ module JointConsensus = mems |> Array.map snd |> Log.calculateChanges peers - |> Log.mkConfigChange 1 + |> Log.jointConsensus 1 let! idx = currentIndex () ci := idx @@ -586,7 +586,7 @@ module JointConsensus = |> Array.map snd |> Array.skip (n / 2) |> Log.calculateChanges peers - |> Log.mkConfigChange !trm + |> Log.jointConsensus !trm let! response = Raft.receiveEntry entry for peer in peers do @@ -691,7 +691,7 @@ module JointConsensus = |> Array.map snd |> Array.append [| self |] |> Log.calculateChanges peers - |> Log.mkConfigChange !trm + |> Log.jointConsensus !trm let! response = Raft.receiveEntry entry @@ -760,7 +760,7 @@ module JointConsensus = |> Array.map snd |> Array.append [| self |] |> Log.calculateChanges peers - |> Log.mkConfigChange 1 + |> Log.jointConsensus 1 let! response = Raft.receiveEntry entry @@ -844,7 +844,7 @@ module JointConsensus = |> Array.map snd |> Array.take (n / 2) |> Log.calculateChanges peers - |> Log.mkConfigChange !trm + |> Log.jointConsensus !trm let! response = Raft.receiveEntry entry @@ -922,7 +922,7 @@ module JointConsensus = |> Array.map snd |> Array.append [| self |] |> Log.calculateChanges peers - |> Log.mkConfigChange 1 + |> Log.jointConsensus 1 let! response = Raft.receiveEntry entry From d131012cbad136820100d006a2bc3ebf6ecc3f9c Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Tue, 13 Feb 2018 17:35:31 +0100 Subject: [PATCH 17/27] make logging fields configurable --- src/Disco/Disco/Core/Logging.fs | 101 +++++++++++------- src/Disco/Disco/Service/CommandLine.fs | 5 +- .../Core/Disco/AddPreviousMemberShouldPull.fs | 14 ++- 3 files changed, 78 insertions(+), 42 deletions(-) diff --git a/src/Disco/Disco/Core/Logging.fs b/src/Disco/Disco/Core/Logging.fs index 5eb473c5..b0f2fb17 100644 --- a/src/Disco/Disco/Core/Logging.fs +++ b/src/Disco/Disco/Core/Logging.fs @@ -126,14 +126,32 @@ type LogEventYaml() = #endif +// * LogEventFields + +type LogEventFields = + { Time: bool + Thread: bool + Tier: bool + Id: bool + Tag: bool + LogLevel: bool + Message: bool } + + // ** Default + + static member Default = + { Time = true + Thread = true + Tier = true + Id = true + Tag = true + LogLevel = true + Message = true } + // * LogEvent -/// ## LogEvent -/// /// Structured log format record. /// -/// ## Fields: -/// /// - Time: int64 unixtime in milliseconds /// - Thread: int ID of Thread the log event was collected /// - Tier: application tier where log was collected @@ -141,8 +159,7 @@ type LogEventYaml() = /// - Tag: call site tag describing source code location where log was collected /// - LogLevel: LogLevel of collected log message /// - Message: log message -/// -/// Returns: LogEvent + type LogEvent = { Time : uint32 Thread : int @@ -254,6 +271,7 @@ type LoggingSettings = { MachineId: DiscoId Level: LogLevel UseColors: bool + Fields: LogEventFields Tier: Tier } // * LoggingSettings module @@ -264,9 +282,10 @@ module LoggingSettings = { MachineId = DiscoId.Empty Level = LogLevel.Debug UseColors = true + Fields = LogEventFields.Default Tier = Tier.Service } -// * Logger +// * Logger module [] module Logger = @@ -283,7 +302,12 @@ module Logger = { MachineId = DiscoId.Empty Level = LogLevel.Debug UseColors = true + Fields = LogEventFields.Default + #if DISCO_NODES + Tier = Tier.Client } + #else Tier = Tier.Service } + #endif // ** currentSettings @@ -293,6 +317,10 @@ module Logger = let set config = _settings <- config + // ** setFields + + let setFields fields = _settings <- { _settings with Fields = fields } + // ** setLevel let setLevel level = @@ -304,40 +332,41 @@ module Logger = // ** stdout - /// ## stdout - /// /// Simple logging to stdout - /// - /// ### Signature: - /// - log: LogEvent - /// - /// Returns: unit + let stdout (log: LogEvent) = #if !FABLE_COMPILER && !DISCO_NODES if _settings.UseColors then - Console.darkGreen "{0}" "[" - match log.LogLevel with - | LogLevel.Trace -> Console.gray "{0,-5}" log.LogLevel - | LogLevel.Debug -> Console.white "{0,-5}" log.LogLevel - | LogLevel.Info -> Console.green "{0,-5}" log.LogLevel - | LogLevel.Warn -> Console.yellow "{0,-5}" log.LogLevel - | LogLevel.Err -> Console.red "{0,-5}" log.LogLevel - Console.darkGreen "{0}" "] " - - Console.darkGreen "{0}:" "ts" - Console.white "{0} " log.Time - - Console.darkGreen "{0}:" "id" - Console.white "{0} " (log.MachineId.Prefix()) - - Console.darkGreen "{0}:" "type" - Console.white "{0,-7} " log.Tier - - Console.darkGreen "{0}:" "in" - Console.yellow "{0,-30} " log.Tag - Console.white "{0}" log.Message - Console.Write(System.Environment.NewLine) + if _settings.Fields.LogLevel then + Console.darkGreen "{0}" "[" + match log.LogLevel with + | LogLevel.Trace -> Console.gray "{0,-5}" log.LogLevel + | LogLevel.Debug -> Console.white "{0,-5}" log.LogLevel + | LogLevel.Info -> Console.green "{0,-5}" log.LogLevel + | LogLevel.Warn -> Console.yellow "{0,-5}" log.LogLevel + | LogLevel.Err -> Console.red "{0,-5}" log.LogLevel + Console.darkGreen "{0}" "] " + + if _settings.Fields.Time then + Console.darkGreen "{0}:" "ts" + Console.white "{0} " log.Time + + if _settings.Fields.Id then + Console.darkGreen "{0}:" "id" + Console.white "{0} " (log.MachineId.Prefix()) + + if _settings.Fields.Tier then + Console.darkGreen "{0}:" "type" + Console.white "{0,-7} " log.Tier + + if _settings.Fields.Tag then + Console.darkGreen "{0}:" "in" + Console.yellow "{0,-30} " log.Tag + + if _settings.Fields.Message then + Console.white "{0}" log.Message + Console.Write(System.Environment.NewLine) else #endif Console.WriteLine("{0}", log) diff --git a/src/Disco/Disco/Service/CommandLine.fs b/src/Disco/Disco/Service/CommandLine.fs index 12781591..5a9f78d0 100644 --- a/src/Disco/Disco/Service/CommandLine.fs +++ b/src/Disco/Disco/Service/CommandLine.fs @@ -158,10 +158,11 @@ module CommandLine = Tier = Tier.Service UseColors = termSupportsColors Level = LogLevel.Debug + Fields = LogEventFields.Default } - + do! Metrics.init machine - + use _ = Logger.subscribe Logger.stdout let! discoService = Disco.create post { diff --git a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs index ccb2ec5a..00de5a7b 100644 --- a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs +++ b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs @@ -24,7 +24,7 @@ open Common module AddPreviousMemberShouldPull = let test = - testCase "ensure previous member pulls from leader" <| fun _ -> + ftestCase "ensure previous member pulls from leader" <| fun _ -> result { use configurationDone = new WaitEvent() use updateDone = new WaitEvent() @@ -51,18 +51,24 @@ module AddPreviousMemberShouldPull = do! FileSystem.copyDir project1.Path path2 do! project2.Save path2 + do Logger.setFields { + LogEventFields.Default with + LogLevel = false + Time = false + Id = false + Tier = false + } + use lobs = Logger.subscribe Logger.stdout let handler mem cmd = match cmd with | DiscoEvent.FileSystem _ -> () | DiscoEvent.Append(_, LogMsg _) -> () - | cmd -> printfn "%s: %O" mem cmd + | cmd -> Logger.debug mem (string cmd) cmd |> function - | DiscoEvent.LeaderChanged leader -> printfn "leader: changed! %A" leader | DiscoEvent.ConfigurationDone members -> configurationDone.Set() | DiscoEvent.Append(_, CommandBatch batch) -> updateDone.Set() - | DiscoEvent.Append(_, LogMsg p) -> () | ev -> () let! repo1 = Project.repository project1 From 5dbbc288f1639aff752e4d4dea27e47ac512f334 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Wed, 14 Feb 2018 16:37:13 +0100 Subject: [PATCH 18/27] do send snapshot to followers after successful reconfiguration --- src/Disco/Disco/Net/TcpClient.fs | 10 --------- src/Disco/Disco/Net/TcpServer.fs | 3 --- src/Disco/Disco/Raft/Raft.fs | 35 ++++++++++++++++++++------------ 3 files changed, 22 insertions(+), 26 deletions(-) diff --git a/src/Disco/Disco/Net/TcpClient.fs b/src/Disco/Disco/Net/TcpClient.fs index 2bd4f38b..5d005a53 100644 --- a/src/Disco/Disco/Net/TcpClient.fs +++ b/src/Disco/Disco/Net/TcpClient.fs @@ -149,16 +149,10 @@ module rec TcpClient = member state.Request (request: Request) = // this socket is asking something, so we need to track this in pending requests - do request.RequestId - |> sprintf "sending to %A (id: %A)" request.PeerId - |> Logger.debug (tag "Request") do pending.TryAdd(request.RequestId, request) |> ignore do request |> RequestBuilder.serialize |> sender.Post member state.Respond (response: Response) = - do response.RequestId - |> sprintf "sending to %A (id: %A)" response.PeerId - |> Logger.debug (tag "Respond") do response |> RequestBuilder.serialize |> sender.Post member state.StartReceiving() = @@ -200,10 +194,6 @@ module rec TcpClient = |> String.format "{0} in socket operation" |> Error.asSocketError (tag "onSend") |> handleError state - else - args.BytesTransferred - |> String.format "sent {0} bytes" - |> Logger.debug (tag "onSend") // ** sendAsync diff --git a/src/Disco/Disco/Net/TcpServer.fs b/src/Disco/Disco/Net/TcpServer.fs index f7a5f659..c02b65cc 100644 --- a/src/Disco/Disco/Net/TcpServer.fs +++ b/src/Disco/Disco/Net/TcpServer.fs @@ -265,9 +265,6 @@ module TcpServer = if args.SocketError <> SocketError.Success then do onError "onSend" state args else - args.BytesTransferred - |> String.format "sent {0} bytes" - |> Logger.debug (tag "onSend") do returnArgs state args do dispose listener diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index efa326fc..1fbaa6e3 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -602,7 +602,6 @@ module rec Raft = do! setConfigChangeEntry change } - // ** applyEntries let applyEntries () = @@ -626,26 +625,36 @@ module rec Raft = // Apply log chain in the order it arrived do! applyLogs entries + + /// The cluster was just re-configured, and if any of (possibly) just removed members were + /// to be added again, the replay log they would receive when joining would cause them to + /// be automatically being removed again. This is why, after the configuration changes are + /// done we need to create a snapshot of the raft log, which won't contain those commands. if LogEntry.contains LogEntry.isConfiguration entries then + /// If self was removed from the cluster, reset node to Follower state. let! included = selfIncluded () if not included then - let str = - string state.Member.Id - |> sprintf "self (%s) not included in new configuration" - do! logDebug "applyEntries" str + do! logDebug "applyEntries" $ + String.format + "self ({0}) not included in new configuration" + state.Member.Id do! setLeader None do! becomeFollower () - /// snapshot now: - /// - /// the cluster was just re-configured, and if any of (possibly) just removed members were - /// to be added again, the replay log they would receive when joining would cause them to - /// be automatically being removed again. this is why, after the configuration changes are - /// done we need to create a snapshot of the raft log, which won't contain those commands. + + /// Do Snapshot Now! + let! self = self() do! doSnapshot() + /// Install the snapshot on all followers to ensure consistency. + if self.State = Leader then + let! peers = peers() + for KeyValue(peerId,peer) in peers do + if peerId <> self.Id then + do! sendInstallSnapshot peer + let! peers = peers() - if not (RaftState.isLeader state) && LogEntry.contains LogEntry.isConfiguration entries then - do! logDebug "applyEntries" "not leader and new configuration is applied. Updating mems." + if not (RaftState.isLeader state) && LogEntry.contains LogEntry.isConfiguration entries + then for KeyValue(_, peer) in peers do if peer.Status <> Running then do! updateMember { peer with Status = Running; Voting = true } From dbca4d67e103107e5b69ae71e7d670fdff024d55 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Fri, 16 Feb 2018 09:26:16 +0100 Subject: [PATCH 19/27] make State.update total by removing wildcard --- src/Disco/Disco/Core/StateMachine.fs | 44 ++++++++++++++---------- src/Disco/Disco/Tests/Core/StateTests.fs | 14 ++++++++ 2 files changed, 40 insertions(+), 18 deletions(-) diff --git a/src/Disco/Disco/Core/StateMachine.fs b/src/Disco/Disco/Core/StateMachine.fs index a336ac33..be7278bb 100644 --- a/src/Disco/Disco/Core/StateMachine.fs +++ b/src/Disco/Disco/Core/StateMachine.fs @@ -1275,9 +1275,23 @@ module State = | UpdateDiscoveredService service -> addOrUpdateService service state | RemoveDiscoveredService service -> removeService service state - | Command AppCommand.Save -> onSave state + | Command AppCommand.Save -> onSave state + + | DataSnapshot snapshot -> snapshot + + | UnloadProject /// handled one level up in Store.Dispatch + | UpdateClock _ /// not handled in-state for now + | SetLogLevel _ /// TODO: should eventually be saved in MachineConfig + | LogMsg _ /// logs bear no relevance to the state + | CommandBatch _ /// handled separately by folding of commands + | CallCue _ /// the service resolves the cue + | AddMachine _ /// raft commands which are not handled + | UpdateMachine _ + | RemoveMachine _ + | Command AppCommand.Undo /// application commands handled one level up + | Command AppCommand.Redo + | Command AppCommand.Reset -> state - | _ -> state // ** processBatch @@ -1473,34 +1487,28 @@ type Store(state : State)= // ** Dispatch - /// ## Dispatch - /// /// Disgroup an action (StateMachine command) to be executed against the current version of the /// `State` to produce the next `State`. /// /// Then notify all listeners of the change, and record a history item for this change. /// - /// ### Signature: /// - ev: `StateMachine` - command to apply to the `State` - /// - /// Returns: unit - member self.Dispatch (ev : StateMachine) : unit = - let andRender (newstate: State) = - state <- newstate // 1) create new state - self.Notify(ev) // 2) notify all - history.Append({ Event = ev // 3) store this action and new state - State = state }) // 4) append to undo history + + member self.Dispatch ev = + let updateState (newstate: State) = + state <- newstate // 1) create new state + self.Notify(ev) // 2) notify all + history.Append + { Event = ev // 3) store this action and new state + State = state } // 4) append to undo history match ev with | Command (AppCommand.Redo) -> self.Redo() | Command (AppCommand.Undo) -> self.Undo() | Command (AppCommand.Reset) -> () // do nothing for now - | UnloadProject -> self.Notify(ev) // This event doesn't actually modify the state - - | CommandBatch batch -> State.processBatch state batch |> andRender - - | other -> State.update state other |> andRender + | CommandBatch batch -> State.processBatch state batch |> updateState + | other -> State.update state other |> updateState // ** Subscribe diff --git a/src/Disco/Disco/Tests/Core/StateTests.fs b/src/Disco/Disco/Tests/Core/StateTests.fs index 009fab13..cc1058e3 100644 --- a/src/Disco/Disco/Tests/Core/StateTests.fs +++ b/src/Disco/Disco/Tests/Core/StateTests.fs @@ -8,6 +8,7 @@ namespace Disco.Tests open Expecto +open System.Collections.Generic open Disco.Core open Disco.Raft @@ -65,9 +66,22 @@ module StateTests = } |> noError + let test_apply_datasnapshot_correctly = + testCase "should apply datasnapshot correctly" <| fun _ -> + result { + let initial = State.Empty + let cue = Cue.create "Hello" Array.empty + let state = State.addCue cue initial + Expect.contains state.Cues (KeyValuePair(cue.Id, cue)) "should contain cue" + let state = State.update state (DataSnapshot initial) + Expect.equal state initial "should reset the state" + } + |> noError + let stateTests = testList "State Tests" [ test_apply_fstree_add_correctly test_apply_fsentry_add_correctly test_apply_fsentry_remove_correctly + test_apply_datasnapshot_correctly ] From 23130cb002293b7e85c6d4572e6fb6e2181b60a7 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Tue, 20 Feb 2018 11:49:28 +0100 Subject: [PATCH 20/27] remove Member and State fields from RaftState --- src/Disco/Disco/Raft/Raft.fs | 4 +- src/Disco/Disco/Raft/RaftState.fs | 67 +++++++++++++++-------- src/Disco/Disco/Service/RaftServer.fs | 2 +- src/Disco/Disco/Tests/Raft/Scenarios.fs | 4 +- src/Disco/Disco/Tests/Raft/ServerTests.fs | 10 ++-- 5 files changed, 53 insertions(+), 34 deletions(-) diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index 1fbaa6e3..c87bf65b 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -207,7 +207,7 @@ module rec Raft = let private shouldCommit peers state resp = let folder (votes: int) nid (mem: RaftMember) = - if nid = state.Member.Id || not (Member.isVoting mem) + if nid = state.MemberId || not (Member.isVoting mem) then votes elif mem.MatchIndex > 0 then match RaftState.entryAt mem.MatchIndex state with @@ -885,7 +885,7 @@ module rec Raft = /// Process the vote if current state of our Raft must be candidate.. else - match state.State with + match state.Member.State with | Leader -> return () | Follower -> /// ...otherwise we respond with the respective RaftError. diff --git a/src/Disco/Disco/Raft/RaftState.fs b/src/Disco/Disco/Raft/RaftState.fs index 1e341918..b7494728 100644 --- a/src/Disco/Disco/Raft/RaftState.fs +++ b/src/Disco/Disco/Raft/RaftState.fs @@ -112,9 +112,7 @@ type RaftStateYaml() = type RaftState = { /// this server's own RaftMember information - Member : RaftMember - /// this server's current Raft state, i.e. follower, leader or candidate - State : MemberState + MemberId : MemberId /// the server's current term, a monotonic counter for election cycles CurrentTerm : Term /// tracks the current Leader Id, or None if there isn't currently a leader @@ -145,13 +143,9 @@ type RaftState = // ** optics - static member Member_ = - (fun (rs:RaftState) -> rs.Member), - (fun mem (rs:RaftState) -> { rs with Member = mem }) - - static member State_ = - (fun (rs:RaftState) -> rs.State), - (fun state (rs:RaftState) -> { rs with State = state }) + static member MemberId_ = + (fun (rs:RaftState) -> rs.MemberId), + (fun memberId (rs:RaftState) -> { rs with MemberId = memberId }) static member CurrentTerm_ = (fun (rs:RaftState) -> rs.CurrentTerm), @@ -226,7 +220,7 @@ RequestTimeout = %A ConfigChangeEntry = %s " (self.Member.ToString()) - self.State + self.Member.State self.CurrentTerm self.CurrentLeader (Map.count self.Peers) @@ -249,6 +243,16 @@ ConfigChangeEntry = %s | Some lid -> self.Member.Id = lid | _ -> false + // ** Member + + member self.Member: RaftMember = + match Map.tryFind self.MemberId self.Peers with + | Some mem -> mem + | None -> + match Option.bind (Map.tryFind self.MemberId) self.OldPeers with + | Some mem -> mem + | None -> failwith "could not find current member in peers map." + // ** ToYaml #if !FABLE_COMPILER && !DISCO_NODES @@ -289,12 +293,12 @@ ConfigChangeEntry = %s then Ok None else DiscoId.TryParse yaml.VotedFor |> Result.map Some + let mem = Member.create id return { - Member = Member.create id - State = Follower + MemberId = id CurrentTerm = yaml.Term CurrentLeader = leader - Peers = Map.empty + Peers = Map [ (id, mem) ] OldPeers = None VotedFor = votedfor Log = Log.empty @@ -320,8 +324,9 @@ module RaftState = // ** getters - let self = Optic.get RaftState.Member_ - let state = Optic.get RaftState.State_ + let self (state: RaftState) = state.Member + let state = self >> Member.state + let memberId = Optic.get RaftState.MemberId_ let currentTerm = Optic.get RaftState.CurrentTerm_ let currentLeader = Optic.get RaftState.CurrentLeader_ let peers = Optic.get RaftState.Peers_ @@ -338,8 +343,7 @@ module RaftState = // ** setters - let setSelf = Optic.set RaftState.Member_ - let setState = Optic.set RaftState.State_ + let setMemberId = Optic.set RaftState.MemberId_ let setCurrentTerm = Optic.set RaftState.CurrentTerm_ let setCurrentLeader = Optic.set RaftState.CurrentLeader_ let setPeers = Optic.set RaftState.Peers_ @@ -354,11 +358,26 @@ module RaftState = let setMaxLogDepth = Optic.set RaftState.MaxLogDepth_ let setConfigChangeEntry = Optic.set RaftState.ConfigChangeEntry_ + // ** setSelf + + let setSelf (mem: RaftMember) state = + state + |> peers + |> Map.add mem.Id mem + |> flip setPeers state + |> setMemberId mem.Id + + // ** setState + + let setState memState (state:RaftState) = + state.Member + |> Member.setState memState + |> flip setSelf state + // ** create let create (self: RaftMember) = - { Member = self - State = Follower + { MemberId = self.Id CurrentTerm = 0 CurrentLeader = None Peers = Map.ofList [(self.Id, self)] @@ -390,15 +409,15 @@ module RaftState = // ** isFollower - let isFollower state = state.State = Follower + let isFollower (state:RaftState) = state.Member.State = Follower // ** isCandidate - let isCandidate state = state.State = Candidate + let isCandidate (state:RaftState) = state.Member.State = Candidate // ** isLeader - let isLeader state = state.State = Leader + let isLeader (state:RaftState) = state.Member.State = Leader // ** inJointConsensus @@ -808,4 +827,4 @@ module RaftState = // ** selfIncluded - let selfIncluded state = Map.containsKey state.Member.Id state.Peers + let selfIncluded state = Map.containsKey state.MemberId state.Peers diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index 2298a395..96545341 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -1526,7 +1526,7 @@ module rec RaftServer = with get () = RaftState.isLeader store.State.Raft member self.RaftState - with get () = store.State.Raft.State + with get () = store.State.Raft.Member.State member self.Leader with get () = RaftState.getLeader store.State.Raft diff --git a/src/Disco/Disco/Tests/Raft/Scenarios.fs b/src/Disco/Disco/Tests/Raft/Scenarios.fs index 721fda23..b681850c 100644 --- a/src/Disco/Disco/Tests/Raft/Scenarios.fs +++ b/src/Disco/Disco/Tests/Raft/Scenarios.fs @@ -125,7 +125,7 @@ module Scenarios = raft { let! raft' = get - let receiver = Map.find raft'.Member.Id peers + let receiver = Map.find raft'.MemberId peers let inbox = (!receiver).Inbox let outbox = (!receiver).Inbox @@ -219,7 +219,7 @@ module Scenarios = while anyMsgs senders do for idx in 0UL .. (numPeers - 1UL) do let srv = servers.[int idx] - __logg <| sprintf "[raft: %d] [state: %A]" idx (fst srv).State + __logg <| sprintf "[raft: %d] [state: %A]" idx (fst srv).Member.State pollMsgs senders |> evalRaft (fst srv) (snd srv) diff --git a/src/Disco/Disco/Tests/Raft/ServerTests.fs b/src/Disco/Disco/Tests/Raft/ServerTests.fs index 7a9353e4..eeaa91bf 100644 --- a/src/Disco/Disco/Tests/Raft/ServerTests.fs +++ b/src/Disco/Disco/Tests/Raft/ServerTests.fs @@ -968,15 +968,15 @@ module ServerTests = let candidate_will_not_respond_to_voterequest_if_it_has_already_voted = testCase "candidate will not respond to voterequest if it has already voted" <| fun _ -> raft { - let! raft' = get + let! self = self() let peer = Member.create (DiscoId.Create()) let vote : VoteRequest = { Term = 0 // term must be equal or lower that raft's - Candidate = raft'.Member // term for this to work + Candidate = self // term for this to work LastLogIndex = 0 LastLogTerm = 0 } do! addMember peer - do! voteFor (Some raft'.Member) + do! voteFor (Some self) let! resp = Raft.receiveVoteRequest peer.Id vote expect "Should have failed" true VoteResponse.declined resp } @@ -1022,7 +1022,7 @@ module ServerTests = expect "should have last log index be 3" 3 VoteRequest.lastLogIndex vote expect "should have last term be 5" 5 VoteRequest.term vote expect "should have last log term be 3" 3 VoteRequest.lastLogTerm vote - expect "should have candidate id be me" self VoteRequest.candidate vote + expect "should have candidate id be me" (Member.id self) (VoteRequest.candidate >> Member.id) vote } |> runWithRaft raft' cbs |> noError @@ -1963,7 +1963,7 @@ module ServerTests = raft { let! raft' = get - let nid = Some raft'.Member.Id + let nid = Some raft'.MemberId let pid = Some peer.Id do! addMember peer do! setState Leader From 43af9da54bcae8be67f492194a469494eed21e7f Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Tue, 20 Feb 2018 15:10:52 +0100 Subject: [PATCH 21/27] ensure cluster config and states are correct after cluster changes --- src/Disco/Disco/Core/Interfaces.fs | 4 - src/Disco/Disco/Core/StateMachine.fs | 41 ++-- src/Disco/Disco/Raft/Raft.fs | 65 ++++--- src/Disco/Disco/Service/DiscoService.fs | 176 +++++++++--------- src/Disco/Disco/Service/Interfaces.fs | 1 + src/Disco/Disco/Service/Persistence.fs | 2 +- src/Disco/Disco/Service/RaftServer.fs | 14 +- .../Core/Disco/AddPreviousMemberShouldPull.fs | 35 +++- .../Disco/RemoveMemberShouldSplitCluster.fs | 5 - .../Disco/Tests/Core/RaftIntegrationTests.fs | 9 + 10 files changed, 195 insertions(+), 157 deletions(-) diff --git a/src/Disco/Disco/Core/Interfaces.fs b/src/Disco/Disco/Core/Interfaces.fs index a36c31d2..3532555d 100644 --- a/src/Disco/Disco/Core/Interfaces.fs +++ b/src/Disco/Disco/Core/Interfaces.fs @@ -103,7 +103,6 @@ type DiscoEvent = | EnterJointConsensus of changes:ConfigChange array | LeaderChanged of leader:MemberId option | StateChanged of oldstate:MemberState * newstate:MemberState - | PersistSnapshot of log:LogEntry | RaftError of error:DiscoError | Status of ServiceStatus | GitPull of remote:IpAddress @@ -122,7 +121,6 @@ type DiscoEvent = | EnterJointConsensus _ -> "EnterJointConsensus" | LeaderChanged _ -> "LeaderChanged" | StateChanged _ -> "StateChanged" - | PersistSnapshot _ -> "PersistSnapshot" | RaftError _ -> "RaftError" | Status _ -> "Status" | SessionOpened _ -> "SessionOpened" @@ -142,7 +140,6 @@ type DiscoEvent = | EnterJointConsensus _ | LeaderChanged _ | StateChanged _ - | PersistSnapshot _ | RaftError _ | SessionOpened _ | SessionClosed _ @@ -177,7 +174,6 @@ type DiscoEvent = | EnterJointConsensus _ | StateChanged _ | LeaderChanged _ - | PersistSnapshot _ | RaftError _ -> Process // ____ _ _ diff --git a/src/Disco/Disco/Core/StateMachine.fs b/src/Disco/Disco/Core/StateMachine.fs index be7278bb..4fba43be 100644 --- a/src/Disco/Disco/Core/StateMachine.fs +++ b/src/Disco/Disco/Core/StateMachine.fs @@ -1125,6 +1125,18 @@ module State = // | |___| | | __/ | | | |_ // \____|_|_|\___|_| |_|\__| + // ** updateRaftMember + + let updateRaftMember (mem: RaftMember) (state: State) = + match Project.findMember mem.Id state.Project with + | Ok clusterMember -> + let mem = + clusterMember + |> ClusterMember.setState mem.State + |> ClusterMember.setStatus mem.Status + { state with Project = Project.updateMember mem state.Project } + | _ -> state + // ** addClient let addClient (client: DiscoClient) (state: State) = @@ -1212,6 +1224,11 @@ module State = let onSave (state: State) = { state with PinGroups = PinGroupMap.mapPins (Pin.setDirty false) state.PinGroups } + // ** processBatch + + let processBatch (state: State) (Transaction batch) = + List.fold update state batch + // ** update let update (state: State) = function @@ -1248,6 +1265,9 @@ module State = | UpdateMember mem -> updateMember mem state | RemoveMember mem -> removeMember mem.Id state + | UpdateMachine mem -> updateRaftMember mem state + | RemoveMachine mem -> removeMember mem.Id state + | AddClient client -> addClient client state | UpdateClient client -> updateClient client state | RemoveClient client -> removeClient client state @@ -1278,26 +1298,18 @@ module State = | Command AppCommand.Save -> onSave state | DataSnapshot snapshot -> snapshot + | CommandBatch batch -> processBatch state batch | UnloadProject /// handled one level up in Store.Dispatch | UpdateClock _ /// not handled in-state for now | SetLogLevel _ /// TODO: should eventually be saved in MachineConfig | LogMsg _ /// logs bear no relevance to the state - | CommandBatch _ /// handled separately by folding of commands | CallCue _ /// the service resolves the cue - | AddMachine _ /// raft commands which are not handled - | UpdateMachine _ - | RemoveMachine _ + | AddMachine _ /// not handled since we don't know how to convert to ClusterMember | Command AppCommand.Undo /// application commands handled one level up | Command AppCommand.Redo | Command AppCommand.Reset -> state - - // ** processBatch - - let processBatch (state: State) (batch: Transaction) = - List.fold update state batch.Commands - // ** initialize let initialize (state: State) = @@ -1424,19 +1436,13 @@ type History (action: StoreAction) = // |____/ \__\___/|_| \___| // -/// ## Store -/// /// The `Store` centrally manages all state changes and notifies interested parties of changes to /// the carried state (e.g. views, socket transport). Clients of the `Store` can subscribe to change /// notifications by regis a callback handler. `Store` is used in all parts of the Disco cluster /// application, from the front-end, at the service level, to all registered clients. `StateMachine` /// commands replicated via `Raft` are applied in the same order to it to ensure that all parties /// have the same data. -/// -/// ### Signature: -/// - state: `State` - the intitial state to use for the store -/// -/// Returns: Store + type Store(state : State)= let mutable state = state @@ -1507,7 +1513,6 @@ type Store(state : State)= | Command (AppCommand.Undo) -> self.Undo() | Command (AppCommand.Reset) -> () // do nothing for now | UnloadProject -> self.Notify(ev) // This event doesn't actually modify the state - | CommandBatch batch -> State.processBatch state batch |> updateState | other -> State.update state other |> updateState // ** Subscribe diff --git a/src/Disco/Disco/Raft/Raft.fs b/src/Disco/Disco/Raft/Raft.fs index c87bf65b..550e9f4e 100644 --- a/src/Disco/Disco/Raft/Raft.fs +++ b/src/Disco/Disco/Raft/Raft.fs @@ -420,12 +420,12 @@ module rec Raft = // ** sendInstallSnapshot - let sendInstallSnapshot mem = + let sendInstallSnapshot mem snapshot = raft { let! env = read let! term = currentTerm() let! leader = self () >>= (Member.id >> returnM) - match env.RetrieveSnapshot () with + match snapshot with | Some (Snapshot(_,idx,term,_,_,_,_) as snapshot) -> env.SendInstallSnapshot mem { Term = term @@ -434,7 +434,9 @@ module rec Raft = LastTerm = term Data = snapshot } - | _ -> () + | other -> + "Snapshot malformatted: " + string other + |> Logger.err (tag "sendInstallSnapshot") } // ** responseCommitted @@ -491,7 +493,8 @@ module rec Raft = else // because this mem is way behind in the cluster, get it up to speed // with a snapshot - do! sendInstallSnapshot mem + let! snapshot = generateSnapshot () + do! sendInstallSnapshot mem snapshot do! updateCommitIndex () let! term = currentTerm () @@ -641,16 +644,17 @@ module rec Raft = do! setLeader None do! becomeFollower () - /// Do Snapshot Now! let! self = self() - do! doSnapshot() + let! currentlyLeader = isLeader() /// Install the snapshot on all followers to ensure consistency. - if self.State = Leader then + if currentlyLeader then + let! snapshot = generateSnapshot() + /// Do Snapshot Now! let! peers = peers() for KeyValue(peerId,peer) in peers do if peerId <> self.Id then - do! sendInstallSnapshot peer + do! sendInstallSnapshot peer snapshot let! peers = peers() if not (RaftState.isLeader state) && LogEntry.contains LogEntry.isConfiguration entries @@ -692,7 +696,7 @@ module rec Raft = do! setTimeoutElapsed 0 match is.Data with - | Snapshot(_,idx,_,_,_,mems, _) as snapshot -> + | Snapshot(_,idx,_,_,_,mems, DataSnapshot data) as snapshot -> // IMPROVEMENT: implementent chunked transmission as per paper do cbs.PersistSnapshot snapshot @@ -711,28 +715,25 @@ module rec Raft = // update log with snapshot and possibly merge existing entries match remaining with - | Some entries -> - do! Log.empty - |> Log.append is.Data - |> Log.append entries - |> setLog - | _ -> - do! updateLogEntries is.Data |> modify + | Some entries -> + do! Log.empty + |> Log.append is.Data + |> Log.append entries + |> setLog + | _ -> + do! updateLogEntries is.Data |> modify // set the current leader to mem which sent snapshot do! setLeader (Some is.LeaderId) // apply all entries in the new log - let! state = get + let! log = log() - match state.Log.Data with - | Some data -> - LogEntry.foldr (fun _ entry -> applyEntry cbs entry) () data - | _ -> failwith "Fatal. Snapshot applied, but log is empty. Aborting." + do Option.iter (LogEntry.foldr (fun _ entry -> applyEntry cbs entry) ()) log.Data // reset the counters,to apply all entries in the log - do! setLastAppliedIndex (Log.index state.Log) - do! setCommitIndex (Log.index state.Log) + do! setLastAppliedIndex (Log.index log) + do! setCommitIndex (Log.index log) // construct reply let! term = currentTerm () @@ -752,9 +753,9 @@ module rec Raft = |> failM } - // ** doSnapshot + // ** generateSnapshot - let doSnapshot () = + let generateSnapshot () = raft { let! cbs = read let! state = get @@ -762,9 +763,15 @@ module rec Raft = | Some snapshot -> do! setLog snapshot match snapshot.Data with - | Some snapshot -> cbs.PersistSnapshot snapshot - | _ -> () - | _ -> () + | Some snapshot -> + do cbs.PersistSnapshot snapshot + return (Some snapshot) + | None -> + do! logError "generateSnapshot" "generated snapshot has not data" + return None + | None -> + do! logError "generateSnapshot" "no snapshot was generated" + return None } // ** maybeSnapshot @@ -773,7 +780,7 @@ module rec Raft = raft { let! state = get if Log.length state.Log >= int state.MaxLogDepth then - do! doSnapshot () + do! generateSnapshot () >>= ignoreM } // ** maybeSetIndex diff --git a/src/Disco/Disco/Service/DiscoService.fs b/src/Disco/Disco/Service/DiscoService.fs index 1583242a..e6f6e22b 100644 --- a/src/Disco/Disco/Service/DiscoService.fs +++ b/src/Disco/Disco/Service/DiscoService.fs @@ -137,7 +137,8 @@ module DiscoService = fun _ _ -> function | DiscoEvent.Append(_, Command AppCommand.Undo) -> store.State.Store.Undo() | DiscoEvent.Append(_, Command AppCommand.Redo) -> store.State.Store.Redo() - | DiscoEvent.Append(_, cmd) -> store.State.Store.Dispatch cmd + | DiscoEvent.Append(_, LogMsg _) -> () + | DiscoEvent.Append(_, cmd) -> do store.State.Store.Dispatch cmd | _ -> () // ** statePersistor @@ -325,31 +326,6 @@ module DiscoService = }) | _ -> () - // ** preActions - - let private preActions (store: IAgentStore) = - [| Pipeline.createHandler (stateMutator store) - Pipeline.createHandler (pinResetHandler store) |] - - // ** processors - - let private processors (store: IAgentStore) = - [| Pipeline.createHandler (statePersistor store) - Pipeline.createHandler (mappingResolver store) - Pipeline.createHandler (logPersistor store) |] - - // ** publishers - - let private publishers (store: IAgentStore) = - [| Pipeline.createHandler (createPublisher store.State.ApiServer) - Pipeline.createHandler (createPublisher store.State.SocketServer) - Pipeline.createHandler (commandResolver store) |] - - // ** postActions - - let private postActions (store: IAgentStore) = - [| Pipeline.createHandler (subscriptionNotifier store) |] - // ** sendLocalData /// ## Send local data to leader upon connection. @@ -358,11 +334,9 @@ module DiscoService = /// browser sessions or locally connected client instances. These pieces of data need to be /// replicated to the leader once connected. IF those clients/sessions already exist, they /// will simply be ignored. + let private sendLocalData (socket: ITcpClient) (store: IAgentStore) = - let mem = - match Config.getActiveMember store.State.Store.State.Project.Config with - | Some clusterMem -> [ AddMember clusterMem ] - | None -> List.empty + let mem = [ AddMember $ Machine.toClusterMember store.State.Machine ] let sessions = store.State.SocketServer.Sessions |> Map.toList @@ -406,7 +380,7 @@ module DiscoService = /// Create a communication socket with the current Raft leader. Its important to note that /// the current members Id *must* be used to set up the client socket. - let private makeLeader (leader: RaftMember) (store: IAgentStore) = + let private makeLeader (leader:RaftMember) (store: IAgentStore) = let socket = TcpClient.create { Tag = "DiscoService.Leader.TcpClient" ClientId = store.State.Member.Id // IMPORTANT: this must be the current member's Id @@ -414,12 +388,58 @@ module DiscoService = PeerPort = leader.RaftPort Timeout = int Constants.REQ_TIMEOUT * 1 } - handleLeaderEvents socket store - |> socket.Subscribe - |> ignore - socket.Connect() + do handleLeaderEvents socket store + |> socket.Subscribe + |> ignore + do socket.Connect() Some { Member = leader; Socket = socket } + // ** maybeCreateLeader + + let private maybeCreateLeader (store: IAgentStore) = + let newLeader = + match store.State.Leader, store.State.RaftServer.Leader with + | Some { Member = currentLeader }, Some raftLeader -> + if currentLeader.Id <> raftLeader.Id && raftLeader.Id <> store.State.Member.Id + then + do Option.iter dispose store.State.Leader + // create redirect socket if we have new leader other than this current node + match Map.tryFind raftLeader.Id store.State.RaftServer.Raft.Peers with + | Some leader -> makeLeader leader store + | None -> + "Could not start re-direct socket: no leader" + |> Logger.debug (tag "maybeCreateLeader") + None + else + "Leader socket exists for current leader." + |> Logger.debug (tag "maybeCreateLeader") + store.State.Leader + | None, Some raftLeader -> + /// /// this service is currently leader, so append the local fstree + /// Option.iter + /// (AddFsTree >> DiscoEvent.appendService >> Pipeline.push pipeline) + /// store.State.AssetService.State + if raftLeader.Id <> store.State.Member.Id + then + // create redirect socket if we have new leader other than this current node + match Map.tryFind raftLeader.Id store.State.RaftServer.Raft.Peers with + | Some leader -> makeLeader leader store + | None -> + "Could not start re-direct socket: no leader" + |> Logger.debug (tag "maybeCreateLeader") + None + else + "Currently leader, not creating socket." + |> Logger.debug (tag "maybeCreateLeader") + store.State.Leader + | Some current, None -> + do dispose current + "No current leader, disposing current socket." + |> Logger.debug (tag "maybeCreateLeader") + None + | None, None -> None + store.Update { store.State with Leader = newLeader } + // ** processEvent /// ## Process DiscoEvents that have special semantics. @@ -427,9 +447,7 @@ module DiscoService = /// Events that need to be treated differently than normal state machine comand events come from /// RaftServer and are used to e.g. wire up communication with the leader for forwarding state /// machine commands to the leader. - let private processEvent (store: IAgentStore) pipeline ev = - Observable.onNext store.State.Subscriptions ev - match ev with + let private processEvent (store: IAgentStore) _ _ = function | DiscoEvent.EnterJointConsensus changes -> changes |> Array.map @@ -446,21 +464,6 @@ module DiscoService = |> Logger.debug (tag "processEvent") | DiscoEvent.ConfigurationDone mems -> - let ids = Array.map Member.id mems - let project = State.project store.State.Store.State - let config = Project.config project - match Config.getActiveSite config with - | None -> () /// this should ever happen - | Some activeSite -> - activeSite - |> ClusterConfig.members - |> Map.filter (fun id _ -> Array.contains id ids) - |> flip ClusterConfig.setMembers activeSite - |> flip Config.updateSite config - |> flip Project.setConfig project - |> UpdateProject - |> DiscoEvent.appendService - |> Pipeline.push pipeline mems |> Array.map (Member.id >> string) |> Array.fold (fun s id -> s + " " + id) "New Configuration with: " @@ -472,42 +475,45 @@ module DiscoService = |> Logger.debug (tag "processEvent") | DiscoEvent.LeaderChanged leader -> - printfn "[DISCO]: leader changed! %A" leader leader |> String.format "Leader changed to {0}" |> Logger.debug (tag "leaderChanged") + do maybeCreateLeader store - printfn "disposing old leader socket" - Option.iter dispose store.State.Leader - - let newLeader = - match leader with - | Some leaderId when leaderId <> store.State.Member.Id -> - // create redirect socket if we have new leader other than this current node - match store.State.RaftServer.Leader with - | Some leader -> makeLeader leader store - | None -> - "Could not start re-direct socket: no leader" - |> Logger.debug (tag "leaderChanged") - None - | Some _ -> - /// this service is currently leader, so append the local fstree - Option.iter - (AddFsTree >> DiscoEvent.appendService >> Pipeline.push pipeline) - store.State.AssetService.State - None - | None -> None - - store.Update { store.State with Leader = newLeader } - - | DiscoEvent.PersistSnapshot log -> - match Persistence.persistSnapshot store.State.Store.State log with - | Error error -> Logger.err (tag "persistSnapshot") (string error) - | _ -> () + | DiscoEvent.Append(_, DataSnapshot _) -> + match store.State.Leader with + | Some leader -> do sendLocalData leader.Socket store + | None -> do maybeCreateLeader store | DiscoEvent.RaftError error -> Logger.err (tag "processEvents") error.Message | _ -> () + // ** preActions + + let private preActions (store: IAgentStore) = + [| Pipeline.createHandler (stateMutator store) + Pipeline.createHandler (pinResetHandler store) |] + + // ** processors + + let private processors (store: IAgentStore) = + [| Pipeline.createHandler (statePersistor store) + Pipeline.createHandler (mappingResolver store) + Pipeline.createHandler (logPersistor store) |] + + // ** publishers + + let private publishers (store: IAgentStore) = + [| Pipeline.createHandler (createPublisher store.State.ApiServer) + Pipeline.createHandler (createPublisher store.State.SocketServer) + Pipeline.createHandler (commandResolver store) |] + + // ** postActions + + let private postActions (store: IAgentStore) = + [| Pipeline.createHandler (processEvent store) + Pipeline.createHandler (subscriptionNotifier store) |] + // ** forwardCommand let private forwardCommand (store: IAgentStore) cmd = @@ -599,10 +605,10 @@ module DiscoService = let private dispatchEvent store pipeline cmd = cmd |> dispatchStrategy |> function - | Process -> processEvent store pipeline cmd + | Process + | Publish -> publishEvent pipeline cmd | Replicate -> replicateEvent store cmd | Ignore -> Observable.onNext store.State.Subscriptions cmd - | Publish -> publishEvent pipeline cmd // ** createDispatcher @@ -669,14 +675,14 @@ module DiscoService = let private persistSnapshot (state: DiscoState) (log: LogEntry) = match Persistence.persistSnapshot state.Store.State log with | Error error -> Logger.err (tag "persistSnapshot") (string error) - | _ -> () - state + | Ok () -> Logger.debug (tag "persistSnapshot") "successfully persisted snapshot" // ** makeRaftCallbacks let private makeRaftCallbacks (store: IAgentStore) = { new IRaftSnapshotCallbacks with member self.PrepareSnapshot () = Some store.State.Store.State + member self.PersistSnapshot log = persistSnapshot store.State log member self.RetrieveSnapshot () = retrieveSnapshot store.State } // ** makeApiCallbacks diff --git a/src/Disco/Disco/Service/Interfaces.fs b/src/Disco/Disco/Service/Interfaces.fs index ecc0901c..6237976d 100644 --- a/src/Disco/Disco/Service/Interfaces.fs +++ b/src/Disco/Disco/Service/Interfaces.fs @@ -109,6 +109,7 @@ type IFsWatcher = type IRaftSnapshotCallbacks = abstract PrepareSnapshot: unit -> State option + abstract PersistSnapshot: LogEntry -> unit abstract RetrieveSnapshot: unit -> LogEntry option // * IRaftServer diff --git a/src/Disco/Disco/Service/Persistence.fs b/src/Disco/Disco/Service/Persistence.fs index cf13bc46..d7faebb0 100644 --- a/src/Disco/Disco/Service/Persistence.fs +++ b/src/Disco/Disco/Service/Persistence.fs @@ -76,7 +76,7 @@ module Persistence = let! state = Yaml.decode data return { state with - Member = ClusterMember.toRaftMember mem + MemberId = mem.Id Peers = Map.map (fun _ -> ClusterMember.toRaftMember) mems MaxLogDepth = options.Raft.MaxLogDepth RequestTimeout = options.Raft.RequestTimeout diff --git a/src/Disco/Disco/Service/RaftServer.fs b/src/Disco/Disco/Service/RaftServer.fs index 96545341..cafcbc1b 100644 --- a/src/Disco/Disco/Service/RaftServer.fs +++ b/src/Disco/Disco/Service/RaftServer.fs @@ -238,12 +238,7 @@ module rec RaftServer = (callbacks.PrepareSnapshot()) member self.RetrieveSnapshot () = callbacks.RetrieveSnapshot() - - member self.PersistSnapshot log = - log - |> DiscoEvent.PersistSnapshot - |> Msg.Notify - |> agent.Post + member self.PersistSnapshot log = callbacks.PersistSnapshot log member self.ApplyLog cmd = cmd @@ -484,14 +479,14 @@ module rec RaftServer = if RaftState.isLeader state.Raft then // I'm leader, so I try to append command match appendCommand state cmd with | Ok (entry, newstate) -> // command was appended, now queue a message and the later - entry // response to check its committed status, eventually - |> AppendEntryResponse // timing out or responding to the server + entry // response to check its committed status, eventually + |> AppendEntryResponse // timing out or responding to the server |> Binary.encode |> Response.fromRequest raw |> fun response -> Msg.ReqCommitted(DateTime.Now, entry, response) |> agent.Post newstate - | Error (err, newstate) -> // Request was unsuccessful, respond immeditately + | Error (err, newstate) -> // Request was unsuccessful, respond immeditately (state.Raft.Member.Id, err) |> ErrorResponse |> Binary.encode @@ -561,6 +556,7 @@ module rec RaftServer = |> Binary.encode |> Response.fromRequest raw |> state.Server.Respond + do Logger.err (tag "processInstallSnapshot") error.Message updateRaft state newstate // ** doRedirect diff --git a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs index 00de5a7b..b7136d8e 100644 --- a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs +++ b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs @@ -24,9 +24,10 @@ open Common module AddPreviousMemberShouldPull = let test = - ftestCase "ensure previous member pulls from leader" <| fun _ -> + testCase "ensure previous member pulls from leader" <| fun _ -> result { use configurationDone = new WaitEvent() + use snapshotDone = new WaitEvent() use updateDone = new WaitEvent() let machine1 = mkMachine 4000us @@ -36,7 +37,7 @@ module AddPreviousMemberShouldPull = let mem2 = Machine.toClusterMember machine2 let site1 = mkSite [ mem1 ] - let site2 = mkSite [ mem2 ] + let site2 = mkSite [ mem2 ] |> ClusterConfig.setName (name "Ohai!") let! project1 = mkProject machine1 site1 @@ -68,6 +69,7 @@ module AddPreviousMemberShouldPull = | cmd -> Logger.debug mem (string cmd) cmd |> function | DiscoEvent.ConfigurationDone members -> configurationDone.Set() + | DiscoEvent.Append(_, DataSnapshot _) -> snapshotDone.Set() | DiscoEvent.Append(_, CommandBatch batch) -> updateDone.Set() | ev -> () @@ -87,7 +89,7 @@ module AddPreviousMemberShouldPull = SiteId = None } - use oobs1 = service1.Subscribe (handler "machine1") + use oobs1 = service1.Subscribe (handler "TEST-MACHINE1") do! service1.Start() // ____ @@ -106,7 +108,7 @@ module AddPreviousMemberShouldPull = SiteId = None } - use oobs2 = service2.Subscribe (handler "machine2") + use oobs2 = service2.Subscribe (handler "TEST-MACHINE2") do! service2.Start() /// _____ @@ -119,9 +121,10 @@ module AddPreviousMemberShouldPull = do! waitFor "configurationDone" configurationDone - printfn "leader1: %A" service1.RaftServer.Raft.CurrentLeader - printfn "leader2: %A" service2.RaftServer.Raft.CurrentLeader + do! waitFor "snapshotDone" snapshotDone + do! waitFor "snapshotDone" snapshotDone + do! waitFor "updateDone" updateDone do! waitFor "updateDone" updateDone Expect.equal @@ -129,6 +132,26 @@ module AddPreviousMemberShouldPull = service2.State.Project.Config.Sites "Cluster Sites should be equal" + Expect.equal + (service1.RaftServer.Raft.Peers |> Map.count) + 2 + "Raft peers of Service 1 Should have 2 Members" + + Expect.equal + (service2.RaftServer.Raft.Peers |> Map.count) + 2 + "Raft peers of Service 2 Should have 2 Members" + + Expect.equal + (service1.State.Project.Config |> Config.getActiveSite |> Option.map (ClusterConfig.members >> Map.count)) + (Some 2) + "ActiveSite of Service 1 Should have 2 Members" + + Expect.equal + (service2.State.Project.Config |> Config.getActiveSite |> Option.map (ClusterConfig.members >> Map.count)) + (Some 2) + "ActiveSite of Service 2 Should also have 2 Members" + dispose service1 dispose service2 } diff --git a/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs b/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs index 74ff111c..368ea13f 100644 --- a/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs +++ b/src/Disco/Disco/Tests/Core/Disco/RemoveMemberShouldSplitCluster.fs @@ -30,7 +30,6 @@ module RemoveMemberShouldSplitCluster = use appendDone = new WaitEvent() use pushDone = new WaitEvent() use removeDone = new WaitEvent() - use updateDone = new WaitEvent() let! (project, zipped) = mkCluster 2 @@ -38,7 +37,6 @@ module RemoveMemberShouldSplitCluster = | DiscoEvent.GitPush _ -> pushDone.Set() | DiscoEvent.StateChanged(oldst, Leader) -> electionDone.Set() | DiscoEvent.Append(Origin.Service, AddFsTree _) -> appendDone.Set() - | DiscoEvent.Append(_, UpdateProject p) -> updateDone.Set() | DiscoEvent.ConfigurationDone _ -> removeDone.Set() | ev -> () // printfn "ev: %A" ev @@ -109,9 +107,6 @@ module RemoveMemberShouldSplitCluster = Expect.equal (Map.count service1.RaftServer.Raft.Peers) 1 "Should only have one peer" Expect.equal (Map.count service2.RaftServer.Raft.Peers) 1 "Should only have one peer" - do! waitFor "update project" updateDone - do! waitFor "update project" updateDone - let activeSite = leader.State |> State.project diff --git a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs index c0732ac7..797aee13 100644 --- a/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs +++ b/src/Disco/Disco/Tests/Core/RaftIntegrationTests.fs @@ -64,6 +64,7 @@ module RaftIntegrationTests = let! leader = RaftServer.create leadercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } do! leader.Start() @@ -72,6 +73,7 @@ module RaftIntegrationTests = let! follower = RaftServer.create followercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } do! follower.Start() @@ -110,6 +112,7 @@ module RaftIntegrationTests = use! leader = RaftServer.create leadercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } @@ -128,6 +131,7 @@ module RaftIntegrationTests = use! follower = RaftServer.create leadercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } @@ -186,6 +190,7 @@ module RaftIntegrationTests = use! leader = RaftServer.create leadercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } @@ -196,6 +201,7 @@ module RaftIntegrationTests = use! follower = RaftServer.create followercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } @@ -238,6 +244,7 @@ module RaftIntegrationTests = use! leader = RaftServer.create leadercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = snapshotCheck.Set() |> ignore Some store.State @@ -339,6 +346,7 @@ module RaftIntegrationTests = use! leader = RaftServer.create leadercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } @@ -349,6 +357,7 @@ module RaftIntegrationTests = use! follower = RaftServer.create followercfg { new IRaftSnapshotCallbacks with member self.RetrieveSnapshot() = None + member self.PersistSnapshot _ = () member self.PrepareSnapshot() = None } From 3cdb59ea8187602cbb8056ded1671cfbb3f6b85e Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Thu, 22 Feb 2018 12:17:39 +0100 Subject: [PATCH 22/27] add another wait to circumvent cases that cause test to fail --- .../Core/Disco/AddPreviousMemberShouldPull.fs | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs index b7136d8e..849c00fa 100644 --- a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs +++ b/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs @@ -52,22 +52,17 @@ module AddPreviousMemberShouldPull = do! FileSystem.copyDir project1.Path path2 do! project2.Save path2 - do Logger.setFields { - LogEventFields.Default with - LogLevel = false - Time = false - Id = false - Tier = false - } + /// do Logger.setFields { + /// LogEventFields.Default with + /// LogLevel = false + /// Time = false + /// Id = false + /// Tier = false + /// } - use lobs = Logger.subscribe Logger.stdout + /// use lobs = Logger.subscribe Logger.stdout - let handler mem cmd = - match cmd with - | DiscoEvent.FileSystem _ -> () - | DiscoEvent.Append(_, LogMsg _) -> () - | cmd -> Logger.debug mem (string cmd) - cmd |> function + let handler = function | DiscoEvent.ConfigurationDone members -> configurationDone.Set() | DiscoEvent.Append(_, DataSnapshot _) -> snapshotDone.Set() | DiscoEvent.Append(_, CommandBatch batch) -> updateDone.Set() @@ -89,7 +84,7 @@ module AddPreviousMemberShouldPull = SiteId = None } - use oobs1 = service1.Subscribe (handler "TEST-MACHINE1") + use oobs1 = service1.Subscribe handler do! service1.Start() // ____ @@ -108,7 +103,7 @@ module AddPreviousMemberShouldPull = SiteId = None } - use oobs2 = service2.Subscribe (handler "TEST-MACHINE2") + use oobs2 = service2.Subscribe handler do! service2.Start() /// _____ @@ -127,6 +122,11 @@ module AddPreviousMemberShouldPull = do! waitFor "updateDone" updateDone do! waitFor "updateDone" updateDone + // we have to wait here because under some circumstances (when LeaderChange happens, and new + // leader socket gets created and local state is forwarded to the leader) CommandBatch gets + // sent 3x rather than 2x causing the next expectations to fail. + do updateDone.WaitOne(System.TimeSpan.FromSeconds 2.0) |> ignore + Expect.equal service1.State.Project.Config.Sites service2.State.Project.Config.Sites From 130528d1d943e7630cd315f1eee55327200d547f Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Thu, 22 Feb 2018 17:27:46 +0100 Subject: [PATCH 23/27] rename test for clarity --- ...fs => AddedMemberShouldHaveCorrectState.fs} | 18 ++++++++---------- .../Tests/Core/Disco/DiscoServiceTests.fs | 2 +- src/Disco/Projects/Tests/Tests.fsproj | 4 ++-- 3 files changed, 11 insertions(+), 13 deletions(-) rename src/Disco/Disco/Tests/Core/Disco/{AddPreviousMemberShouldPull.fs => AddedMemberShouldHaveCorrectState.fs} (89%) diff --git a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs b/src/Disco/Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs similarity index 89% rename from src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs rename to src/Disco/Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs index 849c00fa..e6302629 100644 --- a/src/Disco/Disco/Tests/Core/Disco/AddPreviousMemberShouldPull.fs +++ b/src/Disco/Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs @@ -21,10 +21,10 @@ open Disco.Net open Common -module AddPreviousMemberShouldPull = +module AddedMemberShouldHaveCorrectState = let test = - testCase "ensure previous member pulls from leader" <| fun _ -> + testCase "added member should have correct state" <| fun _ -> result { use configurationDone = new WaitEvent() use snapshotDone = new WaitEvent() @@ -63,9 +63,9 @@ module AddPreviousMemberShouldPull = /// use lobs = Logger.subscribe Logger.stdout let handler = function - | DiscoEvent.ConfigurationDone members -> configurationDone.Set() - | DiscoEvent.Append(_, DataSnapshot _) -> snapshotDone.Set() - | DiscoEvent.Append(_, CommandBatch batch) -> updateDone.Set() + | DiscoEvent.ConfigurationDone members -> configurationDone.Set() + | DiscoEvent.Append(_, DataSnapshot _) -> snapshotDone.Set() + | DiscoEvent.Append(_, CommandBatch batch) -> updateDone.Set() | ev -> () let! repo1 = Project.repository project1 @@ -76,7 +76,7 @@ module AddPreviousMemberShouldPull = // | | // |_| start - let! service1 = DiscoService.create { + use! service1 = DiscoService.create { Machine = machine1 ProjectName = project1.Name UserName = User.Admin.UserName @@ -95,7 +95,7 @@ module AddPreviousMemberShouldPull = let! repo2 = Project.repository project2 - let! service2 = DiscoService.create { + use! service2 = DiscoService.create { Machine = machine2 ProjectName = project2.Name UserName = User.Admin.UserName @@ -106,6 +106,7 @@ module AddPreviousMemberShouldPull = use oobs2 = service2.Subscribe handler do! service2.Start() + /// _____ /// |___ / /// |_ \ @@ -151,8 +152,5 @@ module AddPreviousMemberShouldPull = (service2.State.Project.Config |> Config.getActiveSite |> Option.map (ClusterConfig.members >> Map.count)) (Some 2) "ActiveSite of Service 2 Should also have 2 Members" - - dispose service1 - dispose service2 } |> noError diff --git a/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs b/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs index 25906995..5b41c5d1 100644 --- a/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs +++ b/src/Disco/Disco/Tests/Core/Disco/DiscoServiceTests.fs @@ -41,5 +41,5 @@ module DiscoServiceTests = PinBecomesDirty.test StateShouldBeCleanedOnClientRemove.test RemoveMemberShouldSplitCluster.test - AddPreviousMemberShouldPull.test + AddedMemberShouldHaveCorrectState.test ] |> testSequenced diff --git a/src/Disco/Projects/Tests/Tests.fsproj b/src/Disco/Projects/Tests/Tests.fsproj index 00029bbf..cac1f139 100644 --- a/src/Disco/Projects/Tests/Tests.fsproj +++ b/src/Disco/Projects/Tests/Tests.fsproj @@ -112,8 +112,8 @@ ClonesFromLeader.fs - - AddPreviousMemberShouldPull.fs + + AddedMemberShouldHaveCorrectState.fs RemoveMemberShouldSplitCluster.fs From 01560d9fc75313ea7ed6c7bdcf354258b2e379ed Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Fri, 23 Feb 2018 09:25:41 +0100 Subject: [PATCH 24/27] add missing field to logging initialization code --- src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs | 1 + src/Disco/Disco/Raft/LogEntry.fs | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs b/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs index 42a5d98e..150347dc 100644 --- a/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs +++ b/src/Disco/Disco/Nodes/Nodes/ClientIdNode.fs @@ -67,6 +67,7 @@ type ClientIdNode() = Tier = Tier.Client UseColors = false Level = LogLevel.Debug + Fields = LogEventFields.Default } self.OutClientId.[0] <- id diff --git a/src/Disco/Disco/Raft/LogEntry.fs b/src/Disco/Disco/Raft/LogEntry.fs index 05d9fafc..479786d9 100644 --- a/src/Disco/Disco/Raft/LogEntry.fs +++ b/src/Disco/Disco/Raft/LogEntry.fs @@ -871,15 +871,15 @@ module LogEntry = let rec untilExcluding idx = function | Snapshot _ as curr -> Some curr - | Configuration(id,index,term,mems,Some prev) when idx >= index -> None + | Configuration(_,index,_,_,Some _) when idx >= index -> None | Configuration(id,index,term,mems,Some prev) -> Some $ Configuration(id,index,term,mems,untilExcluding idx prev) - | JointConsensus(id,index,term,changes,Some prev) when idx >= index -> None + | JointConsensus(_,index,_,_,Some _) when idx >= index -> None | JointConsensus(id,index,term,changes,Some prev) -> Some $ JointConsensus(id,index,term,changes,untilExcluding idx prev) - | LogEntry(id,index,term,data,Some prev) when idx >= index -> None + | LogEntry(_,index,_,_,Some _) when idx >= index -> None | LogEntry(id,index,term,data,Some prev) -> Some $ LogEntry(id,index,term,data,untilExcluding idx prev) From 709f1822ba17ed332f3ffc6f76dc38e7569d0a9b Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Mon, 26 Feb 2018 11:26:11 +0100 Subject: [PATCH 25/27] update Paket --- .paket/Paket.Restore.targets | 4 ++-- .paket/paket.exe | Bin 59688 -> 64296 bytes 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.paket/Paket.Restore.targets b/.paket/Paket.Restore.targets index 830e5699..e7c1bc0c 100644 --- a/.paket/Paket.Restore.targets +++ b/.paket/Paket.Restore.targets @@ -53,10 +53,10 @@ - + - + diff --git a/.paket/paket.exe b/.paket/paket.exe index e441f7c29b1455b61b923fee5b38c005d5716006..b98e000b232408fe0a21730e88f89755f0d7a68c 100644 GIT binary patch literal 64296 zcmb@v31C#!^*?^zdoyp6$xcFsgg_>Qgvn%)MGzE`071eI0YO~CkPI-If)8c)^OcaJSPLZ_3LHPSm1Twh%2fEc)m-pWEQ| z_A*VN9Ah%k??4GE>gEse8RoKq-?^%6D!rL%GvJ@Os0aP^JOks}cmYwN{FnaJsN$v) z$Xy|2gT|zUfbbeoWHdg*2Ib=8#Se%ogzvuuVWO-I)-2$QGVrFp_>Ml{T`vHjPR0to zGk?NF8=Ksu+X14|4P#@WFJ^LyHRd+C@h%69tSjrxHlSCB@y#1dflh2!{IG5&`RUYC zhz4#T*v=$~%e08_{U=a7*`&E(f(AuC=YB|tgfNLUjdraIT5r&5%(Gp1TyJCy==HWQ zf*H1R%z!fopJqVVo!KZyizoZ2S`DQr2`P5ai~z0A@kd|y$&(=)*?6 zQEEF7YiIeH(YCD!da~_&pR|i$G&VYfuiFi-UBk`n(8luFtmv5kCs}5Jf~& z5!^U_sNlw2MF}|zrG+yIA1*ZPbsO1sVMvWsu?7LVObsAPZ2K#dYm*c3+5{X-JH-8FXq%7& z-?F37i}kC=C+4Kca^GUcJXF;*=GIznwxQ9XYVf%H;!~J6v`bBR&>r1%6o$t0W?FV= zz2!`RMeLI?rJ$)vv}}*+Oau)+Wzj>>fqyKw2A%R;2OEl0HWFGbXi#c?s-8Pi_7a-Z z*O!}vdJeH&3 z=Wr_6WoNpjMpToKGmoY0S&v{@(-^AVvkryBcA-Ib5?&Ro8Q_`-e6=2?A8*-e0H*C; z1c{M4usE2#pq}5`GP@DP>xQS<+H>;YZi>>~aE){Wrb)*QvdoQ{f`0j}Y& zQy)17c+LSB)wZ1ilwS-)$-s7GLh|wR)y~Fi0&_3%QmGSkpM?5$BpV7uX0iy=`60>y z37AmYlGPf?2TdY^j9#rTi_n1J9Yx7vXcV-q-H7Ktv!T{>WxVgu`HcL!N2x zVixB(R7Xo>eZXIMn<+|;)-p~N8Iw&8%R!D|^$=7#SkNd4Vm=PzLFWV|ZJya^OW2Q^ z>^{LLjm28N2l6qxA~VtqT4TBU3I-gy46(qdDK&42oW>)AU-w2S30;Cg%XAQm5b$kh zKJWvaNw zmH;|S0WQS~F(S)QlBtAO@%Z5#k>&Wbqqmw4+%D+802SP~0i2aU5e8QAhZQM?%Fb$( zqfeNTHhlJB12bwA>l)xSA!jXrn2PlzE|)o2?<($rg%vI`lUVU^>QP1n((Hz!fbC$2 z&ElM}3ooDS$V1LNRTx0Hvtj1h-w1wpi>2@e;IT3vB0isqKdPdwTW4GJH zJr8gVX9D$mph+fAIrDS~57+G3IJkOjx|(ZvrPa&&A4N_atr~OOZm5ymjPlv0-}xTY z$dN#hn-y@jfEw8f;C=^8dlD!)X8`26cLDd@*w$|R5@?<~W#3X0@+-QXtzu2F??6e~ znF9?-IwVpQ`LLjspM90qe4zZyq#LQzFffHgO>VJ|dI#X$zUYHyXm zvm<3(wi2|97`A}$AVEbW09Jph3Q#M2T!@0o z9OD;&4|Xatog|3C`WbshVd%DlGXNHv(~pmau>ofrK3&B3US~T>&JG4U0T4f>o!$5( z$7qwLK^}}#WI1PZlc{K;f{JN7-^BPDOdAVm7wQn=Re?7*8zEj|FjQmZq0cu!4VrfH z9PkPYqGi6jo(1wcEXh5v1j#wCfxPVGZZH-5ihPlyfae~VQsiq0AkWAA24Bo>u(MUE z*zaD4_TE}3(oPRilm&Yjm;jTeQ}6_JTrsJU#xL<=Dbd=sG?ruOVz(-fdMmS&dmw&* z?WJ@_j3e||6vAAdiz;UTAh{P{PYIYJpFt^jpd!azhvuFV0p~oBRV+V1cB5%ULziLO zfE&3Ff$tWJljVA-r(={!<0`3w_28Jk6m+&X0vSw??8)N2*$yTzfYci2LO|2GC{?zd zi&N!N=d)7Y2UuIx=zGes}?QHT7Y;A;+wopmeLx4K!xM{d6z6rFr!$tt=%yP!y;c z49XLxjW@GHkr}XRX?k>KQ9z3-HnU5;T923&TA!Px#yIshGuxJWyCFNJfb2`lVNZBZ zQTS67lAni`m@60@>%TJKz*<=TVy%X3j8}DMXL0(5aEysS27e%!j?K2pZj_(!+OI!e z`7WPVv4hHw4`a(R&BdYhYeG?Tap`2UH0r|`r7nwOrw05)W|H1x^ZWA!(5)}X-Dz&DxpVJLPBW0Ode{A)WoBSo}U&> zZgU!)Azg^$ObeCf!jdOIGv{i6fO8FCZGEwH;S1%}XQ$eE?xgxW;lxir{WPl~1W$o~ ziLo*T$ySCONbM<7z@CClP!Xg60@5`_kOBxuJQP6+AdL42QUIaSBS-;+ut$&r2vr_I z3bJky)(CEey!K3t&kS)cYMYWFL=gXNa}*sOjg4rm&6y$JZ>W6%%_z0=38POn^+#rN zGhAQHkxzdF=`e6RGFLtWkwx;ErR4RP&KJ>fBn-fZYSa0WhoUb(As>_&=6;No&v_^g z2;(y+1IfFQYmD* zdHK|9sWBq>2K5jSCG8M4?yrE<(B@WwDd5}$B;ec(sIu-`P?EG)64+cbfK%oQSfC-0 zl`V;EmP%x^e9l+FYVNAW=n$&D1_VPBJrJ5?Y-Z$tSlX=syO~YT9cR1PN!=5mfE`)M zGvl_V%F)yJOaQOQmE#Oz^VeB;Q*sqp2e>j?zGotTj5i15b82J_s>%-gN)H>+dDwbx zM}x}T5a-f%G-{@bsk;0zsXDK?T(^sS1C4d{3^Nm(qdCTxsm8UYS6ZCeHi8Maqf=E= zg)9^WeMcEMXDiC-BG`(26P=k6#GRlN;eR$wHIRg19+Q=DqG0$P?BS99;Mh}xK|9|@ zspPO7M<>beaJ%mUBw-?44o2=^!kqvCmC~9Z%k^CZ$pDVVQvf5!0^}moO*3cleS^Kb z1M=-%44p9WhMYZ|H%B(29MyCL4_jnuyq58N_;o|XU5iQd(g^o^JfljM@VHP)Wfhu= zjKS7LL=&%w&|^oo0OYy%LqfLm8WZm3VV#arc1Gg>4%fKBwUgiD+Rdni1M)cu`Vyog zXM?lY4eQixkaIjsY6fpZ%OLxGAEXQxlP|#R$k7b$LDhj!(0wUmWH_;`L)`(2@*M?6 zPU99)2>l`dF$um+WxNK*79e)Wyxt2T&V2xKWt+a!4Tf^GK4rGdUj!3v=en(EnHBi~ z8kFV)LP>FeEqw5`-SaYNx&<3q zAKi9|UP=&?9e69I_4bTL*%DS8t?YWg`xfY`WvCclnChRCCbc(Iv7Q^lVL3&4 zYS80GWwgjU;&|OeCZ9fkD9O2=KqAU2Zy*`?}B z+`Qtn=Gn^8R2!Mh6EkX$Eb26fvUl-Ha2~+~zl7*X#rdJ)0(+QKA^_Ws+qAji4R%8! z11TLLM^Qoi#5iRCe-u;Lar|c?5B2SqI!DcBf_po3CSV6iZc^e4B~769AK+NHN8h<7>zXicI**;8Q11D}QxMfCxP8wHa-#Hgr=ogHf`I8XzN@tsR8 zfAXD+6hN5d5u^Y@#3M)nggTEP1rQK1l?*9>Q120>078RDkb>kbcfzt2u$|S9Kx_u> z#zNN~jVs3W07)z_Tyo(G;!F(57T7deVY#@|6+#5dH5d&z-NM36D)25kxqvaV0SHo!os=<#kBk7KX6qUT&q^r>{|ERvgm%)uTsGedT!d;{g z?x)cztw+AbMdxV@GgX;PS8{Q1B`cs?a&d4aE37NIs4C(A@NJv2p%l`rqV%0$Bi{+u z-{|}py$5l)NS#5N6fGxkc_J6bkkFJdIC2cF1$}ZrroDdj2-TtM^3;xpJFu+M$rx-_ z0Oyxy(3jH%oG1z}G_s^j`^iigMmRUsE%+(aR7awv+feMS6gf{$q0D+6D(Y7R5*_l(nkbI%TMy_f3vN+Nh zp~yk-<{en>{1KnwFa-vh%){k&qb)fkPNA=W9;ghi5C0j7O5{~wIk;7BxJRYndyvlf zB7Xw4@qgS$c_qDu^4a|Cun-;N>1wEwnmD(qwZ@c1zRcr1)+!50$$1^T7H)eqNQx-!wDQb1W8a=(lWsC5)RIW6~O->B-EKZtC_AuI4=2{T^tkd>dIdo-3cm z%|x`%c>rZ>oJzs(0pVwj^P%;~4+zT^Hz5Lf2aZjLt7&80 zuX@tFmaJ|)Rt+A<>jB&iih68{(4_t8Hp>34vJ25E)bSwkrL%z>LyiiTToZto?`5$i z(InU`c@$y~ziV<9)|(P7OV43nvn5~JjTB~3)jg=fZPihjV7X3~i)38yU>mZN?}5s@ zKz#(!vR>XDy9 z<2`9N_{M>6jDEIg$x7d|13k*iSKCoIY)|7+!gSczxrR67dRXHe$WepG23)@f*C?5d z@T!-c{HHYH8h*#4p0`N6w&lHLWAjsDRz-9^KBe<>pt}1oN@pKRc-kAmzGm+^dvFKS z(^_#2$2z{&hb%v>9xUtClq}nJmsUXVM^J3sdfPqKL&gKis5#mB7#yi|JFJrN&~@5w ziy=P(yOjpzK~_$Eqg|P^K4`f;kY_vpLfc%+&a#!5yg;_Rw$~Uy;cC=buAAbk367rj zC|mnjDj|`Sg8vw6Id^e?1 zwk?QzJhwO%=sab>JZez0eqh?{98=luVj96S() zt?=ySH1V@kZasyT?V%Id&)_MTUgarL0O2@~AO#R+dju(ffT*dONa6FTEdg5!ZwUy% zw&{<2#2q3)mqBC+;>riyDDp9&b1y){S;>Xq z$jf%kYU2TagU~ zghd{oaOBkQklj(KkerK3dl&15OIxQISTXwl2fBl4_u(V;n$;h4NLRo7Qfr=TYlG34kJ}dU>LQ*M)-N zFTgg_ie0=+tjAguNa9{Ccs3sS2*VZ3Q0{)089)o7E^-TICdH>-?vTfVhs(9b$lC8< z`?!BYv-BaX*stsTsclZo7;=69ZhfBn9TmPoJEvg{^W1%&yXQECMWYV$*!Q^6k@r1* zdp5((alOs6oa-KjE_vQ8BjWKa=elzydLzfA4xVLiMq$?Pqeq-Y)MV*VWUl6wN1Eug zc-1y*(DW5$>7%C%3D3{`YNG2W3}Q=h@d5>t-kjMC^70kiy2z)Dy#wQs{J7Xo@9@O| zZ8SImZ_RodU_{0;HuJHAHgo9!Zvrz@dT#Y>d3*a@BeK{#-Jm7;{OTBucnHSm46lR7(HU-HrcYvj#ljkL z6C)JwCWck=Y;iLB!1)HY;F00=vQU%;+2u|M4!YYR*E52B=?o~Ow3fTFQE0)fyVztw zRt%R|{@M_3vN(O#d0Q?mTupu+3$MkQp!1LF%X02QHwWr!-3Kx{QWjB$K9E=IPKv-C zPi02DTTr3e=jT%e%VaD+N_p4;aK_YD=hHBro)y3x1M7IuQ!V*2iX^zv8J3%X#Bv8; z@e4+06d3MjxdXgK4$Ly;>kKksf}vlZ!kUs}SRf|N7hPx7#U@iUWcB? zF=LDwuW>&I;Z_8?1l_Apbgu=F7rx!EaJTp#4X!3lc_Sp!$%;!pipKKeewCX`redl` z-w%ODqGx11N~S!xH8b8O_$H{0flvhBoI(0FteOw;X8I8@l%2@RZe?Z5Bcr&{W_=fI z?LGrkd>H`5-CfMUd7pYu-zUDq^+CJxlO~@Xniix32oZIV_M*C{H1Q^>S~q{M$K2J8kK6#B^@f@jmj(~?o1;~aS>~=DR7Gxsu6+Ct?(PL@R(_(YcQGdK zGw0#5FMIcyTp5zOQ1HM}Bk^T7KBrVOOGFlWgRYZUSG8wgJao}TO4lAw59tW6qpA)I zpa`EHxVvb15?_P~o-MHo>x!^6^tdVyPa9+IVsnY%rsbHWO6_2Maj9Ih;&>rLm&;a^ z9q{hv0rTM`(g>yaJ!OM)Ksp9;EqONr@06Vdo(8<7flq!(b(ae~=Rm%VoAp``!_rgd zCEQ_7#0y(k7fs2jJjL6=9gV83oL>kFTD&g!O9&3WsKbu{cI^U-x$7K2=db7^dbYU> z<_C$7Gv+Qn&6v9excY6bMvJ{d;!}$AjwYQar1P2dE|V6T>GOnp58Ro*egY%nD=E7# zWL{*ZWwr9wm3%SK!8e1{7d{^W^X`klqSge?_xk-q(9K<3VeVoHvK(-yl54w-by!n( zLpZ(LJoo&FYb!_4i7%3FJQ@tN-?&ADf-a4ETLX=2h z@7Bd5hWloOtscJidPdQ>Vkn1eF#?=U9?$N&?BVgR#zQTa2tj zLY!PcZacbZa?`ZQ)27TqCBC%>AEUn@h*x8F)?;D)8I7vj`rJg%mLzk`-AMFx9Qdo( zw$YzItG>5fed5~I1*rQc@QX*GZeEwOiJ9?Z!dKQ+-jb7@59A|b8oxBjy~7`Pub`{& zi;S6YiWPk@6h3>>|KJyX%I}=Zd6?z#qDOOS@5d+nP|C=#@v|Bsg@0`NZP9h(Y>JO! zc&ETqi(=!7=?4hzHnj?+w`k!Qn=Tl|utDG{b*w)~onvO$ zHXU8pP-WBIpxAVZ#kDv4{)+E(HA|0mKBhb|x)ilP5jekW48E^XRdZf-kiJ;UFgwcd zr4r`+Xbf|{H@4J&BDFxbAhk?-D{Rv@%S+K?xP;4-P`2sI0>2sJR>zexe4zZTTAOYa zO(y$TL;q-&TmkvuAH_V^RdDaEB{A3`6lTiIF$_N|nx6tWL3(Zs^JnEUeT~qM$!EG% z$n+0`-1}`+3~vx^e~wz4E|T$vrPZ%0*d`^p3?GD@ZCY%Ov7gn~UFvCZs-%%L5P3M#|qzblYXZc&Scab$3$M%L-j5l}@*m1)%Pc|dD4H;~8oITL9ilRdID8;T0kPiIb*%sO@PtzO zL+EZTfXS!|VKK!N<-Po6MHBg#tfU$`npP#tMKJ(g{^umyI`H8M`-^u_D}c zvXp;}V{8;|VHk@`yAqsraL}gL>#iDmE#5btA$3npV9s)2EM<|#aESrzxhU67pk>6m zbc|+fBCU~jzZ0wm-{t3ad&{}57H^a=c5VSpo^ z3*1-G$o_mcE+GtOgMMZ48a~0Y&Xpm3<%oorDFw~D%g26 zTQFoAsJnpX7=Bpktg(z;h(CbAGQTaHm(c>jevGYQI$cf+GkX6VwHj>$?Rn3bZ39j< z!|pPMUkx$L7B~a2ls>F|##}XUXyP-ttGOZTL7WpV%zhN`xvVDu-xK&?fXlZFJTL2M zlur>D$$mC>3SFQ7TyERIYrbd9DRk@D7jtbp>_3=$(!kW3M*+ii3`3(CE)TNgcLLnk zLs<;3wi#B7gd| z$vzCYUgY$Na0s<04ZK{yaLFWwP9ejoH4H1Iyeo&x69j%4GdQ^I`9Y?%VIDm>ir*Az zU4S#_1z#kulrA+I0Y~HSbCgnursrXYL9K$!b3Ewtjd_3{m`eb2d`n=B7kq0_-bp8e zKUoz6JPo6;WkiUel@I3H^mJ8RIL`p*B4VqS74cjgTg#R_2cBS4OPG&y75Us_2+*Jt ztt8|;QSbz6r%buJu*{Qz=o>^ZiF>f4eXZkr|5Upz(IkJ0D5|E)b_jzIvnpi z8Sv`@ZxO9tvA&eIGK__ZztZto_01UX4T4=mxmDlD^U+VLRNb!1hw`$i3lW1kcaMKE zFNeOSvCAg>JTH&l5$r0u9asVV5HXNByC(b&e*3S93VS*DC%kf8Qll`pWC^~T#P6aq z=hv#=%o|O2XsoLEU1<6fjomZppE!*d)+)|>CViS$PN!=uCua%XB<&UKD*8vMoj;CN zPGZih=>4_` zB%EJM_af_so?}iL7schk8hu@B1M%sZBDXyA5g9*(2$DvVlc zF3dlUCi2mNuAwiNeIfsNI!7?Yc>-ObFnW62m-A1cpJ?oT|84p6=;bEWF1zG(V*xEa zim@x{`ElRLZ=t&dyM|f{@5^6A5AgvScKKELexsG1)YyUYLTaUFHFkOReq%8`ud!>Z z3u!SO)Yxgk{l*eHq_OT`AuXZ5X>3Vh1-{e!k;YCfEHRgoHAVHeF|^-UMmZYe?~N>@ z5{=zZP=W8lRA}suf)aB%)o5%>P6aZNMvZOHDKS^j42``v{?YuEG)H4Ol|KfyNMYjF ztLU5*_N)9=^b^6Zr1wTGp_A#)g6*Xr)+UV&w3O2Tecja66Y7If2;6ox+oLURPWl2+#x7xdCfjrj}46(nh^#`;QY3i|2mI8n1_-RiF| z*hUj^!NXXMJ*8kf4G4A(JzhMkU?+X;SgyMU?+Yy~*iBJRs=@h?e?`Fn&DNODURUrL zI#pp3moA{Kf?b$(dc}8;h4pG|YlR=!PL17-x(jKq#vVl7g|ts&wI$y{w*7gHO)kNc zL%LpLT?L&57t>cYwyPik>{}WeKYG9MS-M+e^`i^vv-E(*KFHp0?4uuPEC)WnkA9}H zS5S8e{Z?adWf#&V^s->D8Ml`?1((uI$Me{qp!>sp1((s7ISRWW_#NbqKNRd5+FiJ_ z;BxxK30$XQ^5^IUg=Ot5-EVx34r=WD(n9(iy`i!0y#2-%^f!%d%PYiv;>Q}hxcuCL zE6JKGGPABKzX({aVAs&R!Yc|sPu~(u>3P+l-oHTSH*>pdvZ^OtQ}6}4TVqX=ZU**4 zjg6hOJa9F$;pYke+r|5gG}f1!Z(c)B38xy-m+1F`?alJl>@WBdy`r&#nmd90MX=Wl zmU1m+&10Dt(ygQKEx3-B3ig`8GOwpC8oQ)!zi}h=XzYy%m)JMbHjT~Ad$8ckG@!9d za|>~Dx>#d-bMGyYyTj`q`>&*XA!Pn_tjkT2& z((QCWW4B`u_y)b9v5N%zyI@yRXX#H0zCi=?c|@-nQ;Y8{*iZX3_H#d;(nRJ9*_LJAdS5c`7n+7&kucC@GFnge}Ad3@YgBK!Jq1R zE`{Ben_Kw2hvnUrTYk7dT5$l~5#piv9B_K7UTSt;0S*@|9bc z4_#iM$r@W09aZ={nyIl^Gz6?!Vc6Bi75<)f2=+M5D)_YEC3;q4H3h!H1N3|g_qUh6 znp0DFkbEaH_Bg$hpIi7R;&00{R$5Sqdxn{U?WJGld|L22?HBAqx<6;1@n?ESFy(cJ z=%C`v`bxB^@DLr+*j>?S!2YH&*7^zJ6~f5!_9^7(2IgSPHc&H>FZ0F zQ;qiT)VEY&Yze+q;h!hOL*7>iFxKpSx>Gn`%VvLhpMIb*_LukRafKP|FCWmqG{*k& zPg<~y1-)jlzkE#RXpH^kU%H3K{XAozq%hX=a0=sD;d?LsdEC!>n#SEC1-BpNiwiB| zpDAp0q2EwDkjiud#*53j-Cmiafbpuvc#Zjz$};|;F`lC=@2J?g6nt;=ixEaxrMbxfyPRF=N3*fN(56wvjIieX4DB-p*VP#db=_**Nz@H$ zS7)rzbw`^Q6xJD!Wb_an#2GbysySCtw?At9S}?YtACJV}5$vEb3D1)24Sp<4bkKOU zwgT9%1=~yaTU_^!s>}Xq&3^o`(|>Bt`iYr!1+@*}#Gyf?{GsBK!g^zc#;V87MO|j@ zR&T7Ay7TB)#uvc(HNljX8U}GT7~j>Luh1oSgK@vc-Y~B#Y&0I!SRuTiX;8bPjAwLR z(%f$xHKguu_fxVdm>yJ}sxPx_lK7~4AEJj&Rr>z)aJ zS}?`9L1T?M`;Do_-CiB?f~kY_oM!w~*JYWv7ET*fceL?GU3aGM68mVQ;1s3Vg}!~p zbYp^G%APX@wVPoyY0eYDIm4Ktu{(hsld|r&VBMKUtFC*?y0ws>-WjxE0zdD2JIGH| zOG=sYvQVz6WXiSU@w8Itek#x7+GG{;bFEiq9dFRM$_#};$#&#RfDT7~nOQjdEklfF2b%bD=p5~kk_Xo%(}J(0^}xhuqDnIWT4 zGXJ-*T{M4G#;e-?N_zi(IrsH4Mr2aSSg&l*A5m+HJqMSc0l!Iy#<5n@iMY&>4R%4#OJ4Cg_?9r8S7auo}=iQ@aOP$lb#1O z=yfS8`I$VALKDm|#%|G_Vjrg9353AuVqpc-bd&g-B8tZ(Z1re+`xvHVN>*i0PoBF> zJwFz$6wiO7XQt$|CZ3*58LWw-r1kVTmCbn-;5m@22#zO~L(n=bOx1R{Z#*dxBUApH(9opWVkQ3jxP!HAmDt7l57u_LZo@hM8=ey|n+i)DjwgmhoByPF+O}%N`DmuZpMS3>&zd*(b7j|1@My7BCgm0J z+!q;x2kwEAVQzu*T(NZ@cSX2==1Z4B0xX>G7^`o0E2i+zH(e4o@6s@7T79qmB5n) z#suCBXyEBD!-IgM>5y?Oa=>>b_sgZG+DRxcMt1kE(S)q7gyxN#K_43P#?2+eI^c%tEyhkdu{vo~ne}x$P(HVMpRt#Ys=gYOf!ga)eq;34jf6bGs52`o_8STF z@PsSq4oEZTKDw*y0pkw(?4-wxv&@_QPZ=*5n{uB;`Kj?QK*BW>UpG#sak$qnGcPK6 z&)94Js_Fy44SpU`TlFW9HnGSupQbCSvdo=yzds-4tHULLpVpO`SDL#EE6rcf?(0Y-h=StpnRj4*3yCfEpn0E}UGgKd&it_M8NjCC&v1Xv zqpkww*XFw@A2KW88-F*~h|fH2UYTDA59Sj@oq1iUWn~)|=kGTRBV1Bq{la{ps)CA) zT~%YP7tA+CS6K(mL!QOcICL^tPjn z37mCOTW8E1z0!Jw<{*Qvf+aUtd&M*Nnpx$&mSH`HdtSo|Phj}$s1kFpc^0(VYj(k_ z_nJ@OW_gxT8Qf*fGT6Ij8DFWp4CTt;=dC*P!m4Xg=JmytZ(8it*tIY_*MqXH{4wy{ zH<2~}G2p4%hM%4El6870Qb7aCE5}U*XASJuDKo;H$NQ=*w_*X{g%yhdugtg1I&1mpjlQ#t zvuX{RWyyN6{#3Qa*KD0x+2fmH#>Xdp;?+L(w3T?*M)CX;JX6f%#EX4rnK^Y=0saO4 z$uh6?b;(%j%o)Ke=qzK@q+daPJJ#}9Mw$JB?@FU@+#h^H%qJgh~r_xT3`1Kf5K`Ue+MA1`h+#H=pK}B9sdCMUmyQtKaaXlBH;`EY;&#s zmj8Aw;ZVtY{_|xNRpw`ki|r}qRV7nxj+wLUD)T^ovwf+qy+)#3qWB}s)TokfyUt7$ z?*aT}$tCs|gy#l#Qs2;`IXWol#fj2(m+1W1$O}E(hmU( zsWU4dy9dKD0>i?yl#*Fl*x|kecq-ipxRGuF?4;WOpQ3Mp|DPh~U&3E#+`)2;2U(8s zd%z0geZa86ubfUaqJRd3S4mjKB1)OVK1h~Ms0dSFV7vNIk zCx9!BgMe#{e*&&Iii277v~dgM|HNnt=F_vrMS#CH{tEcKu`LJvnk-?WnVXA#%@)80 za~t4f^Xgoa-Zg)i+l0R>e`8h?_Vlu%Cj9-d34qmjgR}|X`CJS*jkW?FM+1QK=@P&t z^eSMRz*Femq7IQzWpqGJv%rl8%Zy2RK+1cie3O)Kmh!_=eniTTN%^3Z4LmWuF{?@- zSzHbaoGY+d;6{Nlfdc~f3cN|+%>o}5_=v!l1s)VgK9*?+v;>9)Rtc;YI9K3&fg1&O z2pkZ&SKxU9ZxZ-bfe#COMBrlrUlw>!;41>jFTD%21cn7x39J^_EHEapL*QP4=Lx)7 z;8z7cBJeSR2L-+&(6Ysb0_O|t5O|)zn*}~1@Ss2=Ap8QG1#T1=6F4AnufUrG-YoE8 zfiDZBES3-!I9K3Cfdc|>68NydmjzO`@C%$Pa3IK(n*=V%Jrm`x2_(GPb7Ph-k11g( zZ_H!PPN57)`6hu63w&JYFH4#7r5Ay71#T2LAn+!E4-0%*AQdqG!vbFxNQELn;9P+l z1>OX&2d9E1Njh%S+%l$Y6gVL8CV?-PGo8kY9D#EM(m0_AylFg_9~StsK&q5lfpZ0J z6gVL8;fZ&F|7C%5Yq-2o;DErJ1U@WqA^xKAZS+n0G2&3S@i|1*Mzg~_VCGp()_iN5 z^%?8S)?L=q)*IFb)+*n5zRP@H@x9{vi|>KT`+PB+3v>(M6OFqUsd*MJ+V0~a?U~|BalL!9Z7~(+?f60Fo6(FJ(BBm7K?~fHz z7;np0;k~(uh_E#{57go8(1_Z}$X90Iyf6!wf{P}63%56~*WCelsQUYW#S^iKEp4T{~2)Vq;~+1pY$={#2N!9FID?e z#76mRx!mJdq^#(flz21;JoiKk0aZDZC$p@iWpb+Vs*z@LW|mdITWeU`TWdxanXtOW z=R-gfmgl(|3uwan{8sijKoj$njdCTRiTTPwxeCyv37Aj3VG3ws{`jr!8bA~8Nf)6! z2@rQEm}Bg{fF|~f(J0RbH0gNExj}OPO*#Sn{N4OB0ke#5z-+?- z3>s$vMvWw3gVB$fUT#(bt~9Fv*Wj!95jx4N0bFlR0^DHM0iJ5s!-po*+4w7ozr@?w z-R3THzxj#z3u~*eT?BuyQWs)#&->D*{pY=@{K$S}Ez%FHvgHcMlD@nqjhH;(@gWIUFPOJk`V)>u)| zcqX?!Db|(fL}SlhLLAy=MBx{c|rlT`j*x%E! zaSAQ(@9K(e>WZV-+R}rGb3JT@3*LC=AYyX|PqXlz)ek@F+d1Fq?v23-Gurn#jPW|b z$Lu-X?d=N_J+ZE?oxoN@gXXTTrHP(+a!w~qHkDd?`ld})V}&tL8fy6r18TmR%r@L6 zQ`MlR(t?EO8FP1TOiP~jZzWG-J!TwzWS)OhHJ#cPHBX&BBQ*$={>>m}&=y3WwQCm6 zr?Vd(P77LAwk%)JvV8u@?F(C%w$P&0Ep2O;u4!*sy?Vv!c6712b@_?yC$+9v z+PtQ9#d2!fne2;qH?^*yZLzNYczZj+`(xCd>~P$!#3l&u@Ob7sU0rdpNwVq0cu(9- zbkJrvfN0X%DIfFuT^GxCS*$0vCEmGaD?1CSX3yzrZ%_0j`Vz6O6mdmwyoaZf6or-| z1kj3}w*HQecrv-UKNT0KxwDg+ld`lsse@N|C#{Pm`W8AauWNWlBFQv1No#VA8|#R- z^soz}Suc9&Y)N*+dKpWuiFfxpZp=+|?QGrBgO#sZwRFXLlPJ%R^>oC$up$u?lT6U| z$sBuIZ@dHJNSux8xxmSYfWvB6#`-$84i~$^O>E({d8C@* z^g*F*c=hW3p5er{t)4BOAHG+dk6!-Y~V-#9X+_@V>DK zI^yC+!|O2Do8#^gD(814uvCXPn(y@VjabpLc{8v7ZE<|t99!g;ox|HMM2Oym6>ww@ zY>=CrB!d13jbUfC-d4KKju9Bv#W$^vpVcoZ%Sa5o{$-s}GF4()dQqfnhtgD_ptWvd zNusBdR>zShcEqVQ$(!2>ciq-RU%aiCN$Xq`CCE^sC)vjlLn2ScQkMQR@dfeCvHq^U zOj1vJ<8RS8c z#G|+NY;(>Om0EhXC0wV6Gs%+>^Lb04R+Vk2ayl`gRz4ayNuj5P56g3#F3FQMvcTzQ z8rE`OqC383XD_ngo=#BEiZRY#HN_hco0UfkF;ZNBJwX?j!GuC%!(sdJns@^y$v#uq zR-MbzX7nQM`W*S#km!}qv-Kw{gS}3%=+C822Q*j^=Pfbb(~*cLr5b@nCEKk%!|HlD z_Z6=BPVY`BunL=bK(Y`JEs_q9W(2?POI5yV0eR43xNwml4u>3Rx0-rR^gBp zl1asqV+TwLV-*C!0O4_+$_gGORm%!2#LAV5m}D&;&w_-DFy^>Bg)n>0wDxu$P7iCz z&DxM(u;%Jx0W7u#^DI?MW63_X{F%bbZ!iTq4JLRj&63lI98P&Sbyen*(x%keBJT43 zAVj$7CT3H)3$?{N`Vn}Lm^gh-httKLMm*fMtw^0|-B#q;>1+k%p^n5E@SrIZLVCX! z)N7=VF+!6;@i{S*I6v0g*AIbgFeLfB|9h)Esi^4yD~8HI6FnVW{he`8^s!Ti>KrN1?vWI9KZBun>UrL!UBN{ZRz<{vn?pzsj_3$!N zB^lr#LT5%I#qHGESBs!!N8B^>TDOZADTfzTH-Bp!n`eLbNDR(KQ2?Y zc^g*C4y;ze*`T~#AvxlWpJZ=n$_!pj@g3M;vAOJ6vDpho>U4)A5y@r1yq#=RY(PwD z>FIE!ppRL4#7%lam_@?vx|rL;2%Ki5>lj*#n*cuHAy~)MpF&E7KaKL5(8V>5F0}P; zO3L3&BJ6;)j88XWJUQp6pd~a63f6_EtP`}Y&*|MRr8Q1Jn!tvsyD(WKmQcc(@$ zdrZR!w_x?)uk5K$HW9*1x95SaE1Gx>@rfRj*d)ElwFhnH{Zkcr#+tjfI0$=NyAiSz z-BQbb12^sOronb#bSVUK-b}o&<808Ac`3oS8<_b-PljnT3@fvwY)p$CaADxA80REB zqfUQcDzv41SuYFb^>%{6F zUmP#_&nj=ixJPBgwzb$iLTS%n}H(%S%efY z?q<;1;xV^ltGfTjxH6E|6^Ora*?|yP5vUWL9OTkOh)W~OoxZmIUR-ctcTQ8quN>T# z_2VXNs5JPg8fdx(DX5$W(iC=Z@kmdVcuEXUJMZQF$&Af1W#mj67A+#0>}GBviJ9Q0 zi1;#*{J9y9yT*|aij-DLy*u&2`tvlYP#`5HsfC+DGv<>QNG8f1VXJh7S1auH35M9g z_cjtrg^)TO2zGYdmonQPBSkj0-x^YL88rTNIwvEsX- zl!#DQRw6(bRYY4YjzMeUI}iogN3a{qhq9gAUVylXFB`QewSkBzUDWrJ8iOg)k1o{l zg0D^GZj3gok4^o!*@2dsey^@@S!;J&q9eW%F-l+S3L~HS)MaVQHk_{2dDqoJzP|^z z!+0tHQ#bb}_|^_+rWTqcC%&f43ewZYA&^7wpt|At2DZSoPoWRbb0tlO?y^6~2I7iQ zbrFt+6prTcHA>I6I93a))t!hMfm}zx6Q~ovu%N!a!CI5u6b9s^9u+ARLv5FfMVSdz zVj5WETMz+ya5310W}LMRrRi-`F?6UsR3Rdj?4aUT#Lw@>uUl=hdXMMa$%l-X6V(QV$WfBPDu`7T^Wxz zaWCcFMI+UZAK)Wr|HShe~6No;$mqkx!1-%S&*8m}zwle*MP-Ct`L z^)CC;^zIRO+tb7qo5c=DPSZ`G4Ier%!c>B-rXBaGZSlT7%-XQgXI8~B*jU|>Z_-8M zBUHhmybE{g>_P-k{bNIsGA}r<%*qbAYVmT`j94bk;vChagt?N>7)zc#=jitKzO9KQ zw*A!QWm443#8q&}r102u6v-s(L)-{89U0;!?4W#D9ZCfwp9f_6afRQf<}hUviCkV>NK<*bhEqHB`wMA4UhW>BHU_Vc!3^-q zBi1cAWmZo6K*ET zS}uZoJS(C#-lww`53!NFZsSK7J*ZHrN}8afh}*mcK}&5`nQ@L&Usc88)nh*uvg8RM z&d+fyz&IR2*L5g*8BR1@Q)hNWoid@`CVU${=)Dm28d!1|qi8ye+Bvi{*sML(TS^7C>Tqi7qS&_haB_Rx z(>B$fr4D_>E>ks(=;itPsZrB>cV}-OUyt=}6`KybVI(-YNJ86&d)Z}c*_o?)g67@Tt9c?In@g}O>5~%_PaPz_QpDJ&CS=pT@cqJ!!;ybl=k5i)L(k>_s~;DDN1@dMG=kC^%av zCS0<}V?W)5vl7Ls2r>~vXxzh4zRg2;&|_MO%y$`NSWsgSjU^7HZ6Cseg{&m@%HZ&x zt3k!Rc)$5fyvy8&cW~o)b30Cy(}?%IUA))bLq>L=lt7)b67OU$!CTmC@OJb(ylK4x zr8fMo27M*|wV>3l@%g|gv=VLOv>CrR;zQmRl=_H9FT{K0F5ab%XHv^nrZhQ8S|ss4 zwF4b!w35TJy6_vr+vm_Hl$O{AzJ4u{LapehM|!|>32=ANR^}g@ssBl$Z5!SrUjZF5 z>zZgt-8i;JZ^lR(A>A8`F_vpLr^Yj=&ff@44Zv+=tx?H!X_?$A zJs!Lt4+-G1j)x_b9z!fKHa&;!cq@7`{vV;Kxr{A@71?TGeCy7^XA(V4!YqVQ-hsL# z%1OM39TuB~p)1dpXZtWXaN8#1>xM0{d!XEdznmV{JsHi*K?%#O@QAu;6Z+c;%1}ux zg?*|Mbu87BK&#dQi%C1yvrptHUkRgcPygZaTyS=$Xe?hdq#V?1oVO&BxJ15O7r zx-Fn7&+EYYY9eY*_a25PFz3k9c}}=3uMu8_y}B2&@Li0$mLYwoWrfk|c>F34py_F^ z@Vp_DH_aKww+(g?+YNtA<>I_G;->hYWq44lhk!g%7@0GS+YBY^{@W1=Vz4L-#E3xgA19-tgNk38m`p-RO zw&X?bg)X&ZhtFUbbC3={YN_%Ja^U5qtLAMBv}9fTF(*pHk%QoW){iB!|8U4q%XTC! zGj&q^rAIO}V9rKJUyCmasjaFF^R*UR6K_d#WM)(^?5Y2rQw1Upo0%RShOU`@o#}V@ zAHDoP{X3H091dcz63-bPs6r!N3mhzC`1Jx4Yr=D)?8D)D2mI2j^+MtC7+2zP%VvBWwHyw<5=C?yDMOSuABGx6at~soCB3vsQdRz4WepZKi4fp9;g+qEL zFclj!BV5xFBOL3)@$&!rkM;33es7g=%x1q**6|Xh<3!UgSSW_MWxa=wg|*?D|LZ^A zA~`8hF%J*SWk$JYo>$)1IR!~ah9;DGZ&2w0&mAX^={9tEc>N{4=oPt6P`uX$JrlWj@T> z4}Ez$ys*b6;swt+X#v_IfBX1gXn~LvK^53H% z{{(zHlZuvOTWm)vv>Ko5@jX~7R(azf+PJOImY3AA_;%(|Il;4Iq1PZ zk1Op3Jl8SM*`s)lyycN$+r}fE54^3I0}wADmOu_Wyf?c_W_n8;-hVnD=ggbWYjv2L zu$)$T87awLJN6(Ki&AZ5JHbhHBPFb1aK-U0?S4R&utBqFLxY4Tb#M~H{N4$S>IZwf zccK_k{t5FXgz*{2le`j=)WKn>H>;C|H{K>5NzEE?bLeCHsoLEG z8RO6{V>xpvv{IWok7ckfnKCkiU0Or6ov^j>f0u&J{Fh{^p*e3otP%IviKxTtf$iqP z(>-m{iArX2LB}mXtIXupJOTLs+Pf0CsOoQj@12za z2j;Sb$}*xPq`)1J1OyRr0To4oGy@f3RFp*lF*I`qb1QR6&81AVa!Yf|Ej3fi(tj>3 zR%Y&NnW=4Rg}(2(cP=x7Q1;%x*L$D$M!CyxIluEezjMy-oOAE}{fPeLh>buVQTI== z4Q&XI`&vz^Tky0bO zRR4=qvzlAln73uUgW#ydNPVP&WhEarVo1cvE6z-A~=h>I+% z_J}v+!a5y`uxS|6A2Eei5NOGmAfJ{3XhiGwFg@~ZCI#EbF^6%HVKKRxz=WVmwy(3P zL>3m=eKI#l9y(FqZtTdTFME^JTbdYaCxgba2!x>)QA$#U`3zf@TzgknXfx0%1=ZvU z+0Jcb@lpFk?PBzw`X%{cG`>VpGLQ;Hx)m4=`3kLSu2n!UpF{VcMfozHE3Ru1;$R;xp$Izx@v{oK0nVIcI zwX6;8Eunr{L-qft9$ByCXc5G6h!9~Y&nJ%av^~-+iBJL98R7V+U{BPmPgO`tM{0?zh*U7Dy%+ZW zG8wWE$U@d|ZwLoFf0T+!S*Dvj!w^R?z3nqEDO<_!krdA#K__dM)Hz||D5@Ce$NxIS z2jrl{zUY;sl9794=LCBn>cK4V{_^s;lGVmqW)p$s$b}TKAnksCHMtoQE2`n>T~os( z*OV?r4vK*EP(UFzmUQ2kIvt@-(LB=^wd@@P12?m?8bv_}lSnLh^e9S~BjSb!4X!;Q zAYH*+c-ZACGYB3*x!Mf{rcqZBsuV$G9=AJClB?wyUkwM&G$%!XWyw4xu^0~Mq$$gg zYKIzuJaQi7hh&(GhW=fUBg9!kHg_5Kcwj?xqSo8P!HfrHPALkwop>ZDiz($2wq}%L zEK~kIH1k0&M;lo7V(+PFOp=CRTBl8hnUr_YlxkROhhcZ&ZK#S7#V?*|9o>K5u{$oB6Dt(95qJ=Tb`z58IvTe z5@aP?67ERegJEH>Uj_-u6T3j6jUhHGfGoZHryd)Tvl@2ECBn%QF}Zbi^V|q$Ptpa{ zM~ZVv_AU)8RHJ3-Kh1d!J=Buh))6)@1r- zAfKLJlM7%EXv-#Y!C7MX2PVZKzcm=z0I_KsPW~G?V5D z$IyYZQO00TGiL=-C*NBhh%AR;V4BsfB}-@*QRbmK8b4w4F6kMlWJbw>jQewB?@e;~ zBmdOpmox;KBa-r>*E3{~j=ZlZ+4~yx?`+GFMeJccBaBps7RA|F3OF&19Mv%6@FE2T zbHjl#vGxdP4d=+WWAMzWRG=d~NpCsjCpeFtJ+vkXg>2_I>c9{zf+ye)3p6Ix=ZMIm zv%03CJ$4|4HOb#)U1c8}mO-K;t_=%LgME#Cu=@2-A?(3wN@hI#uS`g}9GsxJnI64E14$6#CC_pX=%@}uhpH=Ji;xpy=_Qjmy7nSxLwaYe3; zJQdhSQ66i%0&0dH|5saL#5dd;ej$NX^@9t=C1M6==hR3x0<9sR?36)L10qG;Fm+Q9l zn%vBzUBuzkGmOH>uu3D#YE?KGyy;S}#(}q7Ll&p@<}FKEz0!!)gmLeu^5$b%y^E0% z(>)oLk>M?Olp0R2S2C<#k9CaodcC_w$$NS8omoBSZAfLc?j9^lw*jaYi=#rv>H!J) zXjSXUxS&DG@nismLl#vcgwO!P0ir^~(w`P6Xmv)8s(Lb76yaDpvYaQQ(J1wLf4vqM zXK{Ltviy8`50;Y~rSt%XLl5;@^v7S}V&wew{tAQDUrmj85FmoeDA1z88m!WAd>XpN z@M$U>tf9#FR}ppmRsJfm9hLqe4-V*{Q(_0GEovozRq8mEUJH_l1QW^Pr_z9|&rsWX z0}zwy*=mS*>BSOLiKteSn@BVw7jLNn)_#8Iz1~%$;veV3_#8c-OBCXB2%bvAu)H$#hUK42B6UBoS7Aeo6*IE;iYjh=zd#SkMo!i_`=* zRb&W*HBGBg@T2%5eiTT6i&0ppnxiw3s7S0ZN(7uGGLSV3@Bz+6qtf#^pd_aehsIy8 z(s39m@y=hb5Askbz)i1n0c?O1NrV4*WAK`RWRmeYcJkp|upvs{Q}#Zkh#y?Wj{oNlldV$3F3l!Lk_yU~$qz^euDwbO}W)fs9n^LOSu*#l$EHbV$+x zH5++=7@tc_s8wkcdacBpu_EvIwbJmsWdRU*A7%7<8lLS2%K<)~kJs|PxDo#!;`n|T z4_h%p)3O~@K|x4NBjVa&^skY|MXaa=3usB+w0degUZ+t(51?f}o)`)$0oZ8uI*7kz z8WB||DkL3Jb$U1SuLIvfOx6($9nt9+x_(?k6;6U3F(B3rN*r@QQ1BinGRJmeA{2v+ zxo)(L$t|pQv#;g?8)M?8h3nIWtYW zK5^g#!!cc4i*%R{auBhhV2aLO$g(^MmKWI%&aY09Sx*)cJ=!D7g)Cm#f)7Usi(Y1R zbZIGiLa!^5Z7f^GRL35AmfohY+cwgpH|ZIH6ke8`bAmzd(vWK?y;nunp*|W16a3Cd zoCT(Zqsw+b_R@=AN-|cIEFCyHfTj#2N@HcoNkm z41DaD8OWADOYyaHfO81It3ET*$I-X7KR{?=|AeLPXDSX^0~zNpSo+m9lK)-L7KZ#? zfSn&LSSJ5{?c`&K9`xCOW$r(VNBsfBn7T+ks0$?2?|(Gx0R_}wL3U^!{^M-fpJ5q= zns2R88(MH`PK`MOQz4x&wJ6oR#Y%^HoLY-C@+VMOaG{w6CL~`(ncI=nLCV#MIpQ>q zM6*(j=>!-3@Ry0d6e@1fpf>py(pe?8GTr8I$esr#XDU0(R#uP7UX-wh4lm;_oi1kM zBAzbRP`lDhiKJop^QGjY5>(7m@J3j^HOFUqF)H$@&__OjPvSGhOIYA6@5LwB&Ph7) zUL=8d*;>4W%>V#6>iJCAY#g7UC(}(nC5d->J{^fHZzdCihsBFy5$stds`9>Y!SIbA z*)**&ivlBD8d}h$p@oLLLExpuorD!7&;&0g;KBv4e8nt+>WlWse4V5vBr;*uU^g2v zS2DvfuWF?$vGbP2T2AbrWibFLI1jC81~X_2pkdO&n#b^pjnRd>Q48CMj77=$gqsI1 z#RHbEIHzNvhy+L|!X$$}Fw_V14pthbe1AW*0Sm{n86BepTu~8tEjaRClm@?Qmm6j$ zSe>m2|2@DH24-uH@FYu~nkiylikO!|d9~w!!j?VyMuOyW1LXh)kphqj z#o(3E6@ZcR4bu)#$d1J&C~E{|bIC0egAKR^X~;c-%|uNSW-y?XA>ck7Fj^rDrwNg` zPCSDVkfx_=VgaR=3Spd)sHJKhY&kk?)F)F@g+i9&lxwC#KRRU6AqBPkv@G@|q+bBb zu-ID1ht}i50vWZ-lVOEPEQrCP92qFsyM|?a>shfU6D!RjLjDlT@b~93*wKekiRlcs z5o9uwjQR39$(6<;aX*7nBi55JhWG58X&i&~sf=aPQfp#r&(Zj_*NBgoX|dumBNiq$ zVsQu~KKG}^&atYXxeS3#Htr z(M?xqR@Y7*h$l)t5fkqvmfWShewRLwpMhW|{p53^cn7}*XQ>ri0#2R8 zw8!AVl>(0R#3L2n3HfpKYa!OkL@xPxW#W?;ip|s08|k-Rc?E(5og&7OrKj5WLwZjv zBfu?_{8$3=1)b|Aba(_Fa2W9XA$tR_6 zpzUs5?}IL?c6QK2ndQm(LiC3~?j1+sl?tqfYJ0bfCNcT>GsN>|@2}6!d`| zy>L_R&>NCJxjzgXeWDdPqxQ0ODOQ(W@%T851$WUaJdR)f|8YGECxAAH6MX9+K-YKd zj!%5DsL)s;t>l^zWC|C8jM#fXT=qF32pbrM#RM74umo3rZedBWIU%UhTo#nrzLBnx zESP=Q54$Y^-5UPj4KjriH&*cNmtDei%#>k5s9bW8}! zEt59GC=D`>E|AtzO9&c*wad-6PKiJw>cK`vJ;Dk1_=s8}pg??tJVJOk@c)1RhbV9Z zwk*0kEcX9UpZ~wBwG;@UJwiE-5vsiX)Gm)qPMLhG5v$>c1;ky}`9>;ccjn2d#{OaX!)W#~M;Gl!XtSs9)C zWcJC*$TZs4&^I*`0x93s({~v56^V<87&B%}_-L%PC#uMBOiLzzp(zznczR`J_6#Es z;(C8!(o%^+z(b8p(Wb~KlOX>3<2F`kE5w>&+6YmP_7|+r$fyGEt{qKHg~kL<>&e?z za<8;roq8FQlZ@i}gywwHBSMIT zSu>u|bX$#nVSc73+?{XLVc^i=B19NjUvQ zTkU~>n2mihIu-@p-0+@SIpUR?s`B*Y@%yWH1ophcje2;)_2e%nPEYy$vitn8i>|(W zYWb`Bc7C0FN6&cj^@j@Xrux2iZbx>{yE7ii9GiaQ*e@T=zPzyVi&K?zzj!g~u72V> zLA&#OTEBWSr0KeZH@={}i!>Sg3a(>UL8_&({+v7X! zte|FxgIXv*Z-oVg3;T(40dPu%&$OPTS;4c`y{yzAKa->`fmEIM`bwZyD6olBc% zM~8k=uy($C`tI8YT{v(r`>ORP!Fp3<3IFCwU%|)X_0_ffa<7-Y;@>#AaMi9SLeid# zKk%jC53>8~l|D+Z86(1?M*I}DV$LSdMX#UH-QuH%PZh_|-<@T#+qi;Lzbm*=aZkGE z;1>AMT`=9b2|BeFGNryd?BvEaa3y(VBc0(nG6qBqjKMN*N44nCVfs@i`YqWsXu-yx-!b*6w)-U3R_FWYF=$R1hqVuu6 zUYh1IVch$<6CR%y8LS)rW|Q_embF~DW#6_bw|tZ-NeS6sezzpeXi^?GFTHlCK$GE< zaPm=3H}z_Vi)z7jn@{(zukXxqxwpSPA6~KP>%$$d->K+(cB@X+VL`t|Iiq~$jGAt? zep~Y6v|GQGt$pkA?&C8`R=f5J{&CycV<$&17-qe_`rVH$d*6F6cG{j_4!lzMMfsiM z^KbXsyGVCvz|7l?zd7^zlJ{=B(CkuJW$=NZJNs_LJ=1q>oX<~rb3OcXj_wz#RBNE1 z=1R)Rqpf=k^Wv6W$4{(|DH=X1>oG@?xk5XQ|J#JTxzG%Z0rk_wCggn()}o!`M9C%z zPfik*5Oj`US3;435EBKp6dfBK3nlcU1Ad)4oAe@2Dh+Nbp^Zt1Ho2oeq?Fv$8M#lE z6j#Ca&u;!{->`)77PFMK=k<7w*#eCnRv zuHB;3lRGZdB>hm9sqT6u;$T75?+Q1~XK$K^9-U#h`g6OABW1}SOes0J(V8$lzk2FB z+M1N$ptp@@JYEh8N?X~l_rVy$2Z>7$C69W(ZDr1t^*57$+LWwId}qY`6HBg*9p-bDoU~r(>_PXQP5brgo#n%~9l3L<`>xc(yo1(D zFppDR`nJZ<_WI^#-xij&zcVN9g0t4sSn6m!PjHBTu#?JD2nMywpvfuh z5RwT_pfX;F6Jn|#t!^_p(m|U_W%F{WQiLQ{kSY=?nk^wy$w{I*EtlH^dc%YvLVNjM z;2hwU+uHs!c;!Ni+WPEd+29b>u_Ho)kx(}%A#hgjTD z_(+egOInTZbm7MO*O!bL@VWo8k7D2GKPmp1iDN6)o^!c#xI8NHRj=sSth7&0oAY#G z?>;g$Wbq+m$7`#5=sPj{pL`Wa`#uxBYPH z*^P;t&h23~t{L;yeqq;wt>%JzC)%WBy*R3iZp-`#bLiOL!cH7%x%s|DNuNGk+<$ynkNCoh=?am;Jo7{H-B}*YMWPS8AfZ zb?f34Hq;nwZu{ib7k}JndK3Ek42;PSZTdR=sVN`n=XC3HcW#Z})lns@J>cP40V+i}M#XX(6rd$+!HcMpHVFEKY)H+|XHzw8rM9}4juowBF0zxL3M z=~>fneO56mE~-m<*@En!CUqO(ZaF#N^IbKoBHj)D`OcGHJU`H5Z>OyIS@EVW{~GzG zW|i*zx;<>ktR~IR4U9RlUz^i))5N43;Y?ev?fmM>7y2BU;y&)n!J)4`E$nK#d3xzv zDLM-?e{SYzB?Wn`I&Gax5b>phr>AsMHB4r&i*Uyfq{RDmx3wLQ-{Nb;9I! zf3E)=d9;>AMMXGDR$NeoW+4x%*=Dyw5k}MkZb%VgL0;@iS5_`+)d$sr4(=ZWR#An{ zbBSE+zVB}zY&Y$cTT$AEn>}CXwQg@rYvo7p=NaB`$y@ivvM;#Ak4hTvOZdErcJ964 zFIP=n(aNLAnU^+bf|~U9i~H>CH!iy`wJ2W~FwVzR-28fG@321HxzSoxkDFV2pY6@; zpYluL_a2=p`VPN&y5ERqt5ZLFs%_6*_qL4A?BM%o-=T&>y|@c^fBfqA(GQ*YZtE?x zOY_vg`pUqOm1~PS8kZe$ zD^yJHai~l)_j3Okamu%sEqyBRUwLufD?amXx}s0l$W=e>&hPs1>cEVikwV$tlC4ix zEzZ8zWygph|EaFGo33uN{P*cUpPXQxKHb#Ubo9~hx-LEPujf`?_w()dzIx2T?l1LT z*F)QF?96ko_Bl6W#zzld*!bnen7u2n?YF)hJz`bA+-|!0Z*}juC2R3J3onl>di-|L zBW@EK4;tvUXlkLbrjN@kpQiU(Ek1G7cyQXcAx}rnXncBHN>soX=G$)`xINKpPR02A zqcaY_6FvT3sVQyAE4u;;BUa9IQ>Xtnz2&Bg13z8*Vqcqc)2B3>oO^e7R{7axV-&h! zg*z@BSas>h%eNL5H?oUoa`{MMJ#HvqvZF3<>f4ZTP{==U>P^wAZ{q z{mS8#CqCQUc21Y1r!*&z{F;3I?V-8%#;2ayA&k$qoWJA~+kJ(pN(o0+SQob z-d=b7%{Iq3JU@H;jMvudDnESKae{+$udKr3@G9ftRJyB`qzJryqXmfdU4goP~*kUXFcwk&PBifquCt#X@|!9EQNb-_{?7%nZ2U3 z+vkt32n<}c>-wV7OL4BJZ|4*bI`YnAA4NTNe!&k-Bfhk*x|s9orj$J^QYu0g&sBXK zaI@=gZ2N%sySTaym|~c)&9GsDa=_@tjW6X!q*v6O81H#%Q3iK%qFbZft_7Z*Es?G% z{392hJ74_zfb?0d2mErt)AR7d#>o#I8PxCVCw7K?@bvsHhx;A1Y;ZIB$ITnzx-&ju zWJI@1?@oW@hwzMlC2rZ3yE^}?58292BL*JZQTh4ovmxsu?|C0T*XG5fyp~I=xMZP< zOSDr@ZK~n~B()YfXx0DJn9}{RFbB@cK|n~3)`5>)Yi~3x*r+x~WpYO(Dn^Kmj1pp^ zBco0I?_;AA51TKKJn?(zRmNq~JM-TTN!c`ITs>?w;GLF(Ki4fkyXM;9nZYY&E^qJs zbjT06#*eRckG#Aww9^Of@vA>&7w)cFuIzVn<@)xkvv)tAW-R~pxwOH_f8~T#&iLa+E-I0@GIM8`>$L&W`LeH!FuDZ5y{E)fa+0>&mx2`H# z{_5UUy(b^MdRx~b_wsuyR}XV7SQ%{9K|L)FvP5Bo4d8x*Dr z_IJ7U*7rLmo^I8&?ZsCXmEXBBrQ4WmH@d%(Ja5ssxoe7=Zis93Va?3y-WAQyTv3AeQ?(8A$O1rvcOIpd6SnKkIjZJK0S-u3mC0~HC*V5XSku_pg@`16l z;&1|lgezQu#1L{30)dbNNCJN0ct8$F2rneWF)s;(obYlHLd^eFbO`J4O^AO7B`B$Py@Jmel{Ne>lx1D&O;nQr{VYU1=z))F7}vJTgec_yv!4o; z++q{tuI92P$}>VhcwUHj2|i<*$fu8A3NexS-Xn+!;din6fiHLAt%J$^gTTM|1OV!I ztkB#26BA-vtDUmDL6o{-Y$Wt)Hy2xDVXK|&v%pBYlFnoU@%>SJi*hMKd@BJd8=KZ!sHe&<27=OUSh0aRc!J z(3?z895Za@=|1Z;eCj@Cw`QT-STxNeCdr{hQe~h7^*GR`JZ~IUF!TM*g+3ef0V@Jg zB`38et<<#2QRVj%qiGs(^kkZ054VeBeob@;UpJd=v)-yip=`4?fyianB>M2BqL5|P zqwKSaP?Q3#1t2u9P{=$W@nTdqpROpds~L(K6x@<8DP`6f+`>8qA2u``uv^G>73TZu0Z z&6<6BnN@>=VeiYKRWa=crDqsO~ zGo}zTDJRV^9V%HR2w8@B1bxzvVFxrg3seX;7iDb1G?*gTVA!W*>Zv1XAEt4AQ>C8c zGltzx{HiUNNp{PNS;kE~H-_EeV&t-9H0;%x9!aBGHX+kks+| zHweO!0@>AK_>^6Fj>~2&GD>Mt25rRk0qOb0y5o*SlkAPU;*%ciAgprZdAbZp4I~Fn zI4~iOWfg3k0K3v2fK?fZ$3Y32@hSMwEqHCvY63XCA$OQw8fG&p>eEz1VWuhG3Ow&P zjB1+JRFq%xH3|*ej}FQ6+vQG1YXIZm_$bv0+MkE|W;_4|;@I?pdAfBU%03Q|P}<Syd>gdf4x-}i5%#)_inGgzlP0b83?G6lwZl%#4@Jo)~R5knAHS9SSQkfq@XAS5uY_1JQTZ0+9JKhWhpoK98KZLHdcsojLTFf%(gV~BN z#;4i%Y28|ag8d}s!~QAx)KZ{WmdohFh+{i2Eo_v*#wYZ62R;YOA+TPuo(a6Z%sPuc zbjiAc$`#g1e6XF#4neX*Y847WGpfbGZZ=1JrUn0lK5GD*bzftAEed&xobNZ|>$sx0 z(VxO<4%WvZDrjMWQI~K)@?l*d;PH>4#%1uhjvEcf1+>SkV?Lz4kOLJ81N_oqDY@CRF>Q0)%%ZQl&VQs4<* zsC%uuK*{6voA38oTR@GU2VnmIOoy=>2CZ!XAu}MCeUayQvA@~$tEJkE{hk+X#M1~X zY7=SQJ}u(^CD*Mk9usrkmgQFaKOiy<_w+P=Q;#PgRWFajnx>wDCzxPqfdg^ED{QpKc%aWG zKn?0%(lILp)+ogHRH;eO+pM`|+E^vhcsXbsS@H1Q-DoVk3Xu>C$1cei19updk~LATW{4G# zi;W|K#n}v13N<4>9iPF}Aez=&Lx8%qH&ZsPeVKBpwV%re02}J93-Mtc1ZZ4j&qp_` zMw-;X&^YgcH3VD(Yg}vew1kcFEzJR=Y;*b9Wt*A|qx|e(Xzh73qOer`93*%Qofv zRWOB+2H z<8=MZ@+~a|M$Ne>oMT-E=?zV%Fp3#g1j8eh&`Z&n>m(!aQaB0uBMk)}9l<7^Isze$ z3^A@45FTS*Da>8UlRD>aaO;_A^|yp+Vq5(*tF3xjzJD(C5K#{%H9iBQZaENWUPv=N zb1F@*6gssA63RC5jMBj>w|y|O-0;= zr!3SI$h33ZN%nchvUlEj$KPBAPl122vD|_UB2h&%nZa_hq&1Wh_gOg2kzVMi^U zUg1GG{t;A}W%4t1HITJsjh^DQaCY)_1Wr*5nRYkyHslzwID={kh>~U*^0R9|YVNf6 zfyrlG3&dw#2PiYi>rvuVj+3%{-G`IRa#*0*=MQjl=9kHt-(!6gtop$^j1Hmd1|Tvn z8)CK^n;yTBq}>E?h}hKJ#W8m5g!V_FfJr&0soS5(lpD`GTnk>7t6Mjttzq3l!dp{k zf;CN*jg^Nd(MPqO=Fb`Nm8hyX=_x&_AzwG*A47wh{IdAjAU8JZnPR3cT%M_OimOz+ z_^oKHs%PtNY=Ppau8@rzbfUD-}Dv_nEpl7Ov1XNPaW5GuJHgu-PKMu%6 z_@620Vy6W2n2N%Qf`=z#sFXbfi%**HB{OxDxNiqYp&hQ7;&%|?lK?)MpkeKpd=V5! zNXMZI6Jy3_0^}oa%QE}vBx@ep3i;+ig5+!1mJa(+j&DY}QPB}0OqQka2ExPe=H|Hl zc}$&?f!KK=%&C;cJfDJ6cTlEpDr$MQSe-2*zL@cC03ka92?6UzMEEofYa>blS7RTJ zZAG-WK0~$8+Qi=F6=*CbO9F@Wwh=tKodEacR`5tdD0M8k_U5{HkRcn zeTq#YnECc6(8wRh&V$^-$Gy`!qA@*Y;Et61pqTu?^c=zPqz|P-GU{WL!RBptdx1)Zrs}yVAuaDkU6_G9PByTxA+6`A&{E9slE6p@<;r12r!$Am7oQL_?${FGZzIS{z$;G zsX;IjEIp}5JX>4*D9w8t(^_1FS)xH%4^rc^?NgwIV{IpYm!l75^!geJ%Zr5Mpu62I zLgS9tzSqsCP6kqPz9ZQ+m61H_E9fSYFFSeB-8g^zP9{XM>dQbimi_5)-BfIMx|rb* zM3rrLGOu#gjxTBh8hNcRVQznlH7tt4Wkm&}9q=f)S}stQ2D91R<3frG?O&oZ$8%H- z{KX^}Dzv!7>O~5riDVC64mV@>hMlLVAX3om_eH|i15odHeo@31iO8~OY&#X&;)imd zKk8WDSlhRvj5P;`%hJCJI&uYyWr!^vaUseT6a$ddnH=v^-$O~a76MW(grilaiZ8cN zH-~utkjs|mY0mTI`--iffZkMQFlI_DfQ`Y&MZZqBN)Ry{Fb+pG8* zaDm1T1)7T`)dL(0Gno1d)#})(zXB{x`xe~|)YB*34R8Sj>;Tr7Y04XeX+_2zEpa)9x z{ean8BC&kj12Q>|l^1N}+XArc03)%`C$mt&VcEq}2oei@G7A+PmH}oV7{}rdHqZCb z@!C{Z#im3&d~ZyVacgrhYTyPy>5y%0JtVcFSY&cUnu#v^86zkUt~f{exUyxUWNI#! zO!lWSe8p4NDC=4#N?wFE7UbqBQF0__YgBSdjLyp@>Rp{XLnBhuAcavH zni=sqL(8_7Lz8DWU7Qc!pWvQ9j7g7Y=WFI_Jx+5Vr)FlG9?#Cg%$a)JWguK%W(_C@ zAJya8j+xZRd9*G*ihk)w_7%GdZgjTnDd8a0Q3j!YT8z>rWMWjb9>y>;m3`StD&|&_ z0;(kyb1O+?xui_T#0wxA5i$8U14}T)i@X3$@PO}pV zxBvq3IvFgu079!n-~z?j>tWX_*wem?g2Oj4E}nf@Qr;OJh-xQGLUbmTcZaWoEqiw; zFO1mrYopqjEb&JmGyW(*>iy8TUZ>kG6OUEl!9n|EjySseGVA$5hb|H+$NV<*tLC*( z@Gi0J0NR-rK^bDOShFN2ZX854f>Ru^9M{e!-LYlxX1xr{IfpWWqeZ8H;N}=9qlH6{ z!|`wE1y7N)-4G%EEr7;v9-fMMsBdX#IE+OtPtV;boHWZRr+o}O^=Yn26C)k>__H;h zhRW9CB;!nVs7yUUVm|;ndB8Mcr!9vIJM{PwR2cCHpekEWQftbyHPHau){t%EQIh-b zs2Rj|tzqt;LV4ulFLj?45rIm1pS61o`5xYy_I41H9~#}|zahQ}MnR5E3;`uvXi z#KfA7b%uwMPg(db)yyzx#}CGzB?N2VLwlNtk-l6}AHNv<^+D@7Fqqc&iLEt$7e4p^ z0u>e#sm_T10G|z{%kxCQ=MQCtC;kEzSh@dDRX=rt4LKZb0(4wCIw0;dDSe*)T}>1e0NUx8So zCC^?8dg>+6FEl9e!vWQPC_}<|8jID`J+!p&M4rw~^B^DL5%)`^p23HP;PIvgoq9A| zVrYZeH}mY)l5F`z^n;|JA>a7;DHKDj z!0N`zJ4*6v?5A9E4JlVQJf=4emqvob%wEH!B#PMakS}uv0Q)*nUF`NyZgm%`?Jt9t z$zPGR;tAFUY9{sYlv%d}YlOa}cRN1mN7=&@_HeFmKa(psE5OUAR&pOD(c>*u5=q{N zAuDTNKFPG`#dNiSr9&^YxQwyW_Lb#~j?{N12C0pSryyu+C&0yL{hXosFf?__R8mK3 z=EF-aG*+__cQtal=@^HYX>k5fi}^}b@cG#|gq;e0McT^_B~p~W)L|!97&I3wc}AQRz6KO#fC%Rn}9Kwt0y!D zJICQZbjS}hv85uuR?!%+oglta4F$#~jCBZdIu1NL7ehCL(I?Uj4*22PhpVs6oH@h^uC^^$T!h(w>-1ipp+Lb~_XD>tMIiAU`0;YicoT@-_tx z`wNg~TE9fwe8cpcQcTDf;8$*1d?;Yk0pEQYzWQLv%zwjc60G;5kV|XDehT#l$IYO< zt|Gf6;ND$ioezRW&P4ZlG(`DG1xp1Ri0L(aGFWuj*ArhSXz#|BZ|jwct*Ozz9A)Q@ zL0tskG(HAZcIH#zLt*?>n(x@|!B{3?EZNNkYn{}SH$H}ih#f?9{vGwb9`r`LeS$OU zJo^=t9W_+6wdYM#qt3U_b&4T5GFbLf9wztTw?36Y0wyE&Mbv`&IbPXdKkpz?CBNi3 zS&4a&?+5G=4cCdvQWeWjcjl$J%F%G_dEtdTdR~0Au4ltbd0le>^KFP`$ej!urDAaA zAa3afz=JzG3m-b7M=kmItFV*(Ep!}*I!zp_NS}IYSEt$y%61pfhv$$@AKpVLB?WH~ z$_r5Ymm~$AE!V&7A0aD}nylpPm2$AOx&Qi1OK-K)($V`AYS*CJAv-0#_o;SxV@&Bi zf!byCo&~+*)DD-{{H_l2O;3C^6vFF%2MOWJnnoJ?6i0@K+c#ipc)!MGET%w)Z00kp zU%@_&_Iz~Y>~T8Z2xm7szR1Fp0piS4w}BhMU#V^bUHtXs@=}me-uuBW?*!{Bd>=vp zn;`d1U+DNU+z-mTuSfnhIe6gq8pKLLCo2Qa`zX`J%EMwA45h(SPJOmxmlb(cy*IPnu^G#(d%>;p{~wFOUyB3Nu!d>w zu0{7P6sPV&dp=xY|D#6Z?|<~hoy*N}-AJ>XZ_k1*A!n8m@o1Lw?IBR*EMro0XW5xi znDz7MG2#ix$x@?mujV!5O>|bgZ0paNzKD9*qs-!usGPs4E{83{MGF*6YLg~2@XIY^ z>xf4h`(BJk8r#h7^hG{pG&q6W)445-NSJF=pOCYuGZWq(B&O`#s@Zb(_=Q@0m&Wfj z1@ZnB-J2|dm(ox6IQdg3C6AL{_C_Qu`)eH%t_&7p0VARwLiXy>J%`Sq5AUG`_&_Y> z{pxmn!WAOCy735{Sq>5hKluvcWlmXzcNF6%p>Ipf{s+2nk{|sb$>!(nGWkQIbZy-@ z^&8M$KS)Z+gDl=*lJ}P}`z==+EI#JcS&#TTXhkWg%6&{xTqy!L7iecISspK+0kM$~ zD-KVpi?0%Pw%s?0{Pt}ix#xYRJV-p)p-8F5v+0O_57?zml>s?l+>HKPVJA6WyxLRN zC~~az83+p6%O+=sZhmMcl$2xPdyObskhS{af1=g?XMnup-i9)MQ8qKae6e($@Y48b zonlMnAK8~-eHPsupVDAoSQj7XS@?-`*2uHB$ zSZgYe1j2Hj#xsqPrBOeIzN|>qlwvgQa^}lk1ijr&IZXk3eaMf#owZ4DH6zejV>QoB6Bi1*3xUdH1IO& zzMHzQjQ^eF)7sGJd6t-pIXC!eC>BQ&EX{Z>yBp20_Z-{-Jnwke#I0I`g9+!IXXMV4 z@f;j>ZcR<34$h|z8s)Y@FLwkDvNOH?YQYuh`tKkm*!n>W&^ke?U8o-%WD=#$`a#N^ z^@Ay@ewnJ#VlR^@Bewoik@hobACZ1eq@{W`ceOtNW6={=RKe+dl(_k>siFm=`)>tqVnxWM4dhLaVV9gKBR=b4K%xn%e`=H63Vr?t+U zHgo!1RN`A6xE~O)={QFo#`m=F`Nam5I|uFF{+*a3A?9H%>?hj#PVoSE3PGE+Y<6k!vCa~?&cM5nlH{s)E z{K8KKH9HNzTk%_rU$D`4QRsaRE?3}Fh(F`HeEF-42Q=o+=^!bTPr<@~7)eaWnV(C)Q`Uh-Cf(l1;HDLOe4oso(EKZ^WqQ zRS{)FDZz_atLq^rC|)Zi{`ch(eHqg?hKL?0Ao@eB+k&DeJz=ptuN7bYyCzDUfjWZw zs|nu2t=3_Trl^mSRz1aJflijWx0LL&ERSGsK8@mMlgYwALocSd1Uy0U+v*!DFzvPHnc|^VA-2PodeU6S9F+=B{);81 zxD-9UDsasNU)*W5mIp;mjP!gvKz6$U_9xG~$3u`-RvOnC4Y2+!#)g4iU(sGM3*Ig3 zrYWodc%kU2rn&(9nc6i?AS{9tJ7FcvS%fDeE@9611DgfxGVZU1vFYMU=JYVf9Uw5WT9Ip>SNh>J14H;@g?5^b;%VasBK ztx(vOD#F$QGinRPtC*u%qLVOi-UL~*@Vvuh3{SLxZ4!PL=VlRfVOvB2bM|n%ts=@8 z&i81yO%%I0yG1G2eVk<`MFneCUqhTb#RM1U`Gi52%bC-{muLxlg|Q1n9b-VyZb(dK zjAG_2%uoYk>zVTa-bnPqF0}}Tv+zbrBiFsaoWr7(v3n7SXNil&bXV_}h?!bv`qKRC z^v?9*7{LW)1do*vJcVHwV5xYa?mB&K`oY@kkWRhj`yq0mXZ$Y$&hq~ha4o}$J}Ubd zzU(`J@`Hew-O#Ifo$0T7uG6QB4Hdu1GtK8bujg$@>vb;z{%SJ8>xvi#NaiXZ^-|?0 z_(w0nVUr~P%B1pEE*CPq-uFkyzd7($Uah!p!pXb{Yc*Xw8ujBFK|6e}qtzjXpD?N1 zZiYbr3d{LEOMaN)vrK7WINKM=kBHJq<>2i1*X7rWM=Ge_BmM?ZUhy{q`U0()^5>ZD zrbzus^R?+GVB59nI{|COITK%poW6vQ4=@(u z=?BkpQ4adI!#@T6ow5|h_-Ya9^8&+tJc{c8iGLsXHP+{G{UVfGQFhwyt~!G9moOIW z)3A&w`e8{^xap(ITS~9Mti8lG{~@fgHl4)i)~5fB%m0Ob*QTFm_y8bA!DA^98Zt&H6urdNMD-y^Vq%m7vUaHVsAz(5%mWY z_NCaX`6c3Zh5aD%J81WHg}r~$pYpLyAv+^I-#_W^`ITao!WIN8@jl8n#;y}ZC6#!a z;#q|igRffTpF-`f6Thz2Lp5Ty!nW51LbYO-!oFWo5ULaZuCQN3>U9i&QfP65_*t|h zR4-1QLfAFsAF8YlO%V$jJ5qiG59Owa0g3tN*VLhIzrs3eP60Nou&e7^LXF~bg?+q! z2C!=t_RH9A+|Avhus_9K(wf946&9}Djh*ZB3ahStNoy7lC@fIE8}~wAS6FHJOInL~ zTw&d1yKx5oj>66_dr4~*FDR_AYEEdXIIggXRSSW=s<0;~&IwHue^A(ePFx7=O~!5z z@v4r{bg`V$ZP+EAzdAHSd{AKzm%o~Ss+dM8uCmfB(JnDjQnx8IOYCRt24R)$2%RRL zb#cxWzfhd-R1SpZidZvC5$AdjgyxA;arH(0eIz&HO=ca#_6N%Ule-4;u0i$$}-J{v2DmE(Ya7kKQCblZ<>JseMVwb}12=7MR7*N<(!!K#e#Q}xg z65Ne z6PU-?u(-Kysn#WqD(sr7FNeCspA`1H`bR<=#6>s@32`aQ+$6rq*bU-W6;FgVi5D1? zK7Y3OPg&=`y8e5iv&Cx)`*{8Hz}`?;hxf;!bHqu;t`mvM1NYsdOaR6e6^5tRyC z9z7m9Pc&t)XS8i%w!*F|J041iGc(vTTDRDwunz~0hkC@W4EBt+L)Z$N5j!5*DK5)k z&uG2kTE?ys`|^Jo+AZ!>SYG%Kp*`a33cIcNuOUmkjvFAdV9fiE(17TploQyMUL$;g zc#N?d#QJDnI3@ml4%OWto|;r1-X~Vgm7H_Ewc!iJHihl>P6=Nm(h}pS@qY0k#*X;^ zT5+*>zqnpuTBR4*Z3eAvKh20&!7&+uu6!w*<7uX{Tv%|B)7mFtq zHXME*uxAx^OHo?8MEpo$pD8Ltw)?We=E3JL6|X654SfDm@m~syqwX^CmcnMB?lR#y zokshLc41jt_=tGyeS|$BPE;)oe?ZKeC$X0U7mE*y6O7#;1`5s!e^C5+KGn&HdAaz9 z#Qb*@r?tz4cLCS=zfg>fQG^wCZGKw2LX;}(WBG;R3Q?o573FKgSBg^>3`OxhLxu=tU}@+PH#olw}DbvK$HAvXLx;Y~-k zXj$wtc`s;Ji{CP*9MQGn9ma`e68>;q;|vppVeLptdOx+G?H?iXlCq)2o+xu zzFrKdI+FQOaizjK>(kne;#!6Mt>$I#jp7!CCG)Qi-z4r-*duv`;$z}&g*}jWMfg_n zfWnGOwrIDBuPf|n^zd=+GvYLby)@wq;m?USh5ZKY z?iL*ii+ZmJe<5ea?jc3+^Mse|lEug_S&Zy*uVe%#+2#HWMt1p91|z#Xkip0WoA-G5$KoJkN5t=gTeP2u56e3L&W7KHUlKPc>|nzi zz&@cc((|X{GYTU;e=5Gnm>m0Y@l}P<*pG{c7^7J5*YI)iEMsyEC&ZhK4U6hYH|Q^m zOP5H^ei}||KNrs`Y-=82)0WCQv-+Lz&&3BBlVksd=vqc~j|m#zt0J~sVl?(&Q4v2+ zuur@u5n!a*Yhnj;z7il0c}?^yj6CEuv0q{udC0HD7ZpYx@*DA{!pK8@FQ#>n*jF_2 zkUyv%9`n*1y`I5nj^4;%r01V980q z<~e#x+@vs?qqoHE3ZpstyZD^KXpa6a?pGLPfNzV36h;}~+u~aehF$F+;u(cemiG_w zJYzI})deTT-x!lKjU)0|q{|b2vZtM)5Y3euDe8hLwngkTzi-?*?UC}XNC5p;vCdYE2z+Ztgv6|^9w4q zpDFAc#{7Z_+AmyECgw<)sJ*T@FBV(0+`1~Qw394xiP(y1uF7dwrA<l*DR3j3bEx*(<((MnuIW{qyUdu!+kIr zhPJtwD1Tte!?=?*#P@LX>tVWAoRLqpH&qiq)jDP3amxR2(Pdf6m*x2l#Q8ApPc+;- zaT)wN?yg3bOX{=q??kBfc#Pn}5W&CKQZ2sFfwCLY*Zp--$8;KtE`F0oqj;`_MsW`7 zFQvVAcp0Al2&PXW%qM zz?-GNcdaDnmoP4TZzW7}NH-5#3E$K%peJQN4AAqqhcL5#v5e~ z9!alauOQFVslp3ENqJg1Y!IuOnIhBzO$*B)tYOMlX&gG&^ohV!VQ6FYiSYx8_+*aEtHK%B_i8 zPiaZ=Z4LLwq(4OfgIBbqIM6*8a^7WZ8Qr#@^><5Kgw^N4owU=7BU82=J>wtYIN+B5 z1~k-##WV7v$C2Y`J6iI1;~LHRZu&cVZov%dBF6q>Vk}PCZ4-AntG^R5C`xD?L!`{{ zHP6~st|O1Y`{e($t?XS!Z?e25mT|O~@Rw{cH>HPt!wt7_YXYrbL zyXP&y4@?x=8`^K9rZ!p0+!rg>j%nLt)3v{8Ed``!Z|rpKfY=aQsy(Rvaq?Lxe>k>9 z8x{*K>)~4(KS^WrLo|ne5J@z;x&cvU+lK3`iX+H|6~=|n#!{!sFJ?KzC45YMMqHk?HH;(D*%rvIcqq(3M2 zQWaPP#1#ZxL!H?&tpxmmzAwC;QYp>yLk-PN^^lw-17Jm~*tMAtj=u?ZorVr~M zi;$IUx+&C)z^Q31b&u#8v?|26k&je5f2HgMpaCmIxHh6aQ1q()Anfyo zJ{|gKV!HnQGM{m~{wv%j-mXurA$W1*C0KG*-EPz_$JZoa)!@aVR_h5wjav4WT5V_j zWR!aXQ;cKU=c}ioOrF13?5|vItPpeRHXEPQk3j*e4G60n9-(PQTOl0 zxsd!H#xece@Xt^_Qu#}8E`epvWy=%i>&A0>Ugci_YbyT%cwgulZL_wjP7^P}4tI;^ z^gmS>d0y79o>=L5O8eM^8V~vEWY00}YsFImx5sKkFEk-eUriBsR@W}@ROmmL+yNLY zg;tQc+S9{hIi?*9Y!#ceKh%BDvss&j)w)@GzxTtQ1KM4c*L!-kDm~k?z@iCO|_4Eq5KPH+AJegL=7K-xjL%Uao&M)Bw!ses)R-UmqQG+^WxwxRse zgk_NM8_*+q)LZF&N-Hkv@=_c-$4jFtlSo<*B;2R{Isaj8SSyZg zFo(6b!+!7W+V2AAqI{%syLr17hmYN?{Pk z{mX+3JU44}_kB!zwd!T>0Ys`T=(jg^r+J@#dhOljecCthN^cnX!MDsXa_CD@%AN$7l05^%}0nZgL0&Ww>!TDR3@H%sPw4a0G*IozA*Ft{C z)Z&1}+I+xr?Oec#S}$Ns>j#{yr2ymFe!yn!M!;#>9e}554+757z6&@{`z7E)?Ihr0 ztq8B{E!P?WZ`GCn9@Xv!yi@ZA!{W2rRY5;&`67CMo!kCNo0Jz8Z))cPzO7vaDD=DY zbn&?UgS=M!mDlHet=JjAQP7G#@d?05;+KF;;`e|vMSfwcc%PUI*e<35o`rY#TJda- z;5p)>h21QnR_lhGHip|Yl9}Lgn#;pnKFa0Wx%^2kKg#eJQ(k7M=_E%O1Y-IE8Ge%CqYRHR{1(F#3}0sWbB3Cidaq?TiD4VVc7_Rt-3*5rUc&HphM#13jN!K! zY9>iD7*1l?#;~1Xf?=BBFvFt^Z)f-@!($9jFnpPz@UeXu#u(NzT*$DE;Wmb8hDRAb z%J2k3;U@_(h6@>PV|X+`^hX(9ns+|RzhD@{n;6gg7BXC%PxN#?aUNxOCsQ8f@(G3_ zM75p}amKj3kl{9lX@*A`KFaU}LlI`J7@lA#3YfxhA;WD9(+nSlcR%kt!SHAql^6Eh!U-zK!9DiBuL<%+GKk!)*-H439E=lwk?p`MXdY7PpB%V9jsW zF4g|5HR+$$AJ;=hg)z(6VO(U~X53|XJaawmp7oxaJhyuu@I2^w)`Ohedy03r_bKm> zy{~xx=>41b9k18S!yn36jQ6K{&3)!=I7;AsWaPg2$b7?C`33lk2!(jxB#OV{P$FV@ z1$Yv&R(ZmISI^LtCw{-Ud>Ugv5G?Xs{)Wt!JKob`M>LQI1;2lIj9q&)h2Rs7ZHN3fg z2FmwCcU^o5T5I9~Kppwi62OP>ZVPTY@!pCqzK%Uj$8*k=;Q1z?j(;6uHOh|y>NroV zMfqt!T|7f?r{Za1C(7Ru>jA%uH&k(VC^iGWi2V>ZF=7jNegdfD3D;JXe+8)H8CC-2 zUjyRiQgoyITR>g>4mQ)o?*Vo3I&7wkH()JYyahYy;_qS);M=f`hUYsL^z9L!5+QAt z-mVYni;Q)~rN(!SwCBg3zj_9|_jrHntu*V*d8Q{#@8S2Lt@C5!RtN|3%+G!1aYl1# z@@?r{+OKf~k=ynmvki9>xwQMtIk@AZzp8}0QT$fpw+6p4{MO>P4!uu;|4xSA*5kJU zG3ONcVH|5=3Vs{mhfVlx#%~LLTk$&;YhxOIr{i}9e(C2KZMe1;b9e@R&q2PF#OL|^ zdzW@d+@+l(=IdV;{rcmey^7y+#Fa(`-iPYI?<3kZ-b0`rL-`zWjrS4ltH8hMeH{4H z_&uh5)B7T5Kfx!unzx{P>(<4+se!)4f%d*cDm8uD)@h*5-MV%9bSf=N4lYlmb}iWM z5Joj%Hf})tJClQ3(PovkkDIWtkzF`F%v2pLIxv8qSM;U^sSQ&{^>V7yXa<+i#frpW zGBvm%X{UOv{&vewQe#;=vh~>1jL7M;NchUcepZ>0krE^ek8-xsTK2!jPU7DnN+wd= z{dBGz)mTzt(>c_3L!z&@2g*BkW#Y&-V-ly&b*#XJrM-Q9i>-bAeO97p^}ry^kXmY6 zd)n-sLwl0_gDD!0Y%yX6m^jje9sTWz?p-_#DCx*0CDD&V?o9UWSU*78lW_2L4kqlu zHHq_+gNrO{Fg0i=1_tm=9aXzB(c7G4X$eEQtf-QA{a;N>iFDrv2>`vd)sueYN)R-vAr*eV#ktx%z^D-tL+}R zNly;3t(#_yc`q1(OAH=pxAqJq;7_jhgBD@5G>F(gICF*^?wqYCj2;(=<7qiVYB@tJ z?&XdX_JM6m7_2z+T^dp?x}JUN_&lhhwE;o1#%JQ%&gE@0X3fs9qcpC@o*}rRSiEG-l2wbBtZLu9b!o?nC8F~{YB0H{wPUr|o9G)#Zrv*2p$V}k z)os~*z1z{a+u>=q`udV=fK=|d8m^oSK$RAP01=TLWd zGL_mflv!z_t*1w{rFgOQh;CXlJ+gJG%T9DBm-N%DgJl4sdX}WR69a^$x{`YaEIVQM z_8sWh*^hW7TP^8J45UzQPxN;u`{3$`C@CVSLAe#~97uNe!c{Ir^}Izxy?s3k&fmIq zQKI{NEV-q<$v%+Le4PwP<1nlmf>ArIA-g*{y0z3y27*zdS0(n0(Ing9c;Z|!a+J)) zmMf%;s$G*9?A|q6>}tDrXK#O^Z@ik(^qkFNboIKS{?WwFUDm$k$-aTnHLHg9Y){&w z=}WCXtn<9pijEX*7pv`!yLtzcodZPLXrst6MD+Hj z1}PwLU~#Qj?%$0sPVPty^$og7{n-UBmdW(39sm9$i^6t2IFw>^`QYGy3#H*K+21?J zbu`Kh0vR2tm5H6b-H5+Qu_sgNvQ}98l6Gfe2MuR6`F_`~L_aoR<-gRuN|P{kiJel1 zmGD|B?@^!Yl6$PZ$#sc-(9l2@NF7%&;&Hq2UJjugs6;zrDf|kNQQ{fb?(bPcwpN)9 z33t*N1eRSca!z<~=pFrgt@Bx>CH;GQZL6P>stpL>6yHUM+^uCfyRnN7%BHOp(=)?| zovBS9r>qKDYz+|&3v{q|PqOR4020Ff9#GJVFiPbV#TgKpl|~COTwIJmuZk;SLZ*@7 zu$MSZoB@knDv=XAAeT7@E&e#WcYr@HRG-v6wkpY@K37=X=yP$BcC=)FcW*Mq)rb!= z)9mOURX0F6A#=4`0|&T3D(s*ku%ovlUA2I;A%^YQ-gls@cMuq&<@ zBOQuanS)n=n~EhxE|(ETDlmcp!pC}~6&y;YmK0cumB|$e&J-M;#l1Gdlw}`a0*$1f z6r>iN$O1@d`LP(r>cXUQ)rv%FP_AsE(8|iCK%HEI!_vl?2g{+1WJPbkvK*JTXVUGY zO%a}n@X77OCbJGfZX`DDLh6~#CQu&f86ZY(exFYKh~vJb3D*lH~9{Dnu8L+Ej3H`Gq9UFp(G_9q>iuDAPW z$x(Qab?v*7*y@J%jKu)eI1k*>+f5;Y{oXAgGwktd)gn<7ndw*t6M;Bl@1u=KY)|fh zW2_yrP^Mr9f44bhhMGNXgZPUK+mV}y#mVhMJ9koi%hGbzbe1d=ilsJI%|6RMKU=Y6 z|6sD8&hc52BZ3yDQgw7?M?X~Dlc0lCqHkQT#mQ8+-OC5$tO%TFk~UhUHuR=?p?sH> zt&^i=vB;$p`?-|L);qc(S?C$+9?Vw2FA_L^+ld2NnhNl|T@3ba@1>Joww7FZeJa_x zE7{ivkLV_gE;<0P6BRh%4LKVSHXeym1){n{;8U1yS>DUs9XN%c5hB$PZbtSd1sRZb z2V@?!&k7FAt?uyAn%s~543T~R>K%fQs*4Vg%@FKyt`JN5yDcuL6Nws7tFkw-aD3aC zu=@$Y{x;T?fLPxTnK%p~Iws`b^TvVRj5A_c*&r$LdycYdWxE4q90jAH~HE5-W>j@V3647Glb- zJqUumd$^XO6I^R(kH{U6pbZcCa6hKKx8G$4mledB7OJ2x^+=mBncEr~%!HAQV<{gc zUMFbghCl9r#JD(lYTPtu!re5s#Telylh2G5o8(M5U6F{K{ga27OM&9Kgg!*y%(Z8x zGe_iJc^x|T1hM$Gp+SoxX7}P`cXsZi2UC`Zi4<7C(2bKmLY?8OPFw?X`hoZD=-oMl z!yEH+)+A)|1vt)mFlEc1$h%CZhV+}5~hHyWVVL=kb$!wOA%+%3LVPWIw@U`23SkyzJpcGAQV#t&xkXV$TTky?YQ%{Mf)y*&g34b z!y@Fx2n$d}8A&LA1xr_QKSB%_5pjqj&BcdjVB6_RONo*(m_@0gy8TiZjF7!?mMJjq zB~;}OzKDT5Tr5CKw|A~g^e1*oA{{^EwcC=tINHg>maU@YP(LmQait4`whi>sJrGcL zkBY>Hk5+euP?JMJiK1Li-RRv{*+9As`f&V^b4;831&NASL?`q9y-Ax8b?_EjSsEXD zF|nctzc7os5`fF|Rs*Y0>WPXBiZN~FJ1I7=ED;T?$(>ky{kT)=Lo-TFM$*(qBN@8o zt|JkaN>^G^DwjAhSYq2CI#=R2K#`W}$V^x(9jXBNBQ*%GkoUQZdlNY2rx2@B>|I^f zV4|-RVXMCo$|T}Hh$Au-vMH95-I=ua_F^HR5#_4b!s#X>MK`&0d78q5uU$ad z;%)+6IAtqwo^_vcrJv-?e5;eM!>tjfcjBDP6Qa(IgpPKXR_RDIIm9raKG{U0t{qYo zF8W*#dvG=3TuG!v(v3I<=4*izvcE)6TVEd?6IrSDp%gZPOd`t0P`8b2?CdR0<`zPEsi05~hYf6C`=wf>XC{ z9o*HM!tR&3u1c|bZd@)@H-*NgRMWc9R0Sk7}BT7K z1&1X%8I7cZkuqCOt#KJUC}%4(cwQyWg3nTEVn$PY)MMH#AFX4DPYs(ki(Cfy-?(+F ztp4$;H{zn%+Luxz&WcPp6URvhE_hQIR3;@*I60imb#k&MheTHcZGHO^2joQHffYhW zW-T&G65wWBhJPTb6xcP83Uz)nfwWQ(lMIm%8B4O7s-$hl~E+4%F6>{ z%G^aO5+C+dnarw+TL)!hQV0F3M;0v0h3?4K5F_r2oaYzJ>Bg}PGIbrP#drn3+GN2zED-j*XL zz!Q>zp+P|x8>>XS_w0#s=W_v1}WSNmrISPM6;#e0c1-epX> zsTFH7nrz?}DZJHaK?hMH<&dmC{3Zlab4brh>;&JCk|@eL&`&@2fQxo;cjJvx@K4C< z-->^6p0w@6+mWlGgQ%hr54f~#fdofiZ35Nq$mpC?=WT&D8sJ``g@}*(>Vqtak*0lU ztJP3lRwlK|>O7w%fXkSV(Mml=jCMkHp0?s`)@k^6r!w5v%^(xR~(3-5e3#A>fI$1e}Uj${qZnR0_&Cq7hw&Sf@(gevH z_;4KqnzU~>yr@-(CF9GpAUg&-QNPaI#?)A-U$RF(`hk?WS>4ChtrrrgXYwQR)B&ZV zFz~+c2l2<=Xd3YE4nS4MxwnIPEEB}grG*!V>C06X_1>g?i zztwCqxxi9*u{#Lo$vSTg692XTsCRM*vJ%-&PLQ)0r1bF?*gx;d-7DM53L1Sr3w5xVTUxKIg$3+18hJ1(y4U<+0~U(m<$L;EkJW(p7L{#CuU-x| z&MJ0~Pi}Hj3ktI25j1Z^C$FU-NuiE(C0`*QAxO5SZH2J^sf{dHpa(rtY#<$_UB(|1 zS*#Dd*-%T`?1NU4F722?tn0RNBzlg2tY$ccYG6Rn(_r6$-gMz+`NEZ;_Vt zp)KIQ`yc7kkFNmG3^=QdVmA4ew2rgczmGNTgM|{9The>@czDfZBMpeRqCoB-SjUKydr z*4k<5tjv+~LY|xJP0o5HZ>Lsr<x#bfE4+31zK)2j!bY_f$;mo=Zo+q*M3K}bhgP)(gJnl zJGnB2xSa?i#4YBp!_w@>e-2mHrDzTkpwmo~6FUy;>ZN57G#Wbzm761l1afJTAS`l3 z>fOn}-J8_t{+;tc409{3J_U0V<1-Msx0LL(Biq>UFS)fG0H>HTRtgydR}$Z@8v>Lm z6f~PTa@jgkbJGgqPr!p{JfbPr3mwakDgTUi4k~n}a3rsRB$>*OPQ%^fZKaXacY&LN z5!p|M6B#<>Hm=r3`%*PqG6+&w9=lbp<}{ysoi(<073?@#BV47UZwe`ty3lNre`U9C zXH*ni`*@5LTv_+?S3nE7t&;A!eY<6lzd2{7tVYgQXf>UVb0U2^e-hRe1%J|rdhCIR zkpGjNYXt&VRYD(?~);ES9zBKi4q#CXx5r$Cm4FYwY9Trwy^=j14^5qi@xm!Mb+}S`_YSM*H)}YyWQT z==e^D6^d(vSOlbDc1NIC=N#6g^Y_C1SSZ-rEx34g*BN_M?hH6<73f-$byhlP$R((~ z&v8O0h>R~)?o`hF;0|sl?a(2WTFt=U zG?)$h4dR*tx4WTbY;}2gB{pX>WtmgEueMsTlqeWY#j>Kjgu>TuwZKxKW|#6*4xp5+ zQE25LwDW&U@>DEGC;TJ06wJe@$d9P^1vp8}gJwAt1Lq4oQE==+wG{4?;1lT&{O_qb za>sNIEK@nUJGaa7lqzOX#G{x`s>|!~k?q}%EnQjUWv5&0$vUI6OXMbBazD$q$fg-G zy`X-x3yy+|bLh-2ISN0t7mM^||NZVLKspytxt-Dp#C?)-qFdJI=^E((AEFOX9@_oh zw8*wkA@X$d5a>z74z+pE7C$;-DI>2RE2okd7w?vr#c;hy$p@X`<%DLhR1uBRxBvh4 zJi6bJ*^%5Moku&4Ux@YZ#V4h&jVEgipRJL1nBy5$)KKQNZ~O;O8#_@?kH%y|>?FcY z;2mER=jLTB7r=y!D|cj`yAJ(RkfW;zXKKgml_vV5|9>ZXoPD5HCTH$5WA0uqYDOky zBkD_>iCB+-=1haA9ofoRp-XwqBXm@pqmC8y_(|@<>dd!ubd8g?%d_5$e|pxVq)cAF z%iu*%cb!!JAnu#!>8IH9f3qLAdt~o!Xk@B4PKDJI?2tSB3fHq)x!iryOEI@PWG@U z@2%*7qvbh=E*wkFaO*n$f*E(LbKhJ0F|5$?-dd`yIDK;$R=0B+r9GK8E4#_PCF_83D>L{~X7evdqK zP(C5g-88|J0*vHvt~s0(S?&{Zqor+BKI@XxOZNyAd+8WK(OBEr$mJmWrCR~=7w1`_lhC-Ge6$_n$iw6~k>a#DBaZV}NBbq& zE$f-NyCPrKrEmOy=QY{m_!3M)?s0tNve1@{XUwdN$j4*uYajWT$#pm0OJ}8#hjfag z&YqM#CDVpYmmuVRbR9B)5?$svds8+(I!>64jJ24G|7lNx-{zq!u(2ObYu-&buL@DCt+!r`j0-zAma{L$eS$cMOq&l`?j0Q2cSo{y@qH>hKJ7^@10 z>k18{B$~ciuhyz_>_B#83+iUj03)>kTR4odVU`PvH1t#Dja~o~gsZ%|iBXW-1qwCg zV6ad)dI*|D56KbEC(VcFGLjz7_nBaaZt2USn_2%0d}M*ha0d^3WjH`1Oka-wOE62) zYu%8|wibTx_mkxGHAc|q*MWuoh53|BkY%+7-CPE*yxK!)7L|n z2f-5#WA4&lh@`&}ofDnor!xP4OpkU&H{NhW}4{*8$d4vi zE&*3Wm&LAF!QR(`f-5RkR$Q^IyhVJT9}4<7(|0X3?^hmKOjU_040WO!Gw-R@G$85z!VUZIR|e- zAjlo<>{*#W3eRA~iEX>&OXjYR%8 z(2fwOh^5J56HuQ7R46>UpwS6W_z(RSIyUfW)IS>_7Ah=Vk;XKGBN&|Oyy&mHIp3JZ z+3FdauXB#;(IXUQT;*cmmlj319g$>fya2F#x}5{TbObEWhXyp^BLu5Nh4urg zil=B51g-cWtgA%1=$&Bj_k;J59}=57Ac6eLi(I&tFB8jG2vHgcCLmEyzCi_nDoqzK zgdjjL|v|T5DpWP%v_kk%-Z+ei_DbQOfcSO9paq^zl}9y#aJ( zAv#fo%PBDEu!cjha$~w-N8@*v=Jh@YybM&uROPn~31;-=P3(yuW5>Vi8$jok`XT>R zHnO6BDrE;4XPqVcKU%|=&HeY%@%e>5w~vYXtC9ird075s!NBzMFDP+-&p!@U!h9TK zu=rLCmJUg<2o^AXn3upOo5=$BL$EmDMdNW6-&P$>34p}-5)`-@Vu|FTTsnlFA;B{S z{vzNn6#jhSZz5X`SqS-4O%uIctbplCybg0C@-9)tMI`7Uk20{hAHvos_C zrY1iWzz@L}!-NbaRy@3r3+Kn6*_rb~AhbC&O2i-~n7{$? zVRQ@8Y18r+$pMUkfRtSR0x1XZx;6kodUAytM+E~93GjcQ5JMCK?SNrm?lm!nJOGi% z)&tqd18gV?;CC?jddSb1FWbh0i31>+6{3G9&NC7={oIdeVexqB;@Lbs}N{ zoH7Q3089yBL`ghXNjw*Mi!|W^Kqce?<@iugIs8Hi#n1^MlRp+D6gl{!fdQ&rc`ecc z4Z$N-P!@VMf_^muvIo3Ize$r8N_&U0Nod&!K0KKSnbASMbdWC{_W+hQ4a?-9KxjSiQ3=2?Ba~RXel=Ug(N}Sfv%L$H zR8y}#NTKo_Y2V?~1hj{c5SK2szvU6w4vX&O1C959jYPk}A6!Tt7VaC~QgfiOP#QRJ z@w{6<5UrcGBIxAn5e<66B++!4qotYga$Bcbi3U|z(F)B}(HV55ja1QNXrGZV5@q=x z`;#?wkiH1n$qu)wtwbdrY!wE*iEw6>)^|ngtd>aZ6H-&@7uqZ_vY+a!|Fi$?H9%l+ zT`6iR8C=#1tBRNm9x6Y?CNQ{HPIpfj8u_0%CP z{lV!~s1FKepN{l8OIE15JIk*qe{`P>YBBW534K*YA9sSmM74?0!m?71|MJ&O#WzNX z50fgS7YOer(J7&pLA%>fiIU)R7wm09u=w z0154i$xZcvv#0y2 z6)XZgP#Hi^YidQFk0mt))UJRI9edD|Byfr|SO&6R^R21rW0WWm| z$Aub{I!nz)lR?1s!BilNYs12sc%dtSGb{R1BC4y3j~1oQz_AME3POfa<|^+o^;}16 zcu;>~rfvRd*E0@L+tyy5cVTr!p|+4JWG`LjgAcU=}86KCKMFxUYMf!j;8KEgSVUN4cm%1?IV?1%%uu+7u3<80KlgBO7&mU5eKzQkqFJOpOiMx&sym9p z(AA5K2)08>(E6+F~FE<#5q5J1syC^+3ISIS-J=1e*D9!eE_rz92V_VX5Y zr@Eo!IJ$g=24gY^6tRKoMNr@-)TT61AX}FW-H6iZHlX$WBNi<-sKAp#r^+X-Q-_=!BPKQiZrcwMOCd9-|P~g2ug3TA{UXkEs*Td-0V8FR6lNx=WZ?FbydKncn5c30Zne^h6u4EnL5Mm{rjCqWX)J z2~@j@CewhaS326xY4l5{wR0+U7p=a*eZzMdRZO>`i58BxF_{d4wV&dl=(@;FfLLIF zT$aeiqqr;%j43tv4$7gtk-r(U4+Y()!llBgNT}$N@tLWeyQIVCI-)&9qg<5f;W*Qp z>P1;9-4tHbO_5xByfmY8da4}*h8lDX9NX>GqhG(0iC2b{SB@y#{%XJQ!$Y&Q(AV4> zcbW<|_nf+-v9<6#-Szuk867sq=I|!>f(xRgs73C*Z&+~_-F6RIJWV}+ z!jZWAZ>Bj~a!37W)c4tnUhAq3?V9?=fa&igj=uP)JctxBFG-d^Zb)H=8;GyqK6zTbWXd8KZ@RSYL zPldSq&)Ven1GP5z+SklqU)l8&1*qlJ%@}l>dNBF)v@OGb)r#)ZXHjF3_d>SUb7=(2 z@1Dc4l)~Q`JoeciB}u1BbsoOzlXFt)^Yhg7YugLNB?%S9`#7!smV({n4eccYLD0G( zgO9oC{Oq~B!Ds9buDLPywl@2`tn}e}?i;<}O8MjL#Bwc8$(rgueXH|tH9t4X^UJf) zNeC0i&db$xd^1>Y*~mxDRZFY~>~4#D)?b!j5wgeA-JN zQGM&Nm}5aYakqPE6x*Ha8y*rGUEr^E<6Ygs>#TUM0H^24u^KboqTZUc{^lg-d4>2E zsHu&exSsW_5pC0h-aTwtGiuk#mZm{_15WT&xSm)tL9OXQtB&i_o#qcxrF~oGc--mC z_1LnHxSlTb5EIKzERR9yu+&Es`Qt@zy@6i=uViXd15iAY=}C#HJ}e#$IJOIM0%s7E z4P~ulX9R9wg4mf9W^7uvk)WwMJt5sbO_Jr{6BZsJI}VRE+04iyvd5= z?i+_r5q&o~FK6>D^_CM^PM$0ET-+mrer=S*bM5wjRcy7if%Ja7AyCs7s~bPe>|Sd8 zl$gq#(EeNft}nKk|5L5Qp|sJ383EPPcRjy8eY8G#VPZH`pJZ{=5G^zY)WR&Ne zJ;QF7oAz+j={0)K;8|-=E?Z_<8C$T&%m+i{qB8 zxcd4KwV}bvFx&q??oducO-W?Qo3lAHJ)8!FO3R{OP8m2_OLlGe`Ms^{9rjzkY8ijw zhgj`{zLBDtBH@5vGJa&Q=ic6O08gK3WN|Cj?MfXd#;RW1W_njq~JN%#DzGvPtJaA<0_XMjv|D1-BgAN7`8q|q{)@=Ef5Wic~Ec&i= z^AoqSN0%HO&#G|H&oWqq{o8RPUPSSco5qbCiUoj?z%l9zd=w&*OfCiSSWK`YX$`#0 znEfdq%B#Y&LR{46&-tHfA8qfVG$S0VWL&@qB~(1HW(95qM(EI<@Rt}NDBXnnc%)f0 zSN*G8P(}QM0m~?a!V{i^`=KXqkM)^$oi`?ETXXR2kSzz@Y?;T8#OrKSkKeL!#RbCi zczU-(;`2tFxowsg*B7s~(KfoVcpF<_G}zeV?9Kb?wM{*;wwO*Z5T;o?jTmefM%>Eg zs0B7x5574VtDE{d^@+A`PSmL8#v!B4Hw2uW=o-AYttvaBpJDH)B%Ov3;?9Q`mw(Uh zdgW2|8;QC_fSFI!we!iPVgA)Ub4<2y5K2L5l}( z3FHjSn{jJp*sapi<2~Rw^=~KZ&B>XRaH{mg zK9@;tnZls*WqVCi9oEg@u|nUM^s3CMf7x{5kn^pQspds-A8I4BZkmr{aFbJO?$obu zI{A&|!-C5iCPm9`HyOAOS}QDMf*{LGBXFE5nDuYQ+{C9cLC0cA zMFypjf)=dsp#i>s;=90>Q!LL8f@-jBhLHJZBWr1f;}?mb1$H}8%-K63e+ZevnKJMJCl zn+%DVqWOXtBHFKg?O~72-@fhgcu_1rQ-659@B8RgOZ(kCku{L)_q=)W@MjmRza92C z?@{pNNbgC@8{d;@6Sitb=g;f6Qko>VIeS-aPl=i%SOx?wY-q0+GnotW?qCh5ebQHQ!PC^g@Kki1gcm_K>F-vWI z)z0cG@5QMn`s^w??LR(qq-lBv9ny9_rsEj z{K4;|x5zeJFT8R%aY0_guBz0A9X1XI-CQ*m&(L|bW74vd_`4SWZLK{ymM<3b=H0u$ zdUko0_NLthy7SKE8BW>g^u)$Vbd=IHORuxLSQz??ZIgNKQ~!I?%PHgbTO@9c&|h0$ zTzc!Jc=+{SO^(>_CXep>xkz9<_iJ9zvmZxgj$3-(xVgEzMh)+#q2{>q3oeoTsz{;Q zf|7ug>^-vsqw2S-*ZAL0n Date: Mon, 26 Feb 2018 11:35:37 +0100 Subject: [PATCH 26/27] fix client build --- src/Disco/Disco/MockClient/Main.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Disco/Disco/MockClient/Main.fs b/src/Disco/Disco/MockClient/Main.fs index d7c0deac..c1c98de8 100644 --- a/src/Disco/Disco/MockClient/Main.fs +++ b/src/Disco/Disco/MockClient/Main.fs @@ -608,6 +608,7 @@ Usage: Tier = Tier.Client UseColors = true Level = LogLevel.Debug + Fields = LogEventFields.Default } let result = From 1fd031de2f78dda9c16bcf1f8ffcde5e81ddc2e3 Mon Sep 17 00:00:00 2001 From: Karsten Gebbert Date: Mon, 26 Feb 2018 12:45:28 +0100 Subject: [PATCH 27/27] increase timeout value in test --- .../Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Disco/Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs b/src/Disco/Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs index e6302629..00fa93ef 100644 --- a/src/Disco/Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs +++ b/src/Disco/Disco/Tests/Core/Disco/AddedMemberShouldHaveCorrectState.fs @@ -126,7 +126,7 @@ module AddedMemberShouldHaveCorrectState = // we have to wait here because under some circumstances (when LeaderChange happens, and new // leader socket gets created and local state is forwarded to the leader) CommandBatch gets // sent 3x rather than 2x causing the next expectations to fail. - do updateDone.WaitOne(System.TimeSpan.FromSeconds 2.0) |> ignore + do updateDone.WaitOne(System.TimeSpan.FromSeconds 30.0) |> ignore Expect.equal service1.State.Project.Config.Sites