{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.Redis.Cluster.HashSlot(HashSlot, keyToSlot) where

import Data.Bits((.&.), xor, shiftL)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString as BS
import Data.Word(Word8, Word16)

newtype HashSlot = HashSlot Word16 deriving (Integer -> HashSlot
HashSlot -> HashSlot
HashSlot -> HashSlot -> HashSlot
(HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot)
-> (HashSlot -> HashSlot)
-> (HashSlot -> HashSlot)
-> (Integer -> HashSlot)
-> Num HashSlot
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> HashSlot
$cfromInteger :: Integer -> HashSlot
signum :: HashSlot -> HashSlot
$csignum :: HashSlot -> HashSlot
abs :: HashSlot -> HashSlot
$cabs :: HashSlot -> HashSlot
negate :: HashSlot -> HashSlot
$cnegate :: HashSlot -> HashSlot
* :: HashSlot -> HashSlot -> HashSlot
$c* :: HashSlot -> HashSlot -> HashSlot
- :: HashSlot -> HashSlot -> HashSlot
$c- :: HashSlot -> HashSlot -> HashSlot
+ :: HashSlot -> HashSlot -> HashSlot
$c+ :: HashSlot -> HashSlot -> HashSlot
Num, HashSlot -> HashSlot -> Bool
(HashSlot -> HashSlot -> Bool)
-> (HashSlot -> HashSlot -> Bool) -> Eq HashSlot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashSlot -> HashSlot -> Bool
$c/= :: HashSlot -> HashSlot -> Bool
== :: HashSlot -> HashSlot -> Bool
$c== :: HashSlot -> HashSlot -> Bool
Eq, Eq HashSlot
Eq HashSlot
-> (HashSlot -> HashSlot -> Ordering)
-> (HashSlot -> HashSlot -> Bool)
-> (HashSlot -> HashSlot -> Bool)
-> (HashSlot -> HashSlot -> Bool)
-> (HashSlot -> HashSlot -> Bool)
-> (HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot -> HashSlot)
-> Ord HashSlot
HashSlot -> HashSlot -> Bool
HashSlot -> HashSlot -> Ordering
HashSlot -> HashSlot -> HashSlot
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HashSlot -> HashSlot -> HashSlot
$cmin :: HashSlot -> HashSlot -> HashSlot
max :: HashSlot -> HashSlot -> HashSlot
$cmax :: HashSlot -> HashSlot -> HashSlot
>= :: HashSlot -> HashSlot -> Bool
$c>= :: HashSlot -> HashSlot -> Bool
> :: HashSlot -> HashSlot -> Bool
$c> :: HashSlot -> HashSlot -> Bool
<= :: HashSlot -> HashSlot -> Bool
$c<= :: HashSlot -> HashSlot -> Bool
< :: HashSlot -> HashSlot -> Bool
$c< :: HashSlot -> HashSlot -> Bool
compare :: HashSlot -> HashSlot -> Ordering
$ccompare :: HashSlot -> HashSlot -> Ordering
$cp1Ord :: Eq HashSlot
Ord, Num HashSlot
Ord HashSlot
Num HashSlot
-> Ord HashSlot -> (HashSlot -> Rational) -> Real HashSlot
HashSlot -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: HashSlot -> Rational
$ctoRational :: HashSlot -> Rational
$cp2Real :: Ord HashSlot
$cp1Real :: Num HashSlot
Real, Int -> HashSlot
HashSlot -> Int
HashSlot -> [HashSlot]
HashSlot -> HashSlot
HashSlot -> HashSlot -> [HashSlot]
HashSlot -> HashSlot -> HashSlot -> [HashSlot]
(HashSlot -> HashSlot)
-> (HashSlot -> HashSlot)
-> (Int -> HashSlot)
-> (HashSlot -> Int)
-> (HashSlot -> [HashSlot])
-> (HashSlot -> HashSlot -> [HashSlot])
-> (HashSlot -> HashSlot -> [HashSlot])
-> (HashSlot -> HashSlot -> HashSlot -> [HashSlot])
-> Enum HashSlot
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HashSlot -> HashSlot -> HashSlot -> [HashSlot]
$cenumFromThenTo :: HashSlot -> HashSlot -> HashSlot -> [HashSlot]
enumFromTo :: HashSlot -> HashSlot -> [HashSlot]
$cenumFromTo :: HashSlot -> HashSlot -> [HashSlot]
enumFromThen :: HashSlot -> HashSlot -> [HashSlot]
$cenumFromThen :: HashSlot -> HashSlot -> [HashSlot]
enumFrom :: HashSlot -> [HashSlot]
$cenumFrom :: HashSlot -> [HashSlot]
fromEnum :: HashSlot -> Int
$cfromEnum :: HashSlot -> Int
toEnum :: Int -> HashSlot
$ctoEnum :: Int -> HashSlot
pred :: HashSlot -> HashSlot
$cpred :: HashSlot -> HashSlot
succ :: HashSlot -> HashSlot
$csucc :: HashSlot -> HashSlot
Enum, Enum HashSlot
Real HashSlot
Real HashSlot
-> Enum HashSlot
-> (HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot -> HashSlot)
-> (HashSlot -> HashSlot -> (HashSlot, HashSlot))
-> (HashSlot -> HashSlot -> (HashSlot, HashSlot))
-> (HashSlot -> Integer)
-> Integral HashSlot
HashSlot -> Integer
HashSlot -> HashSlot -> (HashSlot, HashSlot)
HashSlot -> HashSlot -> HashSlot
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: HashSlot -> Integer
$ctoInteger :: HashSlot -> Integer
divMod :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
$cdivMod :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
quotRem :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
$cquotRem :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
mod :: HashSlot -> HashSlot -> HashSlot
$cmod :: HashSlot -> HashSlot -> HashSlot
div :: HashSlot -> HashSlot -> HashSlot
$cdiv :: HashSlot -> HashSlot -> HashSlot
rem :: HashSlot -> HashSlot -> HashSlot
$crem :: HashSlot -> HashSlot -> HashSlot
quot :: HashSlot -> HashSlot -> HashSlot
$cquot :: HashSlot -> HashSlot -> HashSlot
$cp2Integral :: Enum HashSlot
$cp1Integral :: Real HashSlot
Integral, Int -> HashSlot -> ShowS
[HashSlot] -> ShowS
HashSlot -> String
(Int -> HashSlot -> ShowS)
-> (HashSlot -> String) -> ([HashSlot] -> ShowS) -> Show HashSlot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashSlot] -> ShowS
$cshowList :: [HashSlot] -> ShowS
show :: HashSlot -> String
$cshow :: HashSlot -> String
showsPrec :: Int -> HashSlot -> ShowS
$cshowsPrec :: Int -> HashSlot -> ShowS
Show)

numHashSlots :: Word16
numHashSlots :: Word16
numHashSlots = Word16
16384

-- | Compute the hashslot associated with a key
keyToSlot :: BS.ByteString -> HashSlot
keyToSlot :: ByteString -> HashSlot
keyToSlot = Word16 -> HashSlot
HashSlot (Word16 -> HashSlot)
-> (ByteString -> Word16) -> ByteString -> HashSlot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.) (Word16
numHashSlots Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
1) (Word16 -> Word16)
-> (ByteString -> Word16) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word16
crc16 (ByteString -> Word16)
-> (ByteString -> ByteString) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
findSubKey

-- | Find the section of a key to compute the slot for.
findSubKey :: BS.ByteString -> BS.ByteString
findSubKey :: ByteString -> ByteString
findSubKey ByteString
key = case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Char8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'{') ByteString
key of
  (ByteString
whole, ByteString
"") -> ByteString
whole
  (ByteString
_, ByteString
xs) -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Char8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'}') (ByteString -> ByteString
Char8.tail ByteString
xs) of
    (ByteString
"", ByteString
_) -> ByteString
key
    (ByteString
subKey, ByteString
_) -> ByteString
subKey

crc16 :: BS.ByteString -> Word16
crc16 :: ByteString -> Word16
crc16 = (Word16 -> Word8 -> Word16) -> Word16 -> ByteString -> Word16
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl (Word16 -> Word16 -> Word8 -> Word16
crc16Update Word16
0x1021) Word16
0

-- Taken from crc16 package
crc16Update :: Word16  -- ^ polynomial
            -> Word16 -- ^ initial crc
            -> Word8 -- ^ data byte
            -> Word16 -- ^ new crc
crc16Update :: Word16 -> Word16 -> Word8 -> Word16
crc16Update Word16
poly Word16
crc Word8
b = 
  (Word16 -> Int -> Word16) -> Word16 -> [Int] -> Word16
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Word16 -> Int -> Word16
forall p. Word16 -> p -> Word16
crc16UpdateBit Word16
newCrc [Int
1 :: Int .. Int
8]
  where 
    newCrc :: Word16
newCrc = Word16
crc Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
`xor` Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b :: Word16) Int
8
    crc16UpdateBit :: Word16 -> p -> Word16
crc16UpdateBit Word16
crc' p
_ =
      if (Word16
crc' Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x8000) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0x0000
          then Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Word16
crc' Int
1 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
`xor` Word16
poly
          else Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Word16
crc' Int
1