{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
module Raft.Log where
import Protolude
import Data.Serialize
import Data.Sequence (Seq(..), (|>))
import Raft.Types
data EntryIssuer
= ClientIssuer ClientId
| LeaderIssuer LeaderId
deriving (Show, Generic, Serialize)
data EntryValue v
= EntryValue v
| NoValue
deriving (Show, Generic, Serialize)
data Entry v = Entry
{ entryIndex :: Index
, entryTerm :: Term
, entryValue :: EntryValue v
, entryIssuer :: EntryIssuer
} deriving (Show, Generic, Serialize)
type Entries v = Seq (Entry v)
class Monad m => RaftWriteLog m v where
type RaftWriteLogError m
writeLogEntries
:: Exception (RaftWriteLogError m)
=> Entries v -> m (Either (RaftWriteLogError m) ())
data DeleteSuccess v = DeleteSuccess
class Monad m => RaftDeleteLog m v where
type RaftDeleteLogError m
deleteLogEntriesFrom
:: Exception (RaftDeleteLogError m)
=> Index -> m (Either (RaftDeleteLogError m) (DeleteSuccess v))
class Monad m => RaftReadLog m v where
type RaftReadLogError m
readLogEntry
:: Exception (RaftReadLogError m)
=> Index -> m (Either (RaftReadLogError m) (Maybe (Entry v)))
readLogEntriesFrom
:: Exception (RaftReadLogError m)
=> Index -> m (Either (RaftReadLogError m) (Entries v))
readLastLogEntry
:: Exception (RaftReadLogError m)
=> m (Either (RaftReadLogError m) (Maybe (Entry v)))
default readLogEntriesFrom
:: Exception (RaftReadLogError m)
=> Index
-> m (Either (RaftReadLogError m) (Entries v))
readLogEntriesFrom idx = do
eLastLogEntry <- readLastLogEntry
case eLastLogEntry of
Left err -> pure (Left err)
Right Nothing -> pure (Right Empty)
Right (Just lastLogEntry)
| entryIndex lastLogEntry < idx -> pure (Right Empty)
| otherwise -> fmap (|> lastLogEntry) <$> go (decrIndexWithDefault0 (entryIndex lastLogEntry))
where
go idx'
| idx' < idx || idx' == 0 = pure (Right Empty)
| otherwise = do
eLogEntry <- readLogEntry idx'
case eLogEntry of
Left err -> pure (Left err)
Right Nothing -> panic "Malformed log"
Right (Just logEntry) -> fmap (|> logEntry) <$> go (decrIndexWithDefault0 idx')
type RaftLog m v = (RaftReadLog m v, RaftWriteLog m v, RaftDeleteLog m v)
type RaftLogExceptions m = (Exception (RaftReadLogError m), Exception (RaftWriteLogError m), Exception (RaftDeleteLogError m))
data RaftLogError m
= RaftLogReadError (RaftReadLogError m)
| RaftLogWriteError (RaftWriteLogError m)
| RaftLogDeleteError (RaftDeleteLogError m)
updateLog
:: forall m v.
( RaftDeleteLog m v, Exception (RaftDeleteLogError m)
, RaftWriteLog m v, Exception (RaftWriteLogError m)
)
=> Entries v
-> m (Either (RaftLogError m) ())
updateLog entries =
case entries of
Empty -> pure (Right ())
e :<| _ -> do
eDel <- deleteLogEntriesFrom @m @v (entryIndex e)
case eDel of
Left err -> pure (Left (RaftLogDeleteError err))
Right DeleteSuccess -> first RaftLogWriteError <$> writeLogEntries entries