Initial commit
This commit is contained in:
La Ancapo
commit
c101616e62
309 changed files with 53937 additions and 0 deletions
106
bundled/Data/Memory/Hash/FNV.hs
Normal file
106
bundled/Data/Memory/Hash/FNV.hs
Normal file
|
|
@ -0,0 +1,106 @@
|
|||
-- |
|
||||
-- Module : Data.Memory.Hash.FNV
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : experimental
|
||||
-- Portability : good
|
||||
--
|
||||
-- Fowler Noll Vo Hash (1 and 1a / 32 / 64 bits versions)
|
||||
-- <http://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function>
|
||||
--
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
{-# LANGUAGE UnboxedTuples #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Data.Memory.Hash.FNV
|
||||
(
|
||||
-- * types
|
||||
FnvHash32(..)
|
||||
, FnvHash64(..)
|
||||
-- * methods
|
||||
, fnv1
|
||||
, fnv1a
|
||||
, fnv1_64
|
||||
, fnv1a_64
|
||||
) where
|
||||
|
||||
import Basement.Bits
|
||||
import Basement.IntegralConv
|
||||
import Data.Memory.Internal.Compat ()
|
||||
import Data.Memory.Internal.Imports
|
||||
import GHC.Word
|
||||
import GHC.Prim hiding (Word64#, Int64#)
|
||||
import GHC.Types
|
||||
import GHC.Ptr
|
||||
|
||||
-- | FNV1(a) hash (32 bit variants)
|
||||
newtype FnvHash32 = FnvHash32 Word32
|
||||
deriving (Show,Eq,Ord,NFData)
|
||||
|
||||
-- | FNV1(a) hash (64 bit variants)
|
||||
newtype FnvHash64 = FnvHash64 Word64
|
||||
deriving (Show,Eq,Ord,NFData)
|
||||
|
||||
fnv1_32_Mix8 :: Word8 -> FnvHash32 -> FnvHash32
|
||||
fnv1_32_Mix8 !w (FnvHash32 acc) = FnvHash32 ((0x01000193 * acc) .^. integralUpsize w)
|
||||
{-# INLINE fnv1_32_Mix8 #-}
|
||||
|
||||
fnv1a_32_Mix8 :: Word8 -> FnvHash32 -> FnvHash32
|
||||
fnv1a_32_Mix8 !w (FnvHash32 acc) = FnvHash32 (0x01000193 * (acc .^. integralUpsize w))
|
||||
{-# INLINE fnv1a_32_Mix8 #-}
|
||||
|
||||
fnv1_64_Mix8 :: Word8 -> FnvHash64 -> FnvHash64
|
||||
fnv1_64_Mix8 !w (FnvHash64 acc) = FnvHash64 ((0x100000001b3 * acc) .^. integralUpsize w)
|
||||
{-# INLINE fnv1_64_Mix8 #-}
|
||||
|
||||
fnv1a_64_Mix8 :: Word8 -> FnvHash64 -> FnvHash64
|
||||
fnv1a_64_Mix8 !w (FnvHash64 acc) = FnvHash64 (0x100000001b3 * (acc .^. integralUpsize w))
|
||||
{-# INLINE fnv1a_64_Mix8 #-}
|
||||
|
||||
-- | compute FNV1 (32 bit variant) of a raw piece of memory
|
||||
fnv1 :: Ptr Word8 -> Int -> IO FnvHash32
|
||||
fnv1 (Ptr addr) n = loop (FnvHash32 0x811c9dc5) 0
|
||||
where
|
||||
loop :: FnvHash32 -> Int -> IO FnvHash32
|
||||
loop !acc !i
|
||||
| i == n = pure $ acc
|
||||
| otherwise = do
|
||||
v <- read8 addr i
|
||||
loop (fnv1_32_Mix8 v acc) (i + 1)
|
||||
|
||||
-- | compute FNV1a (32 bit variant) of a raw piece of memory
|
||||
fnv1a :: Ptr Word8 -> Int -> IO FnvHash32
|
||||
fnv1a (Ptr addr) n = loop (FnvHash32 0x811c9dc5) 0
|
||||
where
|
||||
loop :: FnvHash32 -> Int -> IO FnvHash32
|
||||
loop !acc !i
|
||||
| i == n = pure $ acc
|
||||
| otherwise = do
|
||||
v <- read8 addr i
|
||||
loop (fnv1a_32_Mix8 v acc) (i + 1)
|
||||
|
||||
-- | compute FNV1 (64 bit variant) of a raw piece of memory
|
||||
fnv1_64 :: Ptr Word8 -> Int -> IO FnvHash64
|
||||
fnv1_64 (Ptr addr) n = loop (FnvHash64 0xcbf29ce484222325) 0
|
||||
where
|
||||
loop :: FnvHash64 -> Int -> IO FnvHash64
|
||||
loop !acc !i
|
||||
| i == n = pure $ acc
|
||||
| otherwise = do
|
||||
v <- read8 addr i
|
||||
loop (fnv1_64_Mix8 v acc) (i + 1)
|
||||
|
||||
-- | compute FNV1a (64 bit variant) of a raw piece of memory
|
||||
fnv1a_64 :: Ptr Word8 -> Int -> IO FnvHash64
|
||||
fnv1a_64 (Ptr addr) n = loop (FnvHash64 0xcbf29ce484222325) 0
|
||||
where
|
||||
loop :: FnvHash64 -> Int -> IO FnvHash64
|
||||
loop !acc !i
|
||||
| i == n = pure $ acc
|
||||
| otherwise = do
|
||||
v <- read8 addr i
|
||||
loop (fnv1a_64_Mix8 v acc) (i + 1)
|
||||
|
||||
read8 :: Addr# -> Int -> IO Word8
|
||||
read8 addr (I# i) = IO $ \s -> case readWord8OffAddr# addr i s of
|
||||
(# s2, e #) -> (# s2, W8# e #)
|
||||
163
bundled/Data/Memory/Hash/SipHash.hs
Normal file
163
bundled/Data/Memory/Hash/SipHash.hs
Normal file
|
|
@ -0,0 +1,163 @@
|
|||
-- |
|
||||
-- Module : Data.Memory.Hash.SipHash
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : experimental
|
||||
-- Portability : good
|
||||
--
|
||||
-- provide the SipHash algorithm.
|
||||
-- reference: <http://131002.net/siphash/siphash.pdf>
|
||||
--
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
module Data.Memory.Hash.SipHash
|
||||
( SipKey(..)
|
||||
, SipHash(..)
|
||||
, hash
|
||||
, hashWith
|
||||
) where
|
||||
|
||||
import Data.Memory.Endian
|
||||
import Data.Memory.Internal.Compat
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
import Data.Typeable (Typeable)
|
||||
import Control.Monad
|
||||
import Foreign.Ptr
|
||||
import Foreign.Storable
|
||||
|
||||
-- | SigHash Key
|
||||
data SipKey = SipKey {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
|
||||
|
||||
-- | Siphash tag value
|
||||
newtype SipHash = SipHash Word64
|
||||
deriving (Show,Eq,Ord,Typeable)
|
||||
|
||||
data InternalState = InternalState {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
|
||||
|
||||
-- | produce a siphash with a key and a memory pointer + length.
|
||||
hash :: SipKey -> Ptr Word8 -> Int -> IO SipHash
|
||||
hash = hashWith 2 4
|
||||
|
||||
-- | same as 'hash', except also specifies the number of sipround iterations for compression and digest.
|
||||
hashWith :: Int -- ^ siphash C
|
||||
-> Int -- ^ siphash D
|
||||
-> SipKey -- ^ key for the hash
|
||||
-> Ptr Word8 -- ^ memory pointer
|
||||
-> Int -- ^ length of the data
|
||||
-> IO SipHash
|
||||
hashWith c d key startPtr totalLen = runHash (initSip key) startPtr totalLen
|
||||
where runHash !st !ptr l
|
||||
| l > 7 = peek (castPtr ptr) >>= \v -> runHash (process st (fromLE v)) (ptr `plusPtr` 8) (l-8)
|
||||
| otherwise = do
|
||||
let !lengthBlock = (fromIntegral totalLen `mod` 256) `unsafeShiftL` 56
|
||||
(finish . process st) `fmap` case l of
|
||||
0 -> do return lengthBlock
|
||||
1 -> do v0 <- peekByteOff ptr 0
|
||||
return (lengthBlock .|. to64 v0)
|
||||
2 -> do (v0,v1) <- liftM2 (,) (peekByteOff ptr 0) (peekByteOff ptr 1)
|
||||
return (lengthBlock
|
||||
.|. (to64 v1 `unsafeShiftL` 8)
|
||||
.|. to64 v0)
|
||||
3 -> do (v0,v1,v2) <- liftM3 (,,) (peekByteOff ptr 0) (peekByteOff ptr 1) (peekByteOff ptr 2)
|
||||
return ( lengthBlock
|
||||
.|. (to64 v2 `unsafeShiftL` 16)
|
||||
.|. (to64 v1 `unsafeShiftL` 8)
|
||||
.|. to64 v0)
|
||||
4 -> do (v0,v1,v2,v3) <- liftM4 (,,,) (peekByteOff ptr 0) (peekByteOff ptr 1) (peekByteOff ptr 2)
|
||||
(peekByteOff ptr 3)
|
||||
return ( lengthBlock
|
||||
.|. (to64 v3 `unsafeShiftL` 24)
|
||||
.|. (to64 v2 `unsafeShiftL` 16)
|
||||
.|. (to64 v1 `unsafeShiftL` 8)
|
||||
.|. to64 v0)
|
||||
5 -> do (v0,v1,v2,v3,v4) <- liftM5 (,,,,) (peekByteOff ptr 0) (peekByteOff ptr 1) (peekByteOff ptr 2)
|
||||
(peekByteOff ptr 3) (peekByteOff ptr 4)
|
||||
return ( lengthBlock
|
||||
.|. (to64 v4 `unsafeShiftL` 32)
|
||||
.|. (to64 v3 `unsafeShiftL` 24)
|
||||
.|. (to64 v2 `unsafeShiftL` 16)
|
||||
.|. (to64 v1 `unsafeShiftL` 8)
|
||||
.|. to64 v0)
|
||||
6 -> do v0 <- peekByteOff ptr 0
|
||||
v1 <- peekByteOff ptr 1
|
||||
v2 <- peekByteOff ptr 2
|
||||
v3 <- peekByteOff ptr 3
|
||||
v4 <- peekByteOff ptr 4
|
||||
v5 <- peekByteOff ptr 5
|
||||
return ( lengthBlock
|
||||
.|. (to64 v5 `unsafeShiftL` 40)
|
||||
.|. (to64 v4 `unsafeShiftL` 32)
|
||||
.|. (to64 v3 `unsafeShiftL` 24)
|
||||
.|. (to64 v2 `unsafeShiftL` 16)
|
||||
.|. (to64 v1 `unsafeShiftL` 8)
|
||||
.|. to64 v0)
|
||||
7 -> do v0 <- peekByteOff ptr 0
|
||||
v1 <- peekByteOff ptr 1
|
||||
v2 <- peekByteOff ptr 2
|
||||
v3 <- peekByteOff ptr 3
|
||||
v4 <- peekByteOff ptr 4
|
||||
v5 <- peekByteOff ptr 5
|
||||
v6 <- peekByteOff ptr 6
|
||||
return ( lengthBlock
|
||||
.|. (to64 v6 `unsafeShiftL` 48)
|
||||
.|. (to64 v5 `unsafeShiftL` 40)
|
||||
.|. (to64 v4 `unsafeShiftL` 32)
|
||||
.|. (to64 v3 `unsafeShiftL` 24)
|
||||
.|. (to64 v2 `unsafeShiftL` 16)
|
||||
.|. (to64 v1 `unsafeShiftL` 8)
|
||||
.|. to64 v0)
|
||||
_ -> error "siphash: internal error: cannot happens"
|
||||
|
||||
{-# INLINE to64 #-}
|
||||
to64 :: Word8 -> Word64
|
||||
to64 = fromIntegral
|
||||
|
||||
{-# INLINE process #-}
|
||||
process istate m = newState
|
||||
where newState = postInject $! runRoundsCompression $! preInject istate
|
||||
preInject (InternalState v0 v1 v2 v3) = InternalState v0 v1 v2 (v3 `xor` m)
|
||||
postInject (InternalState v0 v1 v2 v3) = InternalState (v0 `xor` m) v1 v2 v3
|
||||
|
||||
{-# INLINE finish #-}
|
||||
finish istate = getDigest $! runRoundsDigest $! preInject istate
|
||||
where getDigest (InternalState v0 v1 v2 v3) = SipHash (v0 `xor` v1 `xor` v2 `xor` v3)
|
||||
preInject (InternalState v0 v1 v2 v3) = InternalState v0 v1 (v2 `xor` 0xff) v3
|
||||
|
||||
{-# INLINE doRound #-}
|
||||
doRound (InternalState v0 v1 v2 v3) =
|
||||
let !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
|
||||
in InternalState v0''' v1'''' v2''' v3''''
|
||||
|
||||
{-# INLINE runRoundsCompression #-}
|
||||
runRoundsCompression st
|
||||
| c == 2 = doRound $! doRound st
|
||||
| otherwise = loopRounds c st
|
||||
|
||||
{-# INLINE runRoundsDigest #-}
|
||||
runRoundsDigest st
|
||||
| d == 4 = doRound $! doRound $! doRound $! doRound st
|
||||
| otherwise = loopRounds d st
|
||||
|
||||
{-# INLINE loopRounds #-}
|
||||
loopRounds 1 !v = doRound v
|
||||
loopRounds n !v = loopRounds (n-1) (doRound v)
|
||||
|
||||
{-# INLINE initSip #-}
|
||||
initSip (SipKey k0 k1) = InternalState (k0 `xor` 0x736f6d6570736575)
|
||||
(k1 `xor` 0x646f72616e646f6d)
|
||||
(k0 `xor` 0x6c7967656e657261)
|
||||
(k1 `xor` 0x7465646279746573)
|
||||
Loading…
Add table
Add a link
Reference in a new issue