{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UnboxedTuples #-} -- | -- Module: Data.Hash.SipHash -- Copyright: Copyright © 2021 Lars Kuhtz -- License: MIT -- Maintainer: Lars Kuhtz -- Stability: experimental -- module Data.Hash.SipHash ( sipHash , sipHash13 , sipHash24 , sipHash48 , sipHashCD -- * Utils , module Data.Hash.Utils ) where import Control.Monad import Data.Bits import Data.Function import Data.Word import Foreign.Marshal.Utils import Foreign.Storable import GHC.Ptr import Prelude hiding (drop, length, null, splitAt, take) -- internal modules import Data.Hash.Utils -- -------------------------------------------------------------------------- -- -- SipHash -- | SipHash, with recommended default parameters of c=2 and c=4. -- -- The first and second argument is the 128 bit key, represented as two 64 bit -- words. -- sipHash :: Word64 -> Word64 -> Ptr Word8 -> Int -> IO Word64 sipHash = sipHash24 {-# INLINE sipHash #-} -- | SipHash-2-4 -- -- The first and second argument is the 128 bit key, represented as two 64 bit -- words. -- sipHash24 :: Word64 -> Word64 -> Ptr Word8 -> Int -> IO Word64 sipHash24 = sipHashInternal rounds2 rounds4 {-# INLINE sipHash24 #-} -- | SipHash-1-3 -- -- The first and second argument is the 128 bit key, represented as two 64 bit -- words. -- sipHash13 :: Word64 -> Word64 -> Ptr Word8 -> Int -> IO Word64 sipHash13 = sipHashInternal rounds1 rounds3 {-# INLINE sipHash13 #-} -- | SipHash-4-8 -- -- The first and second argument is the 128 bit key, represented as two 64 bit -- words. -- sipHash48 :: Word64 -> Word64 -> Ptr Word8 -> Int -> IO Word64 sipHash48 = sipHashInternal rounds4 rounds8 {-# INLINE sipHash48 #-} -- | Generic SipHash with c rounds per block and d finalization rounds. -- -- The first and second argument is the 128 bit key, represented as two 64 bit -- words. -- sipHashCD :: Int -> Int -> Word64 -> Word64 -> Ptr Word8 -> Int -> IO Word64 sipHashCD c d = sipHashInternal (rounds c) (rounds d) {-# INLINE sipHashCD #-} -- -------------------------------------------------------------------------- -- -- Generic SipHash data S = S {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 type Round = Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) sipHashInternal :: Round -> Round -> Word64 -> Word64 -> Ptr Word8 -> Int -> IO Word64 sipHashInternal cRound dRound !k0 !k1 !ptr !len = do -- loop (S !v0 !v1 !v2 !v3) <- loop i0 i1 i2 i3 (castPtr ptr) len -- end let (!off, !r) = quotRem len 8 w <- ptrToWord64 (plusPtr ptr (off * 8)) r let !b = shiftL (fromIntegral len) 56 .|. w (# !v0', !v1', !v2', !v3' #) = cRound v0 v1 v2 (v3 `xor` b) (# !v0'', !v1'', !v2'', !v3'' #) = dRound (v0' `xor` b) v1' (v2' `xor` 0xff) v3' return $! v0'' `xor` v1'' `xor` v2'' `xor` v3'' where loop !v0 !v1 !v2 !v3 !p !l | l < 8 = return $ S v0 v1 v2 v3 | otherwise = do !m <- peek p let (# v0', v1', v2', v3' #) = cRound v0 v1 v2 (v3 `xor` m) loop (v0' `xor` m) v1' v2' v3' (plusPtr p 8) (l - 8) !i0 = 0x736f6d6570736575 `xor` k0 !i1 = 0x646f72616e646f6d `xor` k1 !i2 = 0x6c7967656e657261 `xor` k0 !i3 = 0x7465646279746573 `xor` k1 {-# INLINE i0 #-} {-# INLINE i1 #-} {-# INLINE i2 #-} {-# INLINE i3 #-} {-# INLINE sipHashInternal #-} ptrToWord64 :: Ptr Word64 -> Int -> IO Word64 ptrToWord64 _ 0 = pure 0 ptrToWord64 !p 1 = fromIntegral <$!> peek @Word8 (castPtr p) ptrToWord64 !p 2 = fromIntegral <$!> peek @Word16 (castPtr p) ptrToWord64 !p 4 = fromIntegral <$!> peek @Word32 (castPtr p) ptrToWord64 !p !i = with @Word64 0 $ \p' -> do -- using 'with' within unsafeDupablePerformIO is probably safe because -- with uses 'alloca', which guarantees that the memory is released -- when computation is abondended before being terminated. copyBytes p' p i peek p' {-# INLINE ptrToWord64 #-} rounds1 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) rounds1 !v0 !v1 !v2 !v3 = sipRound v0 v1 v2 v3 {-# INLINE rounds1 #-} rounds2 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) rounds2 !v0 !v1 !v2 !v3 = let (# !v0', !v1', !v2', !v3' #) = sipRound v0 v1 v2 v3 in sipRound v0' v1' v2' v3' {-# INLINE rounds2 #-} rounds3 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) rounds3 !v0 !v1 !v2 !v3 = let (# !v0', !v1', !v2', !v3' #) = sipRound v0 v1 v2 v3 (# !v0'', !v1'', !v2'', !v3'' #) = sipRound v0' v1' v2' v3' in sipRound v0'' v1'' v2'' v3'' {-# INLINE rounds3 #-} rounds4 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) rounds4 !v0 !v1 !v2 !v3 = let (# !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'' in sipRound v0''' v1''' v2''' v3''' {-# INLINE rounds4 #-} rounds8 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) rounds8 !v0 !v1 !v2 !v3 = let (# !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'' (# !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''''' (# !v0''''''', !v1''''''', !v2''''''', !v3''''''' #) = sipRound v0'''''' v1'''''' v2'''''' v3'''''' in sipRound v0''''''' v1''''''' v2''''''' v3''''''' {-# INLINE rounds8 #-} rounds :: Int -> Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) rounds 1 !v0 !v1 !v2 !v3 = rounds1 v0 v1 v2 v3 rounds 2 !v0 !v1 !v2 !v3 = rounds2 v0 v1 v2 v3 rounds 3 !v0 !v1 !v2 !v3 = rounds3 v0 v1 v2 v3 rounds 4 !v0 !v1 !v2 !v3 = rounds4 v0 v1 v2 v3 rounds 8 !v0 !v1 !v2 !v3 = rounds8 v0 v1 v2 v3 rounds !c !v0 !v1 !v2 !v3 = case sipRound v0 v1 v2 v3 of (# v0', v1', v2', v3' #) -> rounds (c - 1) v0' v1' v2' v3' {-# INLINE rounds #-} sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #) sipRound !v0 !v1 !v2 !v3 = (# v0''', v1'''', v2''', v3'''' #) where !v0' = v0 + v1 !v2' = v2 + v3 !v1' = v1 `rotateL` 13 !v3' = v3 `rotateL` 16 !v1'' = v1' `xor` v0' !v3'' = v3' `xor` v2' !v0'' = v0' `rotateL` 32 !v2'' = v2' + v1'' !v0''' = v0'' + v3'' !v1''' = v1'' `rotateL` 17 !v3''' = v3'' `rotateL` 21 !v1'''' = v1''' `xor` v2'' !v3'''' = v3''' `xor` v0''' !v2''' = v2'' `rotateL` 32 {-# INLINE sipRound #-}