module Data.Hashabler.SipHash (
siphash64
, 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 = (x `unsafeShiftL` b) .|. (x `unsafeShiftR` (64 b))
sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> (Word64, Word64, Word64, Word64)
sipRound v0 v1 v2 v3 = runIdentity $ 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)
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
instance HashState SipState where
mix8 st m = siphashForWord st m
mix16 st m = siphashForWord st m
mix32 st m = siphashForWord st m
mix64 st m = siphashForWord st m
siphashForWord :: (Integral m,
# if MIN_VERSION_base(4,7,0)
FiniteBits m
# else
Bits m
# endif
)=> SipState -> m -> SipState
siphashForWord (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) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound 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
SipState{ .. } <- return $ hash (SipState { .. }) a
let !b = inlen `unsafeShiftL` 56
b <- return $ b .|. mPart
v3 <- return $ v3 `xor` b
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
v0 <- return $ v0 `xor` b
v2 <- return $ v2 `xor` 0xff
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound 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
SipState{ .. } <- return $ hash (SipState { .. }) a
let !b = inlen `unsafeShiftL` 56
b <- return $ b .|. mPart
v3 <- return $ v3 `xor` b
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
v0 <- return $ v0 `xor` b
v2 <- return $ v2 `xor` 0xee
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
let !b0 = v0 `xor` v1 `xor` v2 `xor` v3
v1 <- return $ v1 `xor` 0xdd
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
(v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3
let !b1 = v0 `xor` v1 `xor` v2 `xor` v3
return $! Hash128 b0 b1