module Data.Hashabler.SipHash (
siphash64
, siphash64_1_3
, siphash128
, SipKey(..)
) where
import Data.Functor.Identity
import Data.Word (Word64)
import Data.Bits
import Control.Exception(assert)
import Data.Hashabler.Internal
rotl :: Word64 -> Int -> Word64
rotl x b = assert (b > 0 && b < 64) $
(x `unsafeShiftL` b) .|. (x `unsafeShiftR` (64 b))
sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> Identity (Word64, Word64, Word64, Word64)
sipRound v0 v1 v2 v3 = do
v0 <- return $ v0 + v1
v1 <- return $ rotl v1 13
v1 <- return $ v1 `xor` v0
v0 <- return $ rotl v0 32
v2 <- return $ v2 + v3
v3 <- return $ rotl v3 16
v3 <- return $ v3 `xor` v2
v0 <- return $ v0 + v3
v3 <- return $ rotl v3 21
v3 <- return $ v3 `xor` v0
v2 <- return $ v2 + v1
v1 <- return $ rotl v1 17
v1 <- return $ v1 `xor` v2
v2 <- return $ rotl v2 32
return (v0, v1, v2, v3)
sipRounds :: Int -> Word64 -> Word64 -> Word64 -> Word64 -> Identity (Word64, Word64, Word64, Word64)
sipRounds 0 = error "The number of rounds must be > 0"
sipRounds 1 = \v0 v1 v2 v3 -> do
sipRound v0 v1 v2 v3
sipRounds 2 = \v0 v1 v2 v3 -> do
(v0,v1,v2,v3) <- sipRound v0 v1 v2 v3
sipRound v0 v1 v2 v3
sipRounds 3 = \v0 v1 v2 v3 -> do
(v0,v1,v2,v3) <- sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- sipRound v0 v1 v2 v3
sipRound v0 v1 v2 v3
sipRounds 4 = \v0 v1 v2 v3 -> do
(v0,v1,v2,v3) <- sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- sipRound v0 v1 v2 v3
sipRound v0 v1 v2 v3
sipRounds n = go n where
go 0 v0 v1 v2 v3 = return (v0,v1,v2,v3)
go n' v0 v1 v2 v3 = do
(v0,v1,v2,v3) <- sipRound v0 v1 v2 v3
go (n'1) v0 v1 v2 v3
data SipKey = SipKey !Word64 !Word64
deriving (Read, Show, Eq)
data SipState = SipState {
v0 :: !Word64
, v1 :: !Word64
, v2 :: !Word64
, v3 :: !Word64
, mPart :: !Word64
, bytesRemaining :: !Word64
, inlen :: !Word64
} deriving Eq
newtype Sip_2 = Sip_2 SipState
newtype Sip_1 = Sip_1 SipState
instance HashState Sip_2 where
mix8 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m
mix16 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m
mix32 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m
mix64 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m
instance HashState Sip_1 where
mix8 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m
mix16 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m
mix32 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m
mix64 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m
siphashForWord :: (Integral m,
# if MIN_VERSION_base(4,7,0)
FiniteBits m
# else
Bits m
# endif
)=> Int -> SipState -> m -> SipState
siphashForWord cROUNDS (SipState{ .. }) m = runIdentity $
assert (bytesRemaining > 0 && bytesRemaining <= 8) $
case compare bytesRemaining mSize of
GT -> do mPart <- orMparts mPart m
bytesRemaining <- return $ bytesRemaining mSize
inlen <- return $ inlen + mSize
return $ SipState{ .. }
EQ -> do m <- orMparts mPart m
let mPart = 0
bytesRemaining = 8
(v0,v1,v2,v3) <- sipMix v0 v1 v2 v3 m
inlen <- return $ inlen + mSize
return $ SipState{ .. }
LT | mSize == 8 -> do
(v0,v1,v2,v3) <- sipMix v0 v1 v2 v3 mPart
(v0,v1,v2,v3) <- sipMix v0 v1 v2 v3 (fromIntegral m)
let mPart = 0
bytesRemaining = 8
inlen <- return $ inlen + mSize
return $ SipState{ .. }
| otherwise -> do
(v0,v1,v2,v3) <- sipMix v0 v1 v2 v3 mPart
let mPart = fromIntegral m
bytesRemaining = 8 mSize
inlen <- return $ inlen + mSize
return $ SipState{ .. }
where
mSizeBits =
# if MIN_VERSION_base(4,7,0)
finiteBitSize m
# else
bitSize m
# endif
mSize = case mSizeBits of 8 -> 1 ; 16 -> 2 ; 32 -> 4 ; 64 -> 8 ; _ -> error "Impossible size!"
orMparts mPart m = return $
(mPart `unsafeShiftL` mSizeBits) .|. (fromIntegral m)
sipMix v0 v1 v2 v3 m = do
v3 <- return $ v3 `xor` m
(v0,v1,v2,v3) <- sipRounds cROUNDS v0 v1 v2 v3
v0 <- return $ v0 `xor` m
return (v0,v1,v2,v3)
siphash64 :: Hashable a => SipKey -> a -> Hash64 a
siphash64 (SipKey k0 k1) = \a-> runIdentity $ do
let v0 = 0x736f6d6570736575
v1 = 0x646f72616e646f6d
v2 = 0x6c7967656e657261
v3 = 0x7465646279746573
v3 <- return $ v3 `xor` k1;
v2 <- return $ v2 `xor` k0;
v1 <- return $ v1 `xor` k1;
v0 <- return $ v0 `xor` k0;
let mPart = 0
bytesRemaining = 8
inlen = 0
(Sip_2 SipState{ .. }) <- return $ hash (Sip_2 $ SipState { .. }) a
let !b = inlen `unsafeShiftL` 56
b <- return $ b .|. mPart
v3 <- return $ v3 `xor` b
(v0,v1,v2,v3) <- sipRounds 2 v0 v1 v2 v3
v0 <- return $ v0 `xor` b
v2 <- return $ v2 `xor` 0xff
(v0,v1,v2,v3) <- sipRounds 4 v0 v1 v2 v3
return $! Hash64 $! v0 `xor` v1 `xor` v2 `xor` v3
siphash64_1_3 :: Hashable a => SipKey -> a -> Hash64 a
siphash64_1_3 (SipKey k0 k1) = \a-> runIdentity $ do
let v0 = 0x736f6d6570736575
v1 = 0x646f72616e646f6d
v2 = 0x6c7967656e657261
v3 = 0x7465646279746573
v3 <- return $ v3 `xor` k1;
v2 <- return $ v2 `xor` k0;
v1 <- return $ v1 `xor` k1;
v0 <- return $ v0 `xor` k0;
let mPart = 0
bytesRemaining = 8
inlen = 0
(Sip_1 SipState{ .. }) <- return $ hash (Sip_1 $ SipState { .. }) a
let !b = inlen `unsafeShiftL` 56
b <- return $ b .|. mPart
v3 <- return $ v3 `xor` b
(v0,v1,v2,v3) <- sipRounds 1 v0 v1 v2 v3
v0 <- return $ v0 `xor` b
v2 <- return $ v2 `xor` 0xff
(v0,v1,v2,v3) <- sipRounds 3 v0 v1 v2 v3
return $! Hash64 $! v0 `xor` v1 `xor` v2 `xor` v3
siphash128 :: Hashable a => SipKey -> a -> Hash128 a
siphash128 (SipKey k0 k1) = \a-> runIdentity $ do
let v0 = 0x736f6d6570736575
v1 = 0x646f72616e646f6d
v2 = 0x6c7967656e657261
v3 = 0x7465646279746573
v3 <- return $ v3 `xor` k1;
v2 <- return $ v2 `xor` k0;
v1 <- return $ v1 `xor` k1;
v0 <- return $ v0 `xor` k0;
v1 <- return $ v1 `xor` 0xee
let mPart = 0
bytesRemaining = 8
inlen = 0
(Sip_2 SipState{ .. }) <- return $ hash (Sip_2 $ SipState { .. }) a
let !b = inlen `unsafeShiftL` 56
b <- return $ b .|. mPart
v3 <- return $ v3 `xor` b
(v0,v1,v2,v3) <- sipRounds 2 v0 v1 v2 v3
v0 <- return $ v0 `xor` b
v2 <- return $ v2 `xor` 0xee
(v0,v1,v2,v3) <- sipRounds 4 v0 v1 v2 v3
let !b0 = v0 `xor` v1 `xor` v2 `xor` v3
v1 <- return $ v1 `xor` 0xdd
(v0,v1,v2,v3) <- sipRounds 4 v0 v1 v2 v3
let !b1 = v0 `xor` v1 `xor` v2 `xor` v3
return $! Hash128 b0 b1