ConsistentHashing

ConsistentHash.hs

module ConsistentHash where

import Data.Map as M
import Data.List as L
import Data.ByteString.Lazy.Char8
import Data.Digest.Pure.MD5 hiding (hash)

type Key = String
type Node = Key
type Nodes = [Node]
type CH = (Map Key Node, Node)

create :: Nodes -> CH
create nodes = (circle, (L.head nodes))
  where circle = M.fromList $ L.map (\n -> (hash n, n)) nodes

hash :: Key -> String
hash key = show $ md5 $ pack key

get :: CH -> Key -> Node
get (circle, firstNode) key = case M.lookupGE (hash key) circle of
                               Just (k, n) -> n
                               Nothing -> firstNode

Main.hs

{-# LANGUAGE OverloadedStrings #-}
import ConsistentHash
import Data.List as L
import Data.Map as M

main = do
  let nodes = ["n1", "n2", "n3", "n4", "n5", "n6"]
  let ds = ['a'..'z']
  let emptyStat = M.fromList $ L.map (\n -> (n, [])) nodes
  let ch = create nodes
  let foundNodes = L.map (\d -> (d, ((get ch).show) d)) ds
  print $ L.foldl (\st (d, n) -> M.adjust (++[d]) n st) emptyStat foundNodes