Simple and very dumb implementation of Bully leader election algorithm. Just to test Cloud Haskell.

bully.hs

{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, DeriveGeneric #-}

import Control.Monad
import Data.Binary
import Data.Typeable
import GHC.Generics
import Text.Printf
import Control.Distributed.Process
import Control.Distributed.Process.Closure
import Control.Distributed.Process.Node
import Network.Transport.TCP (createTransport, defaultTCPParameters)


data Ping = Ping ProcessId deriving (Typeable, Generic)
instance Binary Ping

data Pong = Pong ProcessId deriving (Typeable, Generic)
instance Binary Pong

data Leader = Leader ProcessId deriving (Typeable, Generic)
instance Binary Leader

workerCount = 10

worker :: Maybe ProcessId -> Bool -> [ProcessId] -> Process ()
worker leader gpa net = do
    self <- getSelfPid
    result <- receiveTimeout 5000000 [
            match $ \(Ping pid) -> do
                say $ printf "got ping from %s" (show pid)
                send pid (Pong self)
                return (leader, gpa, net),
            match $ \(Pong pid) -> do
                say $ printf "got alive from %s" (show pid)
                return (leader, True, net),
            match $ \(Leader pid) -> do
                say $ printf "new leader id %s" (show pid)
                return (Just pid, False, net),
            match $ \pids@(_:_) -> do
                say "start elections!"
                let newNet = filter ( /= self) pids
                forM_ (filter (> self) newNet) $ \pid -> send pid (Ping self)
                return (leader, False, newNet)
        ]
    case result of
        Nothing -> do
            case (leader, gpa) of
                (Nothing, False) -> do
                    say "become a leader"
                    forM_ net $ \pid -> send pid (Leader self)
                    worker (Just self) False net
                _ ->
                    worker leader gpa net
        Just (leader1, gpa1, net1) ->
            worker leader1 gpa1 net1

master :: Process ()
master = do
    pids <- replicateM workerCount $ spawnLocal $ worker Nothing False []
    say $ printf "spawned %s" (show pids)
    forM_ pids $ \pid -> send pid pids
    liftIO $ forever $ return ()

defaultHost = "localhost"
defaultPort = "6666"

distribMain master = do
    Right transport <- createTransport "127.0.0.1" "10666" defaultTCPParameters
    node <- newLocalNode transport initRemoteTable
    forkProcess node master
    forever $ return ()

main :: IO ()
main = distribMain master

Hi, can you please share the comments and the working of this?