-- |

-- Module      : Crypto.MAC.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>

--

-- This is a copy of the code from the @siphash@ library, which is licensed

-- under the 3-Clause BSD License. Unfortunately, @siphash@ no longer compiles

-- on GHC 9.2 or later, and since @siphash@ is deprecated, it is unlikely that

-- it will receive future updates. For the time being, we have opted to

-- internalize the code in the @hyperloglog@ library, as it is relatively

-- self-contained. In the future, we may want to consider offering this code as

-- a standalone library.

{-# LANGUAGE BangPatterns #-}
module Crypto.MAC.SipHash
    ( SipKey(..)
    , SipHash(..)
    , hash
    , hashWith
    ) where

import Data.Word
import Data.Bits
import Data.ByteString.Internal
import Control.Monad

import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import System.Endian (fromLE64)
import System.IO.Unsafe (unsafeDupablePerformIO)

-- | SigHash Key

data SipKey = SipKey {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  deriving (Int -> SipKey -> ShowS
[SipKey] -> ShowS
SipKey -> String
(Int -> SipKey -> ShowS)
-> (SipKey -> String) -> ([SipKey] -> ShowS) -> Show SipKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SipKey -> ShowS
showsPrec :: Int -> SipKey -> ShowS
$cshow :: SipKey -> String
show :: SipKey -> String
$cshowList :: [SipKey] -> ShowS
showList :: [SipKey] -> ShowS
Show,ReadPrec [SipKey]
ReadPrec SipKey
Int -> ReadS SipKey
ReadS [SipKey]
(Int -> ReadS SipKey)
-> ReadS [SipKey]
-> ReadPrec SipKey
-> ReadPrec [SipKey]
-> Read SipKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SipKey
readsPrec :: Int -> ReadS SipKey
$creadList :: ReadS [SipKey]
readList :: ReadS [SipKey]
$creadPrec :: ReadPrec SipKey
readPrec :: ReadPrec SipKey
$creadListPrec :: ReadPrec [SipKey]
readListPrec :: ReadPrec [SipKey]
Read,SipKey -> SipKey -> Bool
(SipKey -> SipKey -> Bool)
-> (SipKey -> SipKey -> Bool) -> Eq SipKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SipKey -> SipKey -> Bool
== :: SipKey -> SipKey -> Bool
$c/= :: SipKey -> SipKey -> Bool
/= :: SipKey -> SipKey -> Bool
Eq,Eq SipKey
Eq SipKey =>
(SipKey -> SipKey -> Ordering)
-> (SipKey -> SipKey -> Bool)
-> (SipKey -> SipKey -> Bool)
-> (SipKey -> SipKey -> Bool)
-> (SipKey -> SipKey -> Bool)
-> (SipKey -> SipKey -> SipKey)
-> (SipKey -> SipKey -> SipKey)
-> Ord SipKey
SipKey -> SipKey -> Bool
SipKey -> SipKey -> Ordering
SipKey -> SipKey -> SipKey
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
$ccompare :: SipKey -> SipKey -> Ordering
compare :: SipKey -> SipKey -> Ordering
$c< :: SipKey -> SipKey -> Bool
< :: SipKey -> SipKey -> Bool
$c<= :: SipKey -> SipKey -> Bool
<= :: SipKey -> SipKey -> Bool
$c> :: SipKey -> SipKey -> Bool
> :: SipKey -> SipKey -> Bool
$c>= :: SipKey -> SipKey -> Bool
>= :: SipKey -> SipKey -> Bool
$cmax :: SipKey -> SipKey -> SipKey
max :: SipKey -> SipKey -> SipKey
$cmin :: SipKey -> SipKey -> SipKey
min :: SipKey -> SipKey -> SipKey
Ord)

-- | Siphash tag value

newtype SipHash = SipHash Word64
    deriving (Int -> SipHash -> ShowS
[SipHash] -> ShowS
SipHash -> String
(Int -> SipHash -> ShowS)
-> (SipHash -> String) -> ([SipHash] -> ShowS) -> Show SipHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SipHash -> ShowS
showsPrec :: Int -> SipHash -> ShowS
$cshow :: SipHash -> String
show :: SipHash -> String
$cshowList :: [SipHash] -> ShowS
showList :: [SipHash] -> ShowS
Show,SipHash -> SipHash -> Bool
(SipHash -> SipHash -> Bool)
-> (SipHash -> SipHash -> Bool) -> Eq SipHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SipHash -> SipHash -> Bool
== :: SipHash -> SipHash -> Bool
$c/= :: SipHash -> SipHash -> Bool
/= :: SipHash -> SipHash -> Bool
Eq)

data InternalState = InternalState {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64

-- | produce a siphash with a key and a bytestring.

hash :: SipKey -> ByteString -> SipHash
hash :: SipKey -> ByteString -> SipHash
hash = Int -> Int -> SipKey -> ByteString -> SipHash
hashWith Int
2 Int
4

-- | same as 'hash', except also specifies the number of sipround iterations for compression and digest.

hashWith :: Int -> Int -> SipKey -> ByteString -> SipHash
hashWith :: Int -> Int -> SipKey -> ByteString -> SipHash
hashWith Int
c Int
d SipKey
key (PS ForeignPtr Word8
ps Int
s Int
fl) = IO SipHash -> SipHash
forall a. IO a -> a
unsafeDupablePerformIO (IO SipHash -> SipHash) -> IO SipHash -> SipHash
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO SipHash) -> IO SipHash
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ps (\Ptr Word8
ptr -> InternalState -> Ptr Any -> Int -> IO SipHash
forall {a} {b}.
(Ord a, Num a) =>
InternalState -> Ptr b -> a -> IO SipHash
runHash (SipKey -> InternalState
initSip SipKey
key) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
fl)
  where runHash :: InternalState -> Ptr b -> a -> IO SipHash
runHash !InternalState
st !Ptr b
ptr a
l
            | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
7     = Word64 -> Word64
fromLE64 (Word64 -> Word64) -> IO Word64 -> IO Word64
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr b -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr) IO Word64 -> (Word64 -> IO SipHash) -> IO SipHash
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
v -> InternalState -> Ptr b -> a -> IO SipHash
runHash (InternalState -> Word64 -> InternalState
process InternalState
st Word64
v) (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (a
la -> a -> a
forall a. Num a => a -> a -> a
-a
8)
            | Bool
otherwise = do
                let !lengthBlock :: Word64
lengthBlock = (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fl Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
256) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
56
                (InternalState -> SipHash
finish (InternalState -> SipHash)
-> (Word64 -> InternalState) -> Word64 -> SipHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalState -> Word64 -> InternalState
process InternalState
st) (Word64 -> SipHash) -> IO Word64 -> IO SipHash
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` case a
l of
                    a
0 -> do Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
lengthBlock
                    a
1 -> do Word8
v0 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0
                            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
lengthBlock Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
to64 Word8
v0)
                    a
2 -> do (Word8
v0,Word8
v1) <- (Word8 -> Word8 -> (Word8, Word8))
-> IO Word8 -> IO Word8 -> IO (Word8, Word8)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
1)
                            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
lengthBlock
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
to64 Word8
v0)
                    a
3 -> do (Word8
v0,Word8
v1,Word8
v2) <- (Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8))
-> IO Word8 -> IO Word8 -> IO Word8 -> IO (Word8, Word8, Word8)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
1) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
2)
                            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (    Word64
lengthBlock
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
to64 Word8
v0)
                    a
4 -> do (Word8
v0,Word8
v1,Word8
v2,Word8
v3) <- (Word8 -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8))
-> IO Word8
-> IO Word8
-> IO Word8
-> IO Word8
-> IO (Word8, Word8, Word8, Word8)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
1) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
2)
                                                          (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
3)
                            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (    Word64
lengthBlock
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
to64 Word8
v0)
                    a
5 -> do (Word8
v0,Word8
v1,Word8
v2,Word8
v3,Word8
v4) <- (Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> (Word8, Word8, Word8, Word8, Word8))
-> IO Word8
-> IO Word8
-> IO Word8
-> IO Word8
-> IO Word8
-> IO (Word8, Word8, Word8, Word8, Word8)
forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
liftM5 (,,,,) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
1) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
2)
                                                              (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
3) (Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
4)
                            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (    Word64
lengthBlock
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
to64 Word8
v0)
                    a
6 -> do Word8
v0 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0
                            Word8
v1 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
1
                            Word8
v2 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
2
                            Word8
v3 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
3
                            Word8
v4 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
4
                            Word8
v5 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
5
                            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (    Word64
lengthBlock
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
40)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
to64 Word8
v0)
                    a
7 -> do Word8
v0 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0
                            Word8
v1 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
1
                            Word8
v2 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
2
                            Word8
v3 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
3
                            Word8
v4 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
4
                            Word8
v5 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
5
                            Word8
v6 <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
6
                            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (    Word64
lengthBlock
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v6 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
40)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
to64 Word8
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
                                    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
to64 Word8
v0)
                    a
_ -> String -> IO Word64
forall a. HasCallStack => String -> a
error String
"siphash: internal error: cannot happen"

        {-# INLINE to64 #-}
        to64 :: Word8 -> Word64
        to64 :: Word8 -> Word64
to64 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

        {-# INLINE process #-}
        process :: InternalState -> Word64 -> InternalState
process InternalState
istate Word64
m = InternalState
newState
            where newState :: InternalState
newState = InternalState -> InternalState
postInject (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
runRoundsCompression (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
preInject InternalState
istate
                  preInject :: InternalState -> InternalState
preInject  (InternalState Word64
v0 Word64
v1 Word64
v2 Word64
v3) = Word64 -> Word64 -> Word64 -> Word64 -> InternalState
InternalState Word64
v0 Word64
v1 Word64
v2 (Word64
v3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m)
                  postInject :: InternalState -> InternalState
postInject (InternalState Word64
v0 Word64
v1 Word64
v2 Word64
v3) = Word64 -> Word64 -> Word64 -> Word64 -> InternalState
InternalState (Word64
v0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m) Word64
v1 Word64
v2 Word64
v3

        {-# INLINE finish #-}
        finish :: InternalState -> SipHash
finish InternalState
istate = InternalState -> SipHash
getDigest (InternalState -> SipHash) -> InternalState -> SipHash
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
runRoundsDigest (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
preInject InternalState
istate
            where getDigest :: InternalState -> SipHash
getDigest (InternalState Word64
v0 Word64
v1 Word64
v2 Word64
v3) = Word64 -> SipHash
SipHash (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)
                  preInject :: InternalState -> InternalState
preInject (InternalState Word64
v0 Word64
v1 Word64
v2 Word64
v3) = Word64 -> Word64 -> Word64 -> Word64 -> InternalState
InternalState Word64
v0 Word64
v1 (Word64
v2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0xff) Word64
v3

        {-# INLINE doRound #-}
        doRound :: InternalState -> InternalState
doRound (InternalState Word64
v0 Word64
v1 Word64
v2 Word64
v3) =
            let !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
             in Word64 -> Word64 -> Word64 -> Word64 -> InternalState
InternalState Word64
v0''' Word64
v1'''' Word64
v2''' Word64
v3''''

        {-# INLINE runRoundsCompression #-}
        runRoundsCompression :: InternalState -> InternalState
runRoundsCompression InternalState
st
          | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2    = InternalState -> InternalState
doRound (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
doRound InternalState
st
          | Bool
otherwise = Int -> InternalState -> InternalState
forall {t}. (Eq t, Num t) => t -> InternalState -> InternalState
loopRounds Int
c InternalState
st

        {-# INLINE runRoundsDigest #-}
        runRoundsDigest :: InternalState -> InternalState
runRoundsDigest InternalState
st
          | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4    = InternalState -> InternalState
doRound (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
doRound (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
doRound (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$! InternalState -> InternalState
doRound InternalState
st
          | Bool
otherwise = Int -> InternalState -> InternalState
forall {t}. (Eq t, Num t) => t -> InternalState -> InternalState
loopRounds Int
d InternalState
st

        {-# INLINE loopRounds #-}
        loopRounds :: t -> InternalState -> InternalState
loopRounds t
1 !InternalState
v = InternalState -> InternalState
doRound InternalState
v
        loopRounds t
n !InternalState
v = t -> InternalState -> InternalState
loopRounds (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (InternalState -> InternalState
doRound InternalState
v)

        {-# INLINE initSip #-}
        initSip :: SipKey -> InternalState
initSip (SipKey Word64
k0 Word64
k1) = Word64 -> Word64 -> Word64 -> Word64 -> InternalState
InternalState (Word64
k0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x736f6d6570736575)
                                               (Word64
k1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x646f72616e646f6d)
                                               (Word64
k0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x6c7967656e657261)
                                               (Word64
k1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x7465646279746573)