Initial commit

bundled/Crypto/Internal/Builder.hs

@@ -0,0 +1,53 @@
+-- |
+-- Module      : Crypto.Internal.Builder
+-- License     : BSD-style
+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
+-- Stability   : stable
+-- Portability : Good
+--
+-- Delaying and merging ByteArray allocations.  This is similar to module
+-- "Data.ByteArray.Pack" except the total length is computed automatically based
+-- on what is appended.
+--
+{-# LANGUAGE BangPatterns #-}
+module Crypto.Internal.Builder
+    ( Builder
+    , buildAndFreeze
+    , builderLength
+    , byte
+    , bytes
+    , zero
+    ) where
+
+import           Data.ByteArray (ByteArray, ByteArrayAccess)
+import qualified Data.ByteArray as B
+import           Data.Memory.PtrMethods (memSet)
+
+import           Foreign.Ptr (Ptr, plusPtr)
+import           Foreign.Storable (poke)
+
+import           Crypto.Internal.Imports hiding (empty)
+
+data Builder =  Builder !Int (Ptr Word8 -> IO ())  -- size and initializer
+
+instance Semigroup Builder where
+    (Builder s1 f1) <> (Builder s2 f2) = Builder (s1 + s2) f
+      where f p = f1 p >> f2 (p `plusPtr` s1)
+
+builderLength :: Builder -> Int
+builderLength (Builder s _) = s
+
+buildAndFreeze :: ByteArray ba => Builder -> ba
+buildAndFreeze (Builder s f) = B.allocAndFreeze s f
+
+byte :: Word8 -> Builder
+byte !b = Builder 1 (`poke` b)
+
+bytes :: ByteArrayAccess ba => ba -> Builder
+bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs)
+
+zero :: Int -> Builder
+zero s = if s > 0 then Builder s (\p -> memSet p 0 s) else empty
+
+empty :: Builder
+empty = Builder 0 (const $ return ())

bundled/Crypto/Internal/ByteArray.hs

@@ -0,0 +1,39 @@
+-- |
+-- Module      : Crypto.Internal.ByteArray
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Good
+--
+-- Simple and efficient byte array types
+--
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_HADDOCK hide #-}
+module Crypto.Internal.ByteArray
+    ( module Data.ByteArray
+    , module Data.ByteArray.Mapping
+    , module Data.ByteArray.Encoding
+    , constAllZero
+    ) where
+
+import Data.ByteArray
+import Data.ByteArray.Mapping
+import Data.ByteArray.Encoding
+
+import Data.Bits ((.|.))
+import Data.Word (Word8)
+import Foreign.Ptr (Ptr)
+import Foreign.Storable (peekByteOff)
+
+import Crypto.Internal.Compat (unsafeDoIO)
+
+constAllZero :: ByteArrayAccess ba => ba -> Bool
+constAllZero b = unsafeDoIO $ withByteArray b $ \p -> loop p 0 0
+  where
+    loop :: Ptr b -> Int -> Word8 -> IO Bool
+    loop p i !acc
+        | i == len  = return $! acc == 0
+        | otherwise = do
+            e <- peekByteOff p i
+            loop p (i+1) (acc .|. e)
+    len = Data.ByteArray.length b

bundled/Crypto/Internal/Compat.hs

@@ -0,0 +1,48 @@
+-- |
+-- Module      : Crypto.Internal.Compat
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Good
+--
+-- This module tries to keep all the difference between versions of base
+-- or other needed packages, so that modules don't need to use CPP.
+--
+{-# LANGUAGE CPP #-}
+module Crypto.Internal.Compat
+    ( unsafeDoIO
+    , popCount
+    , byteSwap64
+    ) where
+
+import System.IO.Unsafe
+import Data.Word
+import Data.Bits
+
+-- | Perform io for hashes that do allocation and FFI.
+-- 'unsafeDupablePerformIO' is used when possible as the
+-- computation is pure and the output is directly linked
+-- to the input. We also do not modify anything after it has
+-- been returned to the user.
+unsafeDoIO :: IO a -> a
+#if __GLASGOW_HASKELL__ > 704
+unsafeDoIO = unsafeDupablePerformIO
+#else
+unsafeDoIO = unsafePerformIO
+#endif
+
+#if !(MIN_VERSION_base(4,5,0))
+popCount :: Word64 -> Int
+popCount n = loop 0 n
+  where loop c 0 = c
+        loop c i = loop (c + if testBit c 0 then 1 else 0) (i `shiftR` 1)
+#endif
+
+#if !(MIN_VERSION_base(4,7,0))
+byteSwap64 :: Word64 -> Word64
+byteSwap64 w =
+        (w `shiftR` 56)                  .|. (w `shiftL` 56)
+    .|. ((w `shiftR` 40) .&. 0xff00)     .|. ((w .&. 0xff00) `shiftL` 40)
+    .|. ((w `shiftR` 24) .&. 0xff0000)   .|. ((w .&. 0xff0000) `shiftL` 24)
+    .|. ((w `shiftR` 8)  .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)
+#endif

bundled/Crypto/Internal/CompatPrim.hs

@@ -0,0 +1,109 @@
+-- |
+-- Module      : Crypto.Internal.CompatPrim
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Compat
+--
+-- This module tries to keep all the difference between versions of ghc primitive
+-- or other needed packages, so that modules don't need to use CPP.
+--
+-- Note that MagicHash and CPP conflicts in places, making it "more interesting"
+-- to write compat code for primitives.
+--
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+module Crypto.Internal.CompatPrim
+    ( be32Prim
+    , le32Prim
+    , byteswap32Prim
+    , booleanPrim
+    , convert4To32
+    ) where
+
+#if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)
+import Data.Memory.Endian (getSystemEndianness, Endianness(..))
+#endif
+
+#if __GLASGOW_HASKELL__ >= 902
+import GHC.Prim
+#else
+import GHC.Prim hiding (Word32#)
+type Word32# = Word#
+#endif
+
+-- | Byteswap Word# to or from Big Endian
+--
+-- On a big endian machine, this function is a nop.
+be32Prim :: Word32# -> Word32#
+#ifdef ARCH_IS_LITTLE_ENDIAN
+be32Prim = byteswap32Prim
+#elif defined(ARCH_IS_BIG_ENDIAN)
+be32Prim = id
+#else
+be32Prim w = if getSystemEndianness == LittleEndian then byteswap32Prim w else w
+#endif
+
+-- | Byteswap Word# to or from Little Endian
+--
+-- On a little endian machine, this function is a nop.
+le32Prim :: Word32# -> Word32#
+#ifdef ARCH_IS_LITTLE_ENDIAN
+le32Prim w = w
+#elif defined(ARCH_IS_BIG_ENDIAN)
+le32Prim = byteswap32Prim
+#else
+le32Prim w = if getSystemEndianness == LittleEndian then w else byteswap32Prim w
+#endif
+
+-- | Simple compatibility for byteswap the lower 32 bits of a Word#
+-- at the primitive level
+byteswap32Prim :: Word32# -> Word32#
+#if __GLASGOW_HASKELL__ >= 902
+byteswap32Prim w = wordToWord32# (byteSwap32# (word32ToWord# w))
+#else
+byteswap32Prim w = byteSwap32# w
+#endif
+
+-- | Combine 4 word8 [a,b,c,d] to a word32 representing [a,b,c,d]
+convert4To32 :: Word# -> Word# -> Word# -> Word#
+             -> Word#
+convert4To32 a b c d = or# (or# c1 c2) (or# c3 c4)
+  where
+#ifdef ARCH_IS_LITTLE_ENDIAN
+        !c1 = uncheckedShiftL# a 24#
+        !c2 = uncheckedShiftL# b 16#
+        !c3 = uncheckedShiftL# c 8#
+        !c4 = d
+#elif defined(ARCH_IS_BIG_ENDIAN)
+        !c1 = uncheckedShiftL# d 24#
+        !c2 = uncheckedShiftL# c 16#
+        !c3 = uncheckedShiftL# b 8#
+        !c4 = a
+#else
+        !c1
+            | getSystemEndianness == LittleEndian = uncheckedShiftL# a 24#
+            | otherwise                           = uncheckedShiftL# d 24#
+        !c2
+            | getSystemEndianness == LittleEndian = uncheckedShiftL# b 16#
+            | otherwise                           = uncheckedShiftL# c 16#
+        !c3
+            | getSystemEndianness == LittleEndian = uncheckedShiftL# c 8#
+            | otherwise                           = uncheckedShiftL# b 8#
+        !c4
+            | getSystemEndianness == LittleEndian = d
+            | otherwise                           = a
+#endif
+
+-- | Simple wrapper to handle pre 7.8 and future, where
+-- most comparaison functions don't returns a boolean
+-- anymore.
+#if __GLASGOW_HASKELL__ >= 708
+booleanPrim :: Int# -> Bool
+booleanPrim v = tagToEnum# v
+#else
+booleanPrim :: Bool -> Bool
+booleanPrim b = b
+#endif

bundled/Crypto/Internal/DeepSeq.hs

@@ -0,0 +1,35 @@
+-- |
+-- Module      : Crypto.Internal.DeepSeq
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Simple abstraction module to allow compilation without deepseq
+-- by defining our own NFData class if not compiling with deepseq
+-- support.
+--
+{-# LANGUAGE CPP #-}
+module Crypto.Internal.DeepSeq
+    ( NFData(..)
+    ) where
+
+#ifdef WITH_DEEPSEQ_SUPPORT
+import Control.DeepSeq
+#else
+import Data.Word
+import Data.ByteArray
+
+class NFData a where rnf :: a -> ()
+
+instance NFData Word8 where rnf w = w `seq` ()
+instance NFData Word16 where rnf w = w `seq` ()
+instance NFData Word32 where rnf w = w `seq` ()
+instance NFData Word64 where rnf w = w `seq` ()
+
+instance NFData Bytes where rnf b = b `seq` ()
+instance NFData ScrubbedBytes where rnf b = b `seq` ()
+
+instance NFData Integer  where rnf i = i `seq` ()
+
+#endif

bundled/Crypto/Internal/Imports.hs

@@ -0,0 +1,20 @@
+-- |
+-- Module      : Crypto.Internal.Imports
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+{-# LANGUAGE CPP #-}
+module Crypto.Internal.Imports
+    ( module X
+    ) where
+
+import Data.Word               as X
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup          as X (Semigroup(..))
+#endif
+import Control.Applicative     as X
+import Control.Monad           as X (forM, forM_, void)
+import Control.Arrow           as X (first, second)
+import Crypto.Internal.DeepSeq as X

bundled/Crypto/Internal/Nat.hs

@@ -0,0 +1,213 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Crypto.Internal.Nat
+    ( type IsDivisibleBy8
+    , type IsAtMost, type IsAtLeast
+    , byteLen
+    , integralNatVal
+    , type IsDiv8
+    , type Div8
+    , type Mod8
+    ) where
+
+import           GHC.TypeLits
+
+byteLen :: (KnownNat bitlen, Num a) => proxy bitlen -> a
+byteLen d = fromInteger ((natVal d + 7) `div` 8)
+
+integralNatVal :: (KnownNat bitlen, Num a) => proxy bitlen -> a
+integralNatVal = fromInteger . natVal
+
+type family IsLE (bitlen :: Nat) (n :: Nat) (c :: Bool) where
+    IsLE _ _ 'True  = 'True
+#if MIN_VERSION_base(4,9,0)
+    IsLE bitlen n 'False = TypeError
+      (     ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is greater than " ':<>: 'ShowType n)
+      ':$$: ('Text "You have tried to use an invalid Digest size. Please, refer to the documentation.")
+      )
+#else
+    IsLE bitlen n 'False = 'False
+#endif
+
+-- | ensure the given `bitlen` is lesser or equal to `n`
+--
+type IsAtMost  (bitlen :: Nat) (n :: Nat) = IsLE bitlen n (bitlen <=? n) ~ 'True
+
+type family IsGE (bitlen :: Nat) (n :: Nat) (c :: Bool) where
+    IsGE _ _ 'True  = 'True
+#if MIN_VERSION_base(4,9,0)
+    IsGE bitlen n 'False = TypeError
+      (     ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is lesser than " ':<>: 'ShowType n)
+      ':$$: ('Text "You have tried to use an invalid Digest size. Please, refer to the documentation.")
+      )
+#else
+    IsGE bitlen n 'False = 'False
+#endif
+
+-- | ensure the given `bitlen` is greater or equal to `n`
+--
+type IsAtLeast (bitlen :: Nat) (n :: Nat) = IsGE bitlen n (n <=? bitlen) ~ 'True
+
+type family Div8 (bitLen :: Nat) where
+    Div8 0 = 0
+    Div8 1 = 0
+    Div8 2 = 0
+    Div8 3 = 0
+    Div8 4 = 0
+    Div8 5 = 0
+    Div8 6 = 0
+    Div8 7 = 0
+    Div8 8 = 1
+    Div8 9 = 1
+    Div8 10 = 1
+    Div8 11 = 1
+    Div8 12 = 1
+    Div8 13 = 1
+    Div8 14 = 1
+    Div8 15 = 1
+    Div8 16 = 2
+    Div8 17 = 2
+    Div8 18 = 2
+    Div8 19 = 2
+    Div8 20 = 2
+    Div8 21 = 2
+    Div8 22 = 2
+    Div8 23 = 2
+    Div8 24 = 3
+    Div8 25 = 3
+    Div8 26 = 3
+    Div8 27 = 3
+    Div8 28 = 3
+    Div8 29 = 3
+    Div8 30 = 3
+    Div8 31 = 3
+    Div8 32 = 4
+    Div8 33 = 4
+    Div8 34 = 4
+    Div8 35 = 4
+    Div8 36 = 4
+    Div8 37 = 4
+    Div8 38 = 4
+    Div8 39 = 4
+    Div8 40 = 5
+    Div8 41 = 5
+    Div8 42 = 5
+    Div8 43 = 5
+    Div8 44 = 5
+    Div8 45 = 5
+    Div8 46 = 5
+    Div8 47 = 5
+    Div8 48 = 6
+    Div8 49 = 6
+    Div8 50 = 6
+    Div8 51 = 6
+    Div8 52 = 6
+    Div8 53 = 6
+    Div8 54 = 6
+    Div8 55 = 6
+    Div8 56 = 7
+    Div8 57 = 7
+    Div8 58 = 7
+    Div8 59 = 7
+    Div8 60 = 7
+    Div8 61 = 7
+    Div8 62 = 7
+    Div8 63 = 7
+    Div8 64 = 8
+    Div8 n  = 8 + Div8 (n - 64)
+
+type family IsDiv8 (bitLen :: Nat) (n :: Nat) where
+    IsDiv8 _ 0 = 'True
+#if MIN_VERSION_base(4,9,0)
+    IsDiv8 bitLen 1 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 2 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 3 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 4 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 5 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 6 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 7 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+#else
+    IsDiv8 _ 1 = 'False
+    IsDiv8 _ 2 = 'False
+    IsDiv8 _ 3 = 'False
+    IsDiv8 _ 4 = 'False
+    IsDiv8 _ 5 = 'False
+    IsDiv8 _ 6 = 'False
+    IsDiv8 _ 7 = 'False
+#endif
+    IsDiv8 _ n = IsDiv8 n (Mod8 n)
+
+type family Mod8 (n :: Nat) where
+    Mod8 0 = 0
+    Mod8 1 = 1
+    Mod8 2 = 2
+    Mod8 3 = 3
+    Mod8 4 = 4
+    Mod8 5 = 5
+    Mod8 6 = 6
+    Mod8 7 = 7
+    Mod8 8 = 0
+    Mod8 9 = 1
+    Mod8 10 = 2
+    Mod8 11 = 3
+    Mod8 12 = 4
+    Mod8 13 = 5
+    Mod8 14 = 6
+    Mod8 15 = 7
+    Mod8 16 = 0
+    Mod8 17 = 1
+    Mod8 18 = 2
+    Mod8 19 = 3
+    Mod8 20 = 4
+    Mod8 21 = 5
+    Mod8 22 = 6
+    Mod8 23 = 7
+    Mod8 24 = 0
+    Mod8 25 = 1
+    Mod8 26 = 2
+    Mod8 27 = 3
+    Mod8 28 = 4
+    Mod8 29 = 5
+    Mod8 30 = 6
+    Mod8 31 = 7
+    Mod8 32 = 0
+    Mod8 33 = 1
+    Mod8 34 = 2
+    Mod8 35 = 3
+    Mod8 36 = 4
+    Mod8 37 = 5
+    Mod8 38 = 6
+    Mod8 39 = 7
+    Mod8 40 = 0
+    Mod8 41 = 1
+    Mod8 42 = 2
+    Mod8 43 = 3
+    Mod8 44 = 4
+    Mod8 45 = 5
+    Mod8 46 = 6
+    Mod8 47 = 7
+    Mod8 48 = 0
+    Mod8 49 = 1
+    Mod8 50 = 2
+    Mod8 51 = 3
+    Mod8 52 = 4
+    Mod8 53 = 5
+    Mod8 54 = 6
+    Mod8 55 = 7
+    Mod8 56 = 0
+    Mod8 57 = 1
+    Mod8 58 = 2
+    Mod8 59 = 3
+    Mod8 60 = 4
+    Mod8 61 = 5
+    Mod8 62 = 6
+    Mod8 63 = 7
+    Mod8 n = Mod8 (n - 64)
+
+-- | ensure the given `bitlen` is divisible by 8
+--
+type IsDivisibleBy8 bitLen = IsDiv8 bitLen bitLen ~ 'True

bundled/Crypto/Internal/WordArray.hs

@@ -0,0 +1,157 @@
+-- |
+-- Module      : Crypto.Internal.WordArray
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Good
+--
+-- Small and self contained array representation
+-- with limited safety for internal use.
+--
+-- The array produced should never be exposed to the user directly.
+--
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+module Crypto.Internal.WordArray
+    ( Array8
+    , Array32
+    , Array64
+    , MutableArray32
+    , array8
+    , array32
+    , array32FromAddrBE
+    , allocArray32AndFreeze
+    , mutableArray32
+    , array64
+    , arrayRead8
+    , arrayRead32
+    , arrayRead64
+    , mutableArrayRead32
+    , mutableArrayWrite32
+    , mutableArrayWriteXor32
+    , mutableArray32FromAddrBE
+    , mutableArray32Freeze
+    ) where
+
+import Data.Word
+import Data.Bits (xor)
+import Crypto.Internal.Compat
+import Crypto.Internal.CompatPrim
+import GHC.Prim
+import GHC.Types
+import GHC.Word
+
+-- | Array of Word8
+data Array8 = Array8 Addr#
+
+-- | Array of Word32
+data Array32 = Array32 ByteArray#
+
+-- | Array of Word64
+data Array64 = Array64 ByteArray#
+
+-- | Array of mutable Word32
+data MutableArray32 = MutableArray32 (MutableByteArray# RealWorld)
+
+-- | Create an array of Word8 aliasing an Addr#
+array8 :: Addr# -> Array8
+array8 = Array8
+
+-- | Create an Array of Word32 of specific size from a list of Word32
+array32 :: Int -> [Word32] -> Array32
+array32 n l = unsafeDoIO (mutableArray32 n l >>= mutableArray32Freeze)
+{-# NOINLINE array32 #-}
+
+-- | Create an Array of BE Word32 aliasing an Addr
+array32FromAddrBE :: Int -> Addr# -> Array32
+array32FromAddrBE n a =
+    unsafeDoIO (mutableArray32FromAddrBE n a >>= mutableArray32Freeze)
+{-# NOINLINE array32FromAddrBE #-}
+
+-- | Create an Array of Word32 using an initializer
+allocArray32AndFreeze :: Int -> (MutableArray32 -> IO ()) -> Array32
+allocArray32AndFreeze n f =
+    unsafeDoIO (mutableArray32 n [] >>= \m -> f m >> mutableArray32Freeze m)
+{-# NOINLINE allocArray32AndFreeze #-}
+
+-- | Create an Array of Word64 of specific size from a list of Word64
+array64 :: Int -> [Word64] -> Array64
+array64 (I# n) l = unsafeDoIO $ IO $ \s ->
+    case newAlignedPinnedByteArray# (n *# 8#) 8# s of
+        (# s', mbarr #) -> loop 0# s' mbarr l
+  where
+        loop _ st mb [] = freezeArray mb st
+        loop i st mb ((W64# x):xs)
+            | booleanPrim (i ==# n) = freezeArray mb st
+            | otherwise =
+                let !st' = writeWord64Array# mb i x st
+                 in loop (i +# 1#) st' mb xs
+        freezeArray mb st =
+            case unsafeFreezeByteArray# mb st of
+                (# st', b #) -> (# st', Array64 b #)
+{-# NOINLINE array64 #-}
+
+-- | Create a Mutable Array of Word32 of specific size from a list of Word32
+mutableArray32 :: Int -> [Word32] -> IO MutableArray32
+mutableArray32 (I# n) l = IO $ \s ->
+    case newAlignedPinnedByteArray# (n *# 4#) 4# s of
+        (# s', mbarr #) -> loop 0# s' mbarr l
+  where
+        loop _ st mb [] = (# st, MutableArray32 mb #)
+        loop i st mb ((W32# x):xs)
+            | booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
+            | otherwise =
+                let !st' = writeWord32Array# mb i x st
+                 in loop (i +# 1#) st' mb xs
+
+-- | Create a Mutable Array of BE Word32 aliasing an Addr
+mutableArray32FromAddrBE :: Int -> Addr# -> IO MutableArray32
+mutableArray32FromAddrBE (I# n) a = IO $ \s ->
+    case newAlignedPinnedByteArray# (n *# 4#) 4# s of
+        (# s', mbarr #) -> loop 0# s' mbarr
+  where
+        loop i st mb
+            | booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
+            | otherwise             =
+                let !st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st
+                 in loop (i +# 1#) st' mb
+
+-- | freeze a Mutable Array of Word32 into a immutable Array of Word32
+mutableArray32Freeze :: MutableArray32 -> IO Array32
+mutableArray32Freeze (MutableArray32 mb) = IO $ \st ->
+    case unsafeFreezeByteArray# mb st of
+        (# st', b #) -> (# st', Array32 b #)
+
+-- | Read a Word8 from an Array
+arrayRead8 :: Array8 -> Int -> Word8
+arrayRead8 (Array8 a) (I# o) = W8# (indexWord8OffAddr# a o)
+{-# INLINE arrayRead8 #-}
+
+-- | Read a Word32 from an Array
+arrayRead32 :: Array32 -> Int -> Word32
+arrayRead32 (Array32 b) (I# o) = W32# (indexWord32Array# b o)
+{-# INLINE arrayRead32 #-}
+
+-- | Read a Word64 from an Array
+arrayRead64 :: Array64 -> Int -> Word64
+arrayRead64 (Array64 b) (I# o) = W64# (indexWord64Array# b o)
+{-# INLINE arrayRead64 #-}
+
+-- | Read a Word32 from a Mutable Array of Word32
+mutableArrayRead32 :: MutableArray32 -> Int -> IO Word32
+mutableArrayRead32 (MutableArray32 m) (I# o) = IO $ \s -> case readWord32Array# m o s of (# s', e #) -> (# s', W32# e #)
+{-# INLINE mutableArrayRead32 #-}
+
+-- | Write a Word32 from a Mutable Array of Word32
+mutableArrayWrite32 :: MutableArray32 -> Int -> Word32 -> IO ()
+mutableArrayWrite32 (MutableArray32 m) (I# o) (W32# w) = IO $ \s -> let !s' = writeWord32Array# m o w s in (# s', () #)
+{-# INLINE mutableArrayWrite32 #-}
+
+-- | Write into the Mutable Array of Word32 by combining through xor the current value and the new value.
+--
+-- > x[i] = x[i] xor value
+mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO ()
+mutableArrayWriteXor32 m o w =
+    mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w)
+{-# INLINE mutableArrayWriteXor32 #-}

bundled/Crypto/Internal/Words.hs

@@ -0,0 +1,26 @@
+-- |
+-- Module      : Crypto.Internal.Words
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Extra Word size
+--
+module Crypto.Internal.Words
+    ( Word128(..)
+    , w64to32
+    , w32to64
+    ) where
+
+import Data.Word
+import Data.Bits
+import Data.Memory.ExtendedWords
+
+-- | Split a 'Word64' into the highest and lowest 'Word32'
+w64to32 :: Word64 -> (Word32, Word32)
+w64to32 w = (fromIntegral (w `shiftR` 32), fromIntegral w)
+
+-- | Reconstruct a 'Word64' from two 'Word32'
+w32to64 :: (Word32, Word32) -> Word64
+w32to64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)