    {-# 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
    $c+ :: HashSlot -> HashSlot -> HashSlot
    + :: HashSlot -> HashSlot -> HashSlot
    $c- :: HashSlot -> HashSlot -> HashSlot
    - :: HashSlot -> HashSlot -> HashSlot
    $c* :: HashSlot -> HashSlot -> HashSlot
    * :: HashSlot -> HashSlot -> HashSlot
    $cnegate :: HashSlot -> HashSlot
    negate :: HashSlot -> HashSlot
    $cabs :: HashSlot -> HashSlot
    abs :: HashSlot -> HashSlot
    $csignum :: HashSlot -> HashSlot
    signum :: HashSlot -> HashSlot
    $cfromInteger :: Integer -> HashSlot
    fromInteger :: Integer -> HashSlot
    Num, HashSlot -> HashSlot -> Bool
    (HashSlot -> HashSlot -> Bool)
    -> (HashSlot -> HashSlot -> Bool) -> Eq HashSlot
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HashSlot -> HashSlot -> Bool
    == :: HashSlot -> HashSlot -> Bool
    $c/= :: HashSlot -> HashSlot -> Bool
    /= :: 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
    $ccompare :: HashSlot -> HashSlot -> Ordering
    compare :: HashSlot -> HashSlot -> Ordering
    $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
    >= :: HashSlot -> HashSlot -> Bool
    $cmax :: HashSlot -> HashSlot -> HashSlot
    max :: HashSlot -> HashSlot -> HashSlot
    $cmin :: HashSlot -> HashSlot -> HashSlot
    min :: HashSlot -> HashSlot -> 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
    $ctoRational :: HashSlot -> Rational
    toRational :: HashSlot -> Rational
    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
    $csucc :: HashSlot -> HashSlot
    succ :: HashSlot -> HashSlot
    $cpred :: HashSlot -> HashSlot
    pred :: HashSlot -> HashSlot
    $ctoEnum :: Int -> HashSlot
    toEnum :: Int -> HashSlot
    $cfromEnum :: HashSlot -> Int
    fromEnum :: HashSlot -> Int
    $cenumFrom :: HashSlot -> [HashSlot]
    enumFrom :: HashSlot -> [HashSlot]
    $cenumFromThen :: HashSlot -> HashSlot -> [HashSlot]
    enumFromThen :: HashSlot -> HashSlot -> [HashSlot]
    $cenumFromTo :: HashSlot -> HashSlot -> [HashSlot]
    enumFromTo :: HashSlot -> HashSlot -> [HashSlot]
    $cenumFromThenTo :: HashSlot -> HashSlot -> HashSlot -> [HashSlot]
    enumFromThenTo :: HashSlot -> HashSlot -> 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
    $cquot :: HashSlot -> HashSlot -> HashSlot
    quot :: HashSlot -> HashSlot -> HashSlot
    $crem :: HashSlot -> HashSlot -> HashSlot
    rem :: HashSlot -> HashSlot -> HashSlot
    $cdiv :: HashSlot -> HashSlot -> HashSlot
    div :: HashSlot -> HashSlot -> HashSlot
    $cmod :: HashSlot -> HashSlot -> HashSlot
    mod :: HashSlot -> HashSlot -> HashSlot
    $cquotRem :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
    quotRem :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
    $cdivMod :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
    divMod :: HashSlot -> HashSlot -> (HashSlot, HashSlot)
    $ctoInteger :: HashSlot -> Integer
    toInteger :: HashSlot -> Integer
    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
    $cshowsPrec :: Int -> HashSlot -> ShowS
    showsPrec :: Int -> HashSlot -> ShowS
    $cshow :: HashSlot -> String
    show :: HashSlot -> String
    $cshowList :: [HashSlot] -> ShowS
    showList :: [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
    '}') (HasCallStack => ByteString -> ByteString
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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