{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}
module Raft.NodeState where
import Protolude
import Data.Sequence (Seq(..))
import Raft.Client
import Raft.Log
import Raft.Types
data Transition (init :: Mode) (res :: Mode) where
StartElection :: Transition 'Follower 'Candidate
HigherTermFoundFollower :: Transition 'Follower 'Follower
RestartElection :: Transition 'Candidate 'Candidate
DiscoverLeader :: Transition 'Candidate 'Follower
HigherTermFoundCandidate :: Transition 'Candidate 'Follower
BecomeLeader :: Transition 'Candidate 'Leader
HandleClientReq :: Transition 'Leader 'Leader
SendHeartbeat :: Transition 'Leader 'Leader
DiscoverNewLeader :: Transition 'Leader 'Follower
HigherTermFoundLeader :: Transition 'Leader 'Follower
Noop :: Transition init init
deriving instance Show (Transition init res)
data ResultState init v where
ResultState
:: Show v
=> Transition init res
-> NodeState res v
-> ResultState init v
deriving instance Show v => Show (ResultState init v)
followerResultState
:: Show v
=> Transition init 'Follower
-> FollowerState v
-> ResultState init v
followerResultState transition fstate =
ResultState transition (NodeFollowerState fstate)
candidateResultState
:: Show v
=> Transition init 'Candidate
-> CandidateState v
-> ResultState init v
candidateResultState transition cstate =
ResultState transition (NodeCandidateState cstate)
leaderResultState
:: Show v
=> Transition init 'Leader
-> LeaderState v
-> ResultState init v
leaderResultState transition lstate =
ResultState transition (NodeLeaderState lstate)
data RaftNodeState v where
RaftNodeState :: { unRaftNodeState :: NodeState s v } -> RaftNodeState v
deriving instance Show v => Show (RaftNodeState v)
nodeMode :: RaftNodeState v -> Mode
nodeMode (RaftNodeState rns) =
case rns of
NodeFollowerState _ -> Follower
NodeCandidateState _ -> Candidate
NodeLeaderState _ -> Leader
initRaftNodeState :: RaftNodeState v
initRaftNodeState =
RaftNodeState $
NodeFollowerState FollowerState
{ fsCommitIndex = index0
, fsLastApplied = index0
, fsCurrentLeader = NoLeader
, fsLastLogEntry = NoLogEntries
, fsTermAtAEPrevIndex = Nothing
, fsClientReqCache = mempty
}
data NodeState (a :: Mode) v where
NodeFollowerState :: FollowerState v -> NodeState 'Follower v
NodeCandidateState :: CandidateState v -> NodeState 'Candidate v
NodeLeaderState :: LeaderState v -> NodeState 'Leader v
deriving instance Show v => Show (NodeState s v)
data FollowerState v = FollowerState
{ fsCurrentLeader :: CurrentLeader
, fsCommitIndex :: Index
, fsLastApplied :: Index
, fsLastLogEntry :: LastLogEntry v
, fsTermAtAEPrevIndex :: Maybe Term
, fsClientReqCache :: ClientWriteReqCache
} deriving (Show)
data CandidateState v = CandidateState
{ csCommitIndex :: Index
, csLastApplied :: Index
, csVotes :: NodeIds
, csLastLogEntry :: LastLogEntry v
, csClientReqCache :: ClientWriteReqCache
} deriving (Show)
data ClientReadReqData = ClientReadReqData
{ crrdClientId :: ClientId
, crrdReadReq :: ClientReadReq
} deriving (Show)
type ClientReadReqs = Map Int (ClientReadReqData, Int)
type ClientWriteReqCache = Map ClientId (SerialNum, Maybe Index)
data LeaderState v = LeaderState
{ lsCommitIndex :: Index
, lsLastApplied :: Index
, lsNextIndex :: Map NodeId Index
, lsMatchIndex :: Map NodeId Index
, lsLastLogEntry :: LastLogEntry v
, lsReadReqsHandled :: Int
, lsReadRequest :: ClientReadReqs
, lsClientReqCache :: ClientWriteReqCache
} deriving (Show)
setLastLogEntry :: NodeState s v -> Entries v -> NodeState s v
setLastLogEntry nodeState entries =
case entries of
Empty -> nodeState
_ :|> e -> do
let lastLogEntry = LastLogEntry e
case nodeState of
NodeFollowerState fs ->
NodeFollowerState fs { fsLastLogEntry = lastLogEntry }
NodeCandidateState cs ->
NodeCandidateState cs { csLastLogEntry = lastLogEntry }
NodeLeaderState ls ->
NodeLeaderState ls { lsLastLogEntry = lastLogEntry }
getLastLogEntry :: NodeState ns v -> LastLogEntry v
getLastLogEntry nodeState =
case nodeState of
NodeFollowerState fs -> fsLastLogEntry fs
NodeCandidateState cs -> csLastLogEntry cs
NodeLeaderState ls -> lsLastLogEntry ls
getLastLogEntryIndex :: NodeState ns v -> Index
getLastLogEntryIndex = lastLogEntryIndex . getLastLogEntry
getCommitIndex :: NodeState ns v -> Index
getCommitIndex nodeState =
case nodeState of
NodeFollowerState fs -> fsCommitIndex fs
NodeCandidateState cs -> csCommitIndex cs
NodeLeaderState ls -> lsCommitIndex ls
getLastAppliedAndCommitIndex :: NodeState ns v -> (Index, Index)
getLastAppliedAndCommitIndex nodeState =
case nodeState of
NodeFollowerState fs -> (fsLastApplied fs, fsCommitIndex fs)
NodeCandidateState cs -> (csLastApplied cs, csCommitIndex cs)
NodeLeaderState ls -> (lsLastApplied ls, lsCommitIndex ls)
isFollower :: NodeState s v -> Bool
isFollower nodeState =
case nodeState of
NodeFollowerState _ -> True
_ -> False
isCandidate :: NodeState s v -> Bool
isCandidate nodeState =
case nodeState of
NodeCandidateState _ -> True
_ -> False
isLeader :: NodeState s v -> Bool
isLeader nodeState =
case nodeState of
NodeLeaderState _ -> True
_ -> False