hashring (empty) → 0.0.0

raw patch · 6 files changed

+389/−0 lines, 6 filesdep +QuickCheckdep +basedep +containerssetup-changed

Dependencies added: QuickCheck, base, containers, hashable, hashring, test-framework, test-framework-quickcheck2

Files

Data/HashRing.hs +189/−0
LICENSE.md +25/−0
README.md +6/−0
Setup.hs +4/−0
hashring.cabal +46/−0
tests/Properties.hs +119/−0

+ Data/HashRing.hs view

@@ -0,0 +1,189 @@+-- | module: Data.HashRing+-- copyright: (c) Michael S. Craig 2012+-- license: BSD3+-- maintainer: mkscrg@gmail.com+-- stability: experimental+-- portability: portable+--+-- An efficient implementation of consistent hashing, as described in+--+--    * David Karger et al.,+--    \"/Consistent hashing and random trees: distributed caching protocols for relieving hot spots on the World Wide Web/\",+--    29th Annual ACM Symposium on Theory,+--    <http://dl.acm.org/citation.cfm?id=258660>+--+-- In distributed computing applications, it's usually necessary route messages+-- to some group of N nodes in the network. Message locality, wherein messages+-- of the same kind are routed to the same node, is often desirable. \"Normal\"+-- hashing, where a message's node is determined by some hash function modulo+-- N, has the undesirable property that adding or removing a node from the+-- network causes the key sets of all other nodes to change drastically.+-- In contrast, consistent hashing has the property that small changes to the+-- size of the node set cause only small changes to key sets of the nodes.+--+-- This implementation is built on top of 'IntMap' and 'Set'. It provides+-- /O(1)/ lookup functions as well as /O(min(log n, R))/ insertion and deletion+-- functions, where /R/ is the number of replica nodes used in the ring (see+-- 'empty').+--+-- The key space of the ring is the full range of 'Int' values. To insert a+-- node, we generate (/R > 0/) keys by hashing the node with /R/ successive+-- salts, and the node is referenced by those keys in the ring. To get a node+-- for a message, we hash the message to an 'Int' value /k/ and find the+-- smallest key /k'/ in the ring such that /k <= k'/. The node is the value+-- referenced by /k'/. Higher values of /R/ give a more even distribution of+-- keys to nodes but slow down insertions and deletions of nodes. /R/ is+-- specified when constructing a 'HashRing' with 'empty', 'singleton', or+-- 'fromList' and retrievable with 'replicas'.+--+-- The ability of 'HashRing' to fairly distribute messages among nodes relies+-- on the implementations of 'Data.Hashable.hashWithSalt' for the message and+-- node types. For example, the default implementation for+-- 'Data.ByteString.ByteString' is non-uniform on short inputs, and so it's+-- unsuitable for use with 'HashRing'. Reimplementing+-- 'Data.Hashable.hashWithSalt' for your message and node types with a+-- cryptographic hash function (like MD5 or SHA1 from the @cryptohash@ package)+-- will give better results.++module Data.HashRing (+  -- * Map type+  HashRing+  -- * Construction+, empty+, singleton+  -- * Operators+, (!)+  -- * Query+, null+, size+, replicas+, member+, lookup+, find+  -- * Insertion+, insert+  -- * Deletion+, delete+  -- * Conversion+, fromList+, toList+) where++import Prelude hiding (lookup, null)+import Data.Hashable (Hashable, hash, hashWithSalt)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IM+import Data.Set (Set)+import qualified Data.Set as S+++-- | The constructor for this data type is not exported. See 'empty',+-- 'singleton', or 'fromList'.+--+-- Note that 'HashRing' is parameterized by the node type and not by the+-- message type. As made clear by the type signatures for '!', 'find', and+-- 'lookup', any 'Hashable' type can be used as a message.+data HashRing a = HashRing+  { nodeMap :: IntMap a+  , nodeSet :: Set a+  , replicas :: Int+  -- ^ Number of replica nodes (/R/) in the ring for each real node.+  } deriving (Eq)+++instance Show a => Show (HashRing a) where+  showsPrec d ring = showParen (d > 10)+                   $ showString "fromList "+                   . shows (replicas ring)+                   . showString " "+                   . shows (toList ring)++instance (Read a, Ord a, Hashable a) => Read (HashRing a) where+  readsPrec d = readParen (d > 10) $ \s -> do+    ("fromList", s') <- lex s+    (nreps, s'') <- reads s'+    (nodes, s''') <- reads s''+    return (fromList nreps nodes, s''')+++-- | Construct an empty ring with a specific /R/ value.+empty :: Int -> HashRing a+empty nreps = HashRing IM.empty S.empty nreps++-- | Construct a single-node ring with a specific /R/ value.+singleton :: (Ord a, Hashable a) => Int -> a -> HashRing a+singleton nreps node = insert node $ empty nreps+++-- | @True@ if the ring is empty, @False@ otherwise.+null :: HashRing a -> Bool+null ring = S.null $ nodeSet ring++-- | Number of nodes in the ring.+size :: HashRing a -> Int+size ring = S.size $ nodeSet ring++-- | @True@ if the node is in the ring, @False@ otherwise.+member :: Ord a => a -> HashRing a -> Bool+member node ring = S.member node $ nodeSet ring+++-- | Get the node in the ring corresponding to a message, or @Nothing@ if the+-- ring is empty.+lookup :: Hashable b => b -> HashRing a -> Maybe a+lookup msg ring = let nmap = nodeMap ring in if IM.null nmap+  then Nothing+  else Just $ case IM.splitLookup (hash msg) nmap of+    (_, Just node, _) -> node+    (_, _, submap) -> if IM.null submap+      then snd $ IM.findMin nmap+      else snd $ IM.findMin submap++-- | Get the node in the ring corresponding to a message, or error if the ring+-- is empty.+find :: Hashable b => b -> HashRing a -> a+find msg ring = case lookup msg ring of+  Just x -> x+  Nothing -> error "HashRing.find: empty hash ring"++-- | Get the node in the ring corresponding to a message, or error if the ring+-- is empty.+(!) :: Hashable b => HashRing a -> b -> a+ring ! msg = find msg ring+++-- | Add a node to the ring.+insert :: (Ord a, Hashable a) => a -> HashRing a -> HashRing a+insert node ring+  | S.member node $ nodeSet ring = ring+  | otherwise = ring+    { nodeMap = foldr (\key nmap -> IM.insert key node nmap) (nodeMap ring)+              $ take (replicas ring)+              $ filter (\key -> not $ IM.member key (nodeMap ring))+              $ nodeKeys node+    , nodeSet = S.insert node (nodeSet ring) }++-- | Remove a node from the ring.+delete :: (Ord a, Hashable a) => a -> HashRing a -> HashRing a+delete node ring+  | not $ S.member node $ nodeSet ring = ring+  | otherwise = ring+    { nodeMap = foldr (\key nmap -> IM.delete key nmap) (nodeMap ring)+              $ take (replicas ring)+              $ filter (\key -> IM.lookup key (nodeMap ring) == Just node)+              $ nodeKeys node+    , nodeSet = S.delete node (nodeSet ring) }+++-- | Construct a ring from an /R/ value and a list of nodes.+fromList :: (Ord a, Hashable a) => Int -> [a] -> HashRing a+fromList nreps nodes = foldr insert (empty nreps) nodes++-- | Construct a list containing the nodes in the ring.+toList :: HashRing a -> [a]+toList ring = S.toList $ nodeSet ring+++-- List of possible keys for a new node+nodeKeys :: Hashable a => a -> [Int]+nodeKeys node = map (\i -> hashWithSalt i node) [0..]

+ LICENSE.md view

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright (c) 2012, Michael S. Craig. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,6 @@+# hashring++Efficient [consistent hashing](http://en.wikipedia.org/wiki/Consistent_hashing)+in Haskell.++See the haddocks on [Hackage](http://hackage.haskell.org/package/hashring).

+ Setup.hs view

@@ -0,0 +1,4 @@+import Distribution.Simple++main :: IO ()+main = defaultMain

+ hashring.cabal view

@@ -0,0 +1,46 @@+name: hashring+version: 0.0.0+license: BSD3+license-file: LICENSE.md+author: Michael S. Craig <mkscrg@gmail.com>+maintainer: Michael S. Craig <mkscrg@gmail.com>+stability: experimental+synopsis: Efficient consistent hashing.+description:+  An efficient implementation of consistent hashing. See the documentation for+  @Data.HashRing@ for more info.+homepage: https://github.com/mkscrg/hashring+bug-reports: https://github.com/mkscrg/hashring/issues+category: Data+build-type: Simple+cabal-version: >= 1.9.2+extra-source-files: README.md++library+  exposed-modules: Data.HashRing+  ghc-options: -Wall -O2+  build-depends:+    base >= 4 && < 5,+    containers >= 0.4 && < 0.5,+    hashable >= 1.1.1 && < 1.2++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Properties.hs+  hs-source-dirs: tests+  ghc-options: -Wall -O2 -fno-warn-orphans+  build-depends:+    base >= 4 && < 5,+    hashring,+    test-framework,+    test-framework-quickcheck2,+    QuickCheck++source-repository head+  type: git+  location: git://github.com/mkscrg/hashring++source-repository this+  type: git+  location: git://github.com/mkscrg/hashring+  tag: 0.0.0

+ tests/Properties.hs view

@@ -0,0 +1,119 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}++module Main (main) where++import Data.HashRing (HashRing, (!))+import qualified Data.HashRing as R+import Data.List ((\\), nub)+import Data.Word (Word8)+import Test.QuickCheck (Arbitrary (..), Gen, Property, (==>), listOf, resize)+import Test.Framework (defaultMain, testGroup )+import Test.Framework.Providers.QuickCheck2 (testProperty)+++main :: IO ()+main = defaultMain+  [ testGroup "basic properties"+    [ testProperty "empty ring is null" pEmptyIsNull+    , testProperty "nonempty rings are not null" pNonemptyNonNull+    , testProperty "size is # of nodes" pSize+    , testProperty "replicas is # of replicas" pReplicas+    , testProperty "equality" pInequality ]+  , testGroup "query properties"+    [ testProperty "lookup in empty ring" pLookupEmpty+    , testProperty "member identity" pMember+    , testProperty "lookup identity" pLookupId+    , testProperty "find identity" pFindId+    , testProperty "index (bang) identity" pIndexId+    , testProperty "lookup not Nothing" pLookupJust+    , testProperty "lookup wraps" pLookupWrap ]+  , testGroup "insert/delete properties"+    [ testProperty "insert into empty" pSingleton+    , testProperty "insert idempotency" pInsertIdem+    , testProperty "insert then delete" pInsertDelete+    , testProperty "delete nonmember" pDeleteNonMember ]+  , testGroup "conversion properties"+    [ testProperty "show/read identity" pShowRead+    , testProperty "list conversion" pListConvert ] ]+++type IRing = HashRing Int+newtype NReps = NReps Int deriving (Show)++instance Arbitrary NReps where+  arbitrary = fmap (NReps . (+1) . fromIntegral) (arbitrary :: Gen Word8)++instance Arbitrary IRing where+  arbitrary = do+    NReps nreps <- arbitrary+    nodes <- resize 100 $ listOf arbitrary+    return $ R.fromList nreps nodes+++pEmptyIsNull :: NReps -> Bool+pEmptyIsNull (NReps nreps) = R.null $ R.empty nreps++pNonemptyNonNull :: IRing -> Property+pNonemptyNonNull ring = R.size ring > 0 ==> not (R.null ring)++pSize :: NReps -> [Int] -> Bool+pSize (NReps nreps) nodes = go nodes $ R.empty nreps+  where+    go [] ring = R.size ring == length (nub nodes)+    go (n:ns) ring = go ns $ R.insert n ring++pReplicas :: NReps -> Bool+pReplicas (NReps nreps) = R.replicas (R.empty nreps) == nreps++pInequality :: NReps -> Int -> Bool+pInequality (NReps nreps) node = R.singleton nreps node /= R.empty nreps+++pLookupEmpty :: Int -> NReps -> Bool+pLookupEmpty node (NReps nreps) =+  R.lookup node (R.empty nreps :: IRing) == Nothing++pMember :: Int -> IRing -> Bool+pMember node ring = R.member node (R.insert node ring) == True++pLookupId :: Int -> IRing -> Bool+pLookupId msgnode ring = R.lookup msgnode (R.insert msgnode ring) == Just msgnode++pFindId :: Int -> IRing -> Bool+pFindId msgnode ring = R.find msgnode (R.insert msgnode ring) == msgnode++pIndexId :: Int -> IRing -> Bool+pIndexId msgnode ring = R.insert msgnode ring ! msgnode == msgnode++pLookupJust :: Int -> IRing -> Property+pLookupJust msg ring = not (R.null ring) ==> R.lookup msg ring /= Nothing++pLookupWrap :: Int -> NReps -> Property+pLookupWrap msgnode (NReps nreps) = msgnode /= maxBound ==>+  R.lookup (msgnode + 1) (R.insert msgnode $ R.empty nreps) == Just msgnode+++pSingleton :: NReps -> Int -> Bool+pSingleton (NReps nreps) node =+  R.insert node (R.empty nreps) == R.singleton nreps node++pInsertIdem :: Int -> IRing -> Bool+pInsertIdem node ring =+  R.insert node (R.insert node ring) == R.insert node ring++pInsertDelete :: Int -> IRing -> Bool+pInsertDelete node ring = ring == R.delete node (R.insert node ring)++pDeleteNonMember :: Int -> IRing -> Property+pDeleteNonMember node ring =+  not (R.member node ring) ==> R.delete node ring == ring+++pShowRead :: IRing -> Bool+pShowRead ring = ring == read (show ring)++pListConvert :: NReps -> [Int] -> Bool+pListConvert (NReps nreps) ints =+  let innodes = nub ints+      outnodes = R.toList $ R.fromList nreps innodes+  in innodes \\ outnodes == [] && outnodes \\ innodes == []