{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Raft.RPC where
import Protolude
import Data.Serialize
import Raft.Log
import Raft.Types
class RaftSendRPC m v where
sendRPC :: NodeId -> RPCMessage v -> m ()
class Show (RaftRecvRPCError m v) => RaftRecvRPC m v where
type RaftRecvRPCError m v
receiveRPC :: m (Either (RaftRecvRPCError m v) (RPCMessage v))
data RPCMessage v = RPCMessage
{ sender :: NodeId
, rpc :: RPC v
} deriving (Show, Generic, Serialize)
data RPC v
= AppendEntriesRPC (AppendEntries v)
| AppendEntriesResponseRPC AppendEntriesResponse
| RequestVoteRPC RequestVote
| RequestVoteResponseRPC RequestVoteResponse
deriving (Show, Generic, Serialize)
class RPCType a v where
toRPC :: a -> RPC v
instance RPCType (AppendEntries v) v where
toRPC = AppendEntriesRPC
instance RPCType AppendEntriesResponse v where
toRPC = AppendEntriesResponseRPC
instance RPCType RequestVote v where
toRPC = RequestVoteRPC
instance RPCType RequestVoteResponse v where
toRPC = RequestVoteResponseRPC
rpcTerm :: RPC v -> Term
rpcTerm = \case
AppendEntriesRPC ae -> aeTerm ae
AppendEntriesResponseRPC aer -> aerTerm aer
RequestVoteRPC rv -> rvTerm rv
RequestVoteResponseRPC rvr -> rvrTerm rvr
data NoEntriesSpec
= FromHeartbeat
| FromClientReadReq Int
deriving (Show)
data AppendEntriesSpec v
= FromIndex Index
| FromNewLeader (Entry v)
| FromClientWriteReq (Entry v)
| NoEntries NoEntriesSpec
deriving (Show)
data AppendEntriesData v = AppendEntriesData
{ aedTerm :: Term
, aedLeaderCommit :: Index
, aedEntriesSpec :: AppendEntriesSpec v
} deriving (Show)
data AppendEntries v = AppendEntries
{ aeTerm :: Term
, aeLeaderId :: LeaderId
, aePrevLogIndex :: Index
, aePrevLogTerm :: Term
, aeEntries :: Entries v
, aeLeaderCommit :: Index
, aeReadRequest :: Maybe Int
} deriving (Show, Generic, Serialize)
data AppendEntriesResponse = AppendEntriesResponse
{ aerTerm :: Term
, aerSuccess :: Bool
, aerReadRequest :: Maybe Int
} deriving (Show, Generic, Serialize)
data RequestVote = RequestVote
{ rvTerm :: Term
, rvCandidateId :: NodeId
, rvLastLogIndex :: Index
, rvLastLogTerm :: Term
} deriving (Show, Generic, Serialize)
data RequestVoteResponse = RequestVoteResponse
{ rvrTerm :: Term
, rvrVoteGranted :: Bool
} deriving (Show, Generic, Serialize)