Basic Paxos in Haskell

paxos.rst.lhs

> module Paxos.Basic where

> import Data.List (maximumBy)
> import Data.Maybe (catMaybes)

Phase 1a: Prepare
=================
A Proposer (the leader) creates a proposal identified with a number N. This
number must be greater than any previous proposal number used by this Proposer.
Then, it sends a Prepare message containing this proposal to a Quorum o
Acceptors.

> newtype ProposalId = ProposalId Int
>   deriving (Show, Eq, Ord)

> data Prepare = Prepare ProposalId
>   deriving (Show)

> startRound :: Int -> v -> ProposalId -> (ProposerState v, [Action v])
> startRound quorum' value proposalId = (state, [BroadcastPrepare Acceptors (Prepare proposalId)])
>   where
>     state = ProposerState { quorum = quorum'
>                           , proposedValue = value
>                           , currentProposal = proposalId
>                           , promises = []
>                           }

Phase 1b: Promise
=================
If the proposal's number N is higher than any previous proposal number received
from any Proposer by the Acceptor, then the Acceptor must return a promise to
ignore all future proposals having a number less than N. If the Acceptor
accepted a proposal at some point in the past, it must include the previous
proposal number and previous value in its response to the Proposer.

> data Promise v = Promise ProposalId (Maybe (AcceptedValue v))
>   deriving (Show)

> handlePrepare :: AcceptorState v -> Node -> Prepare -> (AcceptorState v, [Action v])
> handlePrepare state proposer (Prepare n)
>     | n > promised state =
>         (state { promised = n }, [SendPromise proposer (Promise n (accepted state))])

Otherwise, the Acceptor can ignore the received proposal. It does not have to
answer in this case for Paxos to work. However, for the sake of optimization,
sending a denial (Nack) response would tell the Proposer that it can stop its
attempt to create consensus with proposal N.

>     | otherwise = (state, [SendNack proposer (Nack (promised state))])

> data Nack = Nack ProposalId
>   deriving (Show)

Phase 2a: Accept Request
========================
If a Proposer receives enough promises from a Quorum of Acceptors, it needs to
set a value to its proposal. If any Acceptors had previously accepted any
proposal, then they'll have sent their values to the Proposer, who now must set
the value of its proposal to the value associated with the highest proposal
number reported by the Acceptors. If none of the Acceptors had accepted a
proposal up to this point, then the Proposer may choose any value for its
proposal.

> handlePromise :: ProposerState v -> Promise v -> Either String (ProposerState v, [Action v])
> handlePromise state (Promise proposalId acceptedValue)
>     | proposalId < currentProposal state =
>         Right (state, [])
>     | proposalId > currentProposal state =
>         Left "Received Promise for future ProposalId"
>     | length promises' < quorum state =
>         Right (state', [])

The Proposer sends an Accept Request message to a Quorum of Acceptors with the
chosen value for its proposal.

>     | otherwise =
>         Right (state', [BroadcastAccept Acceptors (Accept proposalId value)])
>   where
>     promises' = acceptedValue : promises state
>     state' = state { promises = promises' }
>     accepteds = catMaybes promises'
>     (AcceptedValue _ acceptedValue') = maximumBy compareAccepteds accepteds
>     value = if null accepteds then proposedValue state else acceptedValue'
>     compareAccepteds (AcceptedValue p1 _) (AcceptedValue p2 _) = compare p1 p2

> data Accept v = Accept ProposalId v
>   deriving (Show)

> handleNack :: ProposerState v -> Nack -> (ProposerState v, [Action v])
> handleNack state (Nack proposalId)
>     | proposalId < currentProposal state = (state, [])
>     | otherwise = (state, [Restart proposalId])

Phase 2b: Accepted
==================
If an Acceptor receives an Accept Request message for a proposal N, it must
accept it if and only if it has not already promised to only consider proposals
having an identifier greater than N. In this case, it should register the
corresponding value v and send an Accepted message to the Proposer and every
Learner. Else, it can ignore the Accept Request.

> data Accepted v = Accepted ProposalId v
>   deriving (Show)

> handleAccept :: AcceptorState v -> Node -> Accept v -> (AcceptorState v, [Action v])
> handleAccept state proposer (Accept proposalId value)
>     | promised state > proposalId = (state, [])
>     | otherwise = (state', [SendAccepted proposer msg, BroadcastAccepted Learners msg])
>   where
>     state' = state { accepted = Just (AcceptedValue proposalId value) }
>     msg = Accepted proposalId value

Data Structures
===============

> data Node = Node
>   deriving (Show, Eq)

> data AcceptedValue v = AcceptedValue ProposalId v
>   deriving (Show)

> data AcceptorState  v= AcceptorState { promised :: ProposalId
>                                      , accepted :: Maybe (AcceptedValue v)
>                                      }

> data ProposerState v = ProposerState { quorum :: Int
>                                      , proposedValue :: v
>                                      , currentProposal :: ProposalId
>                                      , promises :: [Maybe (AcceptedValue v)]
>                                      }

> data BroadcastGroup = Acceptors
>                     | Learners
>   deriving (Show)

> data Action v = BroadcastPrepare BroadcastGroup Prepare
>               | SendPromise Node (Promise v)
>               | SendNack Node Nack
>               | SendAccept Node (Accept v)
>               | BroadcastAccept BroadcastGroup (Accept v)
>               | SendAccepted Node (Accepted v)
>               | BroadcastAccepted BroadcastGroup (Accepted v)
>               | Restart ProposalId
>   deriving (Show)

Original description taken from Wikipedia_.

.. _Wikipedia: http://en.wikipedia.org/wiki/Paxos_(computer_science)

> main :: IO ()
> main = undefined