cluster.hs

#!/usr/bin/env stack
-- stack --resolver lts-13.27 script --package text --package turtle --package async

{-# LANGUAGE OverloadedStrings #-}

import Control.Concurrent.Async
import Data.Foldable
import Data.Text (pack)
import Turtle

type Index = Int
type Port = Int

gossipSeeds :: [(Index, Port)]
gossipSeeds = fmap go [0..2]
  where
    go idx = (idx, getIntHttpPort idx)

otherGossipSeeds :: Index -> [(Index, Port)]
otherGossipSeeds idx = filter go gossipSeeds
  where
    go (i, _) = i /= idx

formatSeeds :: [(Index, Port)] -> Text
formatSeeds = foldl1 append . fmap go
  where
    go (_, port) = "127.0.0.1:" <> tshow port

    append a b = a <> "," <> b

tshow :: Show a => a -> Text
tshow = pack . show

getIntTcpPort :: Index -> Int
getIntTcpPort idx = idx * 1000 + 1111

getIntHttpPort :: Index -> Int
getIntHttpPort idx = idx * 1000 + 1113

getExtTcpPort :: Index -> Int
getExtTcpPort idx = idx * 1000 + 1112

getExtHttpPort :: Index -> Int
getExtHttpPort idx = idx * 1000 + 1114

main :: IO ()
main = forConcurrently_ [0..2] $ \idx -> sh $ do
  let logFile = "node-" <> tshow (idx + 1) <> ".log"
      program =
        inproc "./run-node.sh"
          [ "--mem-db"
          , "--int-ip 127.0.0.1"
          , "--ext-ip 127.0.0.1"
          , "--discover-via-dns false"
          , "--cluster-size 3"
          , "--int-tcp-port " <> tshow (getIntTcpPort idx)
          , "--int-http-port " <> tshow (getIntHttpPort idx)
          , "--ext-tcp-port " <> tshow (getExtTcpPort idx)
          , "--ext-http-port " <> tshow (getExtHttpPort idx)
          , "--gossip-seed " <> (formatSeeds $ otherGossipSeeds idx)
          ] mempty

  output (fromText logFile) program