{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
module Raft.NodeState where
import Protolude
import qualified Data.Serialize as S
import Data.Sequence (Seq(..))
import Raft.Log
import Raft.Types
data Mode
= Follower
| Candidate
| Leader
deriving (Show)
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
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 where
ResultState :: Transition init res -> NodeState res -> ResultState init
deriving instance Show (ResultState init)
followerResultState
:: Transition init 'Follower
-> FollowerState
-> ResultState init
followerResultState transition fstate =
ResultState transition (NodeFollowerState fstate)
candidateResultState
:: Transition init 'Candidate
-> CandidateState
-> ResultState init
candidateResultState transition cstate =
ResultState transition (NodeCandidateState cstate)
leaderResultState
:: Transition init 'Leader
-> LeaderState
-> ResultState init
leaderResultState transition lstate =
ResultState transition (NodeLeaderState lstate)
data RaftNodeState where
RaftNodeState :: { unRaftNodeState :: NodeState s } -> RaftNodeState
nodeMode :: RaftNodeState -> Mode
nodeMode (RaftNodeState rns) =
case rns of
NodeFollowerState _ -> Follower
NodeCandidateState _ -> Candidate
NodeLeaderState _ -> Leader
initRaftNodeState :: RaftNodeState
initRaftNodeState =
RaftNodeState $
NodeFollowerState FollowerState
{ fsCommitIndex = index0
, fsLastApplied = index0
, fsCurrentLeader = NoLeader
, fsLastLogEntryData = (index0, term0)
, fsTermAtAEPrevIndex = Nothing
}
deriving instance Show RaftNodeState
data NodeState (a :: Mode) where
NodeFollowerState :: FollowerState -> NodeState 'Follower
NodeCandidateState :: CandidateState -> NodeState 'Candidate
NodeLeaderState :: LeaderState -> NodeState 'Leader
deriving instance Show (NodeState v)
data CurrentLeader
= CurrentLeader LeaderId
| NoLeader
deriving (Show, Eq, Generic)
instance S.Serialize CurrentLeader
data FollowerState = FollowerState
{ fsCurrentLeader :: CurrentLeader
, fsCommitIndex :: Index
, fsLastApplied :: Index
, fsLastLogEntryData :: (Index, Term)
, fsTermAtAEPrevIndex :: Maybe Term
} deriving (Show)
data CandidateState = CandidateState
{ csCommitIndex :: Index
, csLastApplied :: Index
, csVotes :: NodeIds
, csLastLogEntryData :: (Index, Term)
} deriving (Show)
type ClientReadReqs = Map Int (ClientId, Int)
data LeaderState = LeaderState
{ lsCommitIndex :: Index
, lsLastApplied :: Index
, lsNextIndex :: Map NodeId Index
, lsMatchIndex :: Map NodeId Index
, lsLastLogEntryData
:: ( Index
, Term
, Maybe EntryIssuer
)
, lsReadReqsHandled :: Int
, lsReadRequest :: ClientReadReqs
} deriving (Show)
setLastLogEntryData :: NodeState ns -> Entries v -> NodeState ns
setLastLogEntryData nodeState entries =
case entries of
Empty -> nodeState
_ :|> e ->
case nodeState of
NodeFollowerState fs ->
NodeFollowerState fs
{ fsLastLogEntryData = (entryIndex e, entryTerm e) }
NodeCandidateState cs ->
NodeCandidateState cs
{ csLastLogEntryData = (entryIndex e, entryTerm e) }
NodeLeaderState ls ->
NodeLeaderState ls
{ lsLastLogEntryData = (entryIndex e, entryTerm e, Just (entryIssuer e)) }
getLastLogEntryData :: NodeState ns -> (Index, Term)
getLastLogEntryData nodeState =
case nodeState of
NodeFollowerState fs -> fsLastLogEntryData fs
NodeCandidateState cs -> csLastLogEntryData cs
NodeLeaderState ls -> let (peTerm, peIndex, _) = lsLastLogEntryData ls
in (peTerm, peIndex)
getLastAppliedAndCommitIndex :: NodeState ns -> (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 -> Bool
isFollower nodeState =
case nodeState of
NodeFollowerState _ -> True
_ -> False
isCandidate :: NodeState s -> Bool
isCandidate nodeState =
case nodeState of
NodeCandidateState _ -> True
_ -> False
isLeader :: NodeState s -> Bool
isLeader nodeState =
case nodeState of
NodeLeaderState _ -> True
_ -> False