{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Hash.SipHash
( SipHashKey(..)
, SipHash(..)
, sipHash
, sipHashCD
, sipHash24
, sipHash13
, sipHash48
, SipHashContext
, sipHashInitialize
, sipHashUpdate
, sipHashFinalize
, module Data.Hash.Class.Pure.Salted
) where
import Control.Monad
import Data.Bits
import Data.Type.Equality
import Data.Word
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import GHC.TypeNats
import Data.Hash.Class.Pure.Salted
sipHash
:: SipHashKey
-> Ptr Word8
-> Int
-> IO (SipHash 2 4)
sipHash :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 2 4)
sipHash = SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 2 4)
forall (c :: Nat) (d :: Nat).
(SipHashParam c, SipHashParam d) =>
SipHashKey -> Ptr Word8 -> Int -> IO (SipHash c d)
sipHashCD
{-# INLINE sipHash #-}
sipHashCD
:: forall c d
. SipHashParam c
=> SipHashParam d
=> SipHashKey
-> Ptr Word8
-> Int
-> IO (SipHash c d)
sipHashCD :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash c d)
sipHashCD SipHashKey
key Ptr Word8
ptr Int
n = SipHashContext c d -> SipHash c d
forall (c :: Nat) (d :: Nat).
(SipHashParam c, SipHashParam d) =>
SipHashContext c d -> SipHash c d
sipHashFinalize
(SipHashContext c d -> SipHash c d)
-> IO (SipHashContext c d) -> IO (SipHash c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SipHashContext c d -> Ptr Word8 -> Int -> IO (SipHashContext c d)
forall (c :: Nat) (d :: Nat).
SipHashParam c =>
SipHashContext c d -> Ptr Word8 -> Int -> IO (SipHashContext c d)
sipHashUpdate (SipHashKey -> SipHashContext c d
forall (c :: Nat) (d :: Nat). SipHashKey -> SipHashContext c d
sipHashInitialize SipHashKey
key) Ptr Word8
ptr Int
n
{-# INLINE sipHashCD #-}
sipHash24 :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 2 4)
sipHash24 :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 2 4)
sipHash24 = SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 2 4)
forall (c :: Nat) (d :: Nat).
(SipHashParam c, SipHashParam d) =>
SipHashKey -> Ptr Word8 -> Int -> IO (SipHash c d)
sipHashCD
{-# INLINE sipHash24 #-}
sipHash13 :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 1 3)
sipHash13 :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 1 3)
sipHash13 = SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 1 3)
forall (c :: Nat) (d :: Nat).
(SipHashParam c, SipHashParam d) =>
SipHashKey -> Ptr Word8 -> Int -> IO (SipHash c d)
sipHashCD
{-# INLINE sipHash13 #-}
sipHash48 :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 4 8)
sipHash48 :: SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 4 8)
sipHash48 = SipHashKey -> Ptr Word8 -> Int -> IO (SipHash 4 8)
forall (c :: Nat) (d :: Nat).
(SipHashParam c, SipHashParam d) =>
SipHashKey -> Ptr Word8 -> Int -> IO (SipHash c d)
sipHashCD
{-# INLINE sipHash48 #-}
instance (SipHashParam c, SipHashParam d) => IncrementalHash (SipHash c d) where
type Context (SipHash c d) = SipHashContext c d
update :: Context (SipHash c d)
-> Ptr Word8 -> Int -> IO (Context (SipHash c d))
update = Context (SipHash c d)
-> Ptr Word8 -> Int -> IO (Context (SipHash c d))
forall (c :: Nat) (d :: Nat).
SipHashParam c =>
SipHashContext c d -> Ptr Word8 -> Int -> IO (SipHashContext c d)
sipHashUpdate
finalize :: Context (SipHash c d) -> SipHash c d
finalize = Context (SipHash c d) -> SipHash c d
forall (c :: Nat) (d :: Nat).
(SipHashParam c, SipHashParam d) =>
SipHashContext c d -> SipHash c d
sipHashFinalize
{-# INLINE update #-}
{-# INLINE finalize #-}
instance (SipHashParam c, SipHashParam d) => Hash (SipHash c d) where
type Salt (SipHash c d) = SipHashKey
initialize :: Salt (SipHash c d) -> Context (SipHash c d)
initialize = Salt (SipHash c d) -> Context (SipHash c d)
forall (c :: Nat) (d :: Nat). SipHashKey -> SipHashContext c d
sipHashInitialize
{-# INLINE initialize #-}
newtype SipHash (c :: Nat) (d :: Nat) = SipHash Word64
deriving (Int -> SipHash c d -> ShowS
[SipHash c d] -> ShowS
SipHash c d -> String
(Int -> SipHash c d -> ShowS)
-> (SipHash c d -> String)
-> ([SipHash c d] -> ShowS)
-> Show (SipHash c d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: Nat) (d :: Nat). Int -> SipHash c d -> ShowS
forall (c :: Nat) (d :: Nat). [SipHash c d] -> ShowS
forall (c :: Nat) (d :: Nat). SipHash c d -> String
showList :: [SipHash c d] -> ShowS
$cshowList :: forall (c :: Nat) (d :: Nat). [SipHash c d] -> ShowS
show :: SipHash c d -> String
$cshow :: forall (c :: Nat) (d :: Nat). SipHash c d -> String
showsPrec :: Int -> SipHash c d -> ShowS
$cshowsPrec :: forall (c :: Nat) (d :: Nat). Int -> SipHash c d -> ShowS
Show, SipHash c d -> SipHash c d -> Bool
(SipHash c d -> SipHash c d -> Bool)
-> (SipHash c d -> SipHash c d -> Bool) -> Eq (SipHash c d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
/= :: SipHash c d -> SipHash c d -> Bool
$c/= :: forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
== :: SipHash c d -> SipHash c d -> Bool
$c== :: forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
Eq, Eq (SipHash c d)
Eq (SipHash c d)
-> (SipHash c d -> SipHash c d -> Ordering)
-> (SipHash c d -> SipHash c d -> Bool)
-> (SipHash c d -> SipHash c d -> Bool)
-> (SipHash c d -> SipHash c d -> Bool)
-> (SipHash c d -> SipHash c d -> Bool)
-> (SipHash c d -> SipHash c d -> SipHash c d)
-> (SipHash c d -> SipHash c d -> SipHash c d)
-> Ord (SipHash c d)
SipHash c d -> SipHash c d -> Bool
SipHash c d -> SipHash c d -> Ordering
SipHash c d -> SipHash c d -> SipHash c d
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
forall (c :: Nat) (d :: Nat). Eq (SipHash c d)
forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
forall (c :: Nat) (d :: Nat).
SipHash c d -> SipHash c d -> Ordering
forall (c :: Nat) (d :: Nat).
SipHash c d -> SipHash c d -> SipHash c d
min :: SipHash c d -> SipHash c d -> SipHash c d
$cmin :: forall (c :: Nat) (d :: Nat).
SipHash c d -> SipHash c d -> SipHash c d
max :: SipHash c d -> SipHash c d -> SipHash c d
$cmax :: forall (c :: Nat) (d :: Nat).
SipHash c d -> SipHash c d -> SipHash c d
>= :: SipHash c d -> SipHash c d -> Bool
$c>= :: forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
> :: SipHash c d -> SipHash c d -> Bool
$c> :: forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
<= :: SipHash c d -> SipHash c d -> Bool
$c<= :: forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
< :: SipHash c d -> SipHash c d -> Bool
$c< :: forall (c :: Nat) (d :: Nat). SipHash c d -> SipHash c d -> Bool
compare :: SipHash c d -> SipHash c d -> Ordering
$ccompare :: forall (c :: Nat) (d :: Nat).
SipHash c d -> SipHash c d -> Ordering
$cp1Ord :: forall (c :: Nat) (d :: Nat). Eq (SipHash c d)
Ord)
data SipHashKey = SipHashKey {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
deriving (Int -> SipHashKey -> ShowS
[SipHashKey] -> ShowS
SipHashKey -> String
(Int -> SipHashKey -> ShowS)
-> (SipHashKey -> String)
-> ([SipHashKey] -> ShowS)
-> Show SipHashKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SipHashKey] -> ShowS
$cshowList :: [SipHashKey] -> ShowS
show :: SipHashKey -> String
$cshow :: SipHashKey -> String
showsPrec :: Int -> SipHashKey -> ShowS
$cshowsPrec :: Int -> SipHashKey -> ShowS
Show, SipHashKey -> SipHashKey -> Bool
(SipHashKey -> SipHashKey -> Bool)
-> (SipHashKey -> SipHashKey -> Bool) -> Eq SipHashKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SipHashKey -> SipHashKey -> Bool
$c/= :: SipHashKey -> SipHashKey -> Bool
== :: SipHashKey -> SipHashKey -> Bool
$c== :: SipHashKey -> SipHashKey -> Bool
Eq, Eq SipHashKey
Eq SipHashKey
-> (SipHashKey -> SipHashKey -> Ordering)
-> (SipHashKey -> SipHashKey -> Bool)
-> (SipHashKey -> SipHashKey -> Bool)
-> (SipHashKey -> SipHashKey -> Bool)
-> (SipHashKey -> SipHashKey -> Bool)
-> (SipHashKey -> SipHashKey -> SipHashKey)
-> (SipHashKey -> SipHashKey -> SipHashKey)
-> Ord SipHashKey
SipHashKey -> SipHashKey -> Bool
SipHashKey -> SipHashKey -> Ordering
SipHashKey -> SipHashKey -> SipHashKey
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
min :: SipHashKey -> SipHashKey -> SipHashKey
$cmin :: SipHashKey -> SipHashKey -> SipHashKey
max :: SipHashKey -> SipHashKey -> SipHashKey
$cmax :: SipHashKey -> SipHashKey -> SipHashKey
>= :: SipHashKey -> SipHashKey -> Bool
$c>= :: SipHashKey -> SipHashKey -> Bool
> :: SipHashKey -> SipHashKey -> Bool
$c> :: SipHashKey -> SipHashKey -> Bool
<= :: SipHashKey -> SipHashKey -> Bool
$c<= :: SipHashKey -> SipHashKey -> Bool
< :: SipHashKey -> SipHashKey -> Bool
$c< :: SipHashKey -> SipHashKey -> Bool
compare :: SipHashKey -> SipHashKey -> Ordering
$ccompare :: SipHashKey -> SipHashKey -> Ordering
$cp1Ord :: Eq SipHashKey
Ord)
data SipHashContext (c :: Nat) (d :: Nat) = SipHashContext
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
sipHashInitialize :: SipHashKey -> SipHashContext c d
sipHashInitialize :: SipHashKey -> SipHashContext c d
sipHashInitialize (SipHashKey Word64
k0 Word64
k1) = Word64
-> Word64 -> Word64 -> Word64 -> Word64 -> SipHashContext c d
forall (c :: Nat) (d :: Nat).
Word64
-> Word64 -> Word64 -> Word64 -> Word64 -> SipHashContext c d
SipHashContext
(Word64
0x736f6d6570736575 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
k0)
(Word64
0x646f72616e646f6d Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
k1)
(Word64
0x6c7967656e657261 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
k0)
(Word64
0x7465646279746573 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
k1)
Word64
0x0
{-# INLINE sipHashInitialize #-}
sipHashUpdate
:: forall (c :: Nat) (d :: Nat)
. SipHashParam c
=> SipHashContext c d
-> Ptr Word8
-> Int
-> IO (SipHashContext c d)
sipHashUpdate :: SipHashContext c d -> Ptr Word8 -> Int -> IO (SipHashContext c d)
sipHashUpdate (SipHashContext Word64
s0 Word64
s1 Word64
s2 Word64
s3 Word64
r) Ptr Word8
ptr8 Int
len
| Word64
0 <- Word64
rlen Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`rem` Word64
8 = Word64
-> Word64
-> Word64
-> Word64
-> Ptr Word64
-> Word64
-> IO (SipHashContext c d)
loop Word64
s0 Word64
s1 Word64
s2 Word64
s3 Ptr Word64
ptr64 Word64
len64
| Word64
a <- Word64
rlen Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`rem` Word64
8 = do
let !missing :: Word64
missing = Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
a
!Word64
m <- Ptr Word64 -> Word64 -> IO Word64
ptrToWord64 Ptr Word64
ptr64 (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
missing
let !m' :: Word64
m' = (Word64
0x00ffffffffffffff Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
r ) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
m
if Word64
len64 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
missing
then
SipHashContext c d -> IO (SipHashContext c d)
forall (m :: * -> *) a. Monad m => a -> m a
return (SipHashContext c d -> IO (SipHashContext c d))
-> SipHashContext c d -> IO (SipHashContext c d)
forall a b. (a -> b) -> a -> b
$ Word64
-> Word64 -> Word64 -> Word64 -> Word64 -> SipHashContext c d
forall (c :: Nat) (d :: Nat).
Word64
-> Word64 -> Word64 -> Word64 -> Word64 -> SipHashContext c d
SipHashContext Word64
s0 Word64
s1 Word64
s2 Word64
s3 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word64
rlen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
len64) Int
56 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
m')
else do
let (# Word64
v0', Word64
v1', Word64
v2', Word64
v3' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat).
SipHashParam n =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds @c Word64
s0 Word64
s1 Word64
s2 (Word64
s3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m')
Word64
-> Word64
-> Word64
-> Word64
-> Ptr Word64
-> Word64
-> IO (SipHashContext c d)
loop (Word64
v0' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m') Word64
v1' Word64
v2' Word64
v3' (Ptr Word64 -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word64
ptr64 (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
missing)) (Word64
len64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
missing)
where
len64 :: Word64
len64 = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
{-# INLINE len64 #-}
!ptr64 :: Ptr Word64
ptr64 = Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr8
{-# INLINE ptr64 #-}
!rlen :: Word64
rlen = Word64
0xff00000000000000 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
r
{-# INLINE rlen #-}
loop :: Word64
-> Word64
-> Word64
-> Word64
-> Ptr Word64
-> Word64
-> IO (SipHashContext c d)
loop !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 !Ptr Word64
p !Word64
l
| Word64
l Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
8 = do
!Word64
m <- Ptr Word64 -> Word64 -> IO Word64
ptrToWord64 Ptr Word64
p Word64
l
SipHashContext c d -> IO (SipHashContext c d)
forall (m :: * -> *) a. Monad m => a -> m a
return (SipHashContext c d -> IO (SipHashContext c d))
-> SipHashContext c d -> IO (SipHashContext c d)
forall a b. (a -> b) -> a -> b
$ Word64
-> Word64 -> Word64 -> Word64 -> Word64 -> SipHashContext c d
forall (c :: Nat) (d :: Nat).
Word64
-> Word64 -> Word64 -> Word64 -> Word64 -> SipHashContext c d
SipHashContext Word64
v0 Word64
v1 Word64
v2 Word64
v3 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word64
rlen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
len64) Int
56 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
m)
| Bool
otherwise = do
!Word64
m <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
p
let (# Word64
v0', Word64
v1', Word64
v2', Word64
v3' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat).
SipHashParam n =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds @c Word64
v0 Word64
v1 Word64
v2 (Word64
v3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m)
Word64
-> Word64
-> Word64
-> Word64
-> Ptr Word64
-> Word64
-> IO (SipHashContext c d)
loop (Word64
v0' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m) Word64
v1' Word64
v2' Word64
v3' (Ptr Word64 -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word64
p Int
8) (Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
8)
{-# INLINE loop #-}
{-# INLINE sipHashUpdate #-}
sipHashFinalize
:: forall (c :: Nat) (d :: Nat)
. SipHashParam c
=> SipHashParam d
=> SipHashContext c d
-> SipHash c d
sipHashFinalize :: SipHashContext c d -> SipHash c d
sipHashFinalize (SipHashContext Word64
v0 Word64
v1 Word64
v2 Word64
v3 Word64
m) =
Word64 -> SipHash c d
forall (c :: Nat) (d :: Nat). Word64 -> SipHash c d
SipHash (Word64 -> SipHash c d) -> Word64 -> SipHash c d
forall a b. (a -> b) -> a -> b
$! Word64
v0'' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v1'' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v2'' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v3''
where
(# !Word64
v0', !Word64
v1', !Word64
v2', !Word64
v3' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat).
SipHashParam n =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds @c Word64
v0 Word64
v1 Word64
v2 (Word64
v3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m)
(# !Word64
v0'', !Word64
v1'', !Word64
v2'', !Word64
v3'' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat).
SipHashParam n =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds @d (Word64
v0' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m) Word64
v1' (Word64
v2' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0xff) Word64
v3'
{-# INLINE sipHashFinalize #-}
ptrToWord64 :: Ptr Word64 -> Word64 -> IO Word64
ptrToWord64 :: Ptr Word64 -> Word64 -> IO Word64
ptrToWord64 Ptr Word64
_ Word64
0 = Word64 -> IO Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
ptrToWord64 !Ptr Word64
p Word64
1 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek @Word8 (Ptr Word64 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
p)
ptrToWord64 !Ptr Word64
p Word64
2 = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word64) -> IO Word16 -> IO Word64
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek @Word16 (Ptr Word64 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
p)
ptrToWord64 !Ptr Word64
p Word64
4 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> IO Word32 -> IO Word64
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (Ptr Word64 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
p)
ptrToWord64 !Ptr Word64
p !Word64
i = Word64 -> (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with @Word64 Word64
0 ((Ptr Word64 -> IO Word64) -> IO Word64)
-> (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
p' -> do
Ptr Word64 -> Ptr Word64 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word64
p' Ptr Word64
p (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
p'
{-# INLINE ptrToWord64 #-}
class SipHashParam (n :: Nat) where
rounds :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)
instance SipHashRounds n (SlowRounds n) => SipHashParam (n :: Nat) where
rounds :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds = SipHashRounds n (SlowRounds n) =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @n @(SlowRounds n)
{-# INLINE rounds #-}
type SlowRounds r = CmpNat r 8 == 'GT
class SipHashRounds (n :: Nat) (x :: Bool) where
rounds_ :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)
instance SipHashRounds 1 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3
{-# INLINE rounds_ #-}
instance SipHashRounds 2 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 =
let (# !Word64
v0', !Word64
v1', !Word64
v2', !Word64
v3' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3
in Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0' Word64
v1' Word64
v2' Word64
v3'
{-# INLINE rounds_ #-}
instance SipHashRounds 3 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 =
let (# !Word64
v0', !Word64
v1', !Word64
v2', !Word64
v3' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3
(# !Word64
v0'', !Word64
v1'', !Word64
v2'', !Word64
v3'' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0' Word64
v1' Word64
v2' Word64
v3'
in Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0'' Word64
v1'' Word64
v2'' Word64
v3''
{-# INLINE rounds_ #-}
instance SipHashRounds 4 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 =
let (# !Word64
v0', !Word64
v1', !Word64
v2', !Word64
v3' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3
(# !Word64
v0'', !Word64
v1'', !Word64
v2'', !Word64
v3'' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0' Word64
v1' Word64
v2' Word64
v3'
(# !Word64
v0''', !Word64
v1''', !Word64
v2''', !Word64
v3''' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0'' Word64
v1'' Word64
v2'' Word64
v3''
in Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0''' Word64
v1''' Word64
v2''' Word64
v3'''
{-# INLINE rounds_ #-}
instance SipHashRounds 5 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 = case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @4 @'False Word64
v0 Word64
v1 Word64
v2 Word64
v3 of
(# Word64
v0', Word64
v1', Word64
v2', Word64
v3' #) -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @1 @'False Word64
v0' Word64
v1' Word64
v2' Word64
v3'
{-# INLINE rounds_ #-}
instance SipHashRounds 6 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 = case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @4 @'False Word64
v0 Word64
v1 Word64
v2 Word64
v3 of
(# Word64
v0', Word64
v1', Word64
v2', Word64
v3' #) -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @2 @'False Word64
v0' Word64
v1' Word64
v2' Word64
v3'
{-# INLINE rounds_ #-}
instance SipHashRounds 7 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 = case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @4 @'False Word64
v0 Word64
v1 Word64
v2 Word64
v3 of
(# Word64
v0', Word64
v1', Word64
v2', Word64
v3' #) -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @3 @'False Word64
v0' Word64
v1' Word64
v2' Word64
v3'
{-# INLINE rounds_ #-}
instance SipHashRounds 8 'False where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 =
let (# !Word64
v0', !Word64
v1', !Word64
v2', !Word64
v3' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3
(# !Word64
v0'', !Word64
v1'', !Word64
v2'', !Word64
v3'' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0' Word64
v1' Word64
v2' Word64
v3'
(# !Word64
v0''', !Word64
v1''', !Word64
v2''', !Word64
v3''' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0'' Word64
v1'' Word64
v2'' Word64
v3''
(# !Word64
v0'''', !Word64
v1'''', !Word64
v2'''', !Word64
v3'''' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0''' Word64
v1''' Word64
v2''' Word64
v3'''
(# !Word64
v0''''', !Word64
v1''''', !Word64
v2''''', !Word64
v3''''' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0'''' Word64
v1'''' Word64
v2'''' Word64
v3''''
(# !Word64
v0'''''', !Word64
v1'''''', !Word64
v2'''''', !Word64
v3'''''' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0''''' Word64
v1''''' Word64
v2''''' Word64
v3'''''
(# !Word64
v0''''''', !Word64
v1''''''', !Word64
v2''''''', !Word64
v3''''''' #) = Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0'''''' Word64
v1'''''' Word64
v2'''''' Word64
v3''''''
in Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0''''''' Word64
v1''''''' Word64
v2''''''' Word64
v3'''''''
{-# INLINE rounds_ #-}
instance ((CmpNat n 8 == 'GT) ~ 'True, SipHashRounds (n-8) t) => SipHashRounds n 'True where
rounds_ :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 = case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @8 @'False Word64
v0 Word64
v1 Word64
v2 Word64
v3 of
(# Word64
v0', Word64
v1', Word64
v2', Word64
v3' #) -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
forall (n :: Nat) (x :: Bool).
SipHashRounds n x =>
Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds_ @(n - 8) @t Word64
v0' Word64
v1' Word64
v2' Word64
v3'
{-# INLINE rounds_ #-}
sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)
sipRound :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 = (# Word64
v0''', Word64
v1'''', Word64
v2''', Word64
v3'''' #)
where
!v0' :: Word64
v0' = Word64
v0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v1
!v2' :: Word64
v2' = Word64
v2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v3
!v1' :: Word64
v1' = Word64
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
13
!v3' :: Word64
v3' = Word64
v3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
16
!v1'' :: Word64
v1'' = Word64
v1' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v0'
!v3'' :: Word64
v3'' = Word64
v3' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v2'
!v0'' :: Word64
v0'' = Word64
v0' Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
32
!v2'' :: Word64
v2'' = Word64
v2' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v1''
!v0''' :: Word64
v0''' = Word64
v0'' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v3''
!v1''' :: Word64
v1''' = Word64
v1'' Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
17
!v3''' :: Word64
v3''' = Word64
v3'' Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
21
!v1'''' :: Word64
v1'''' = Word64
v1''' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v2''
!v3'''' :: Word64
v3'''' = Word64
v3''' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v0'''
!v2''' :: Word64
v2''' = Word64
v2'' Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
32
{-# INLINE sipRound #-}