update modules to use more efficient byte array memory allocation and representation for contextes

Crypto/Cipher/Types.hs

@@ -0,0 +1,3 @@
+module Crypto.Cipher.Types
+    (
+    ) where

Crypto/Hash/Internal/Kekkak.hs

@@ -25,17 +25,15 @@ module Crypto.Hash.Internal.Kekkak
     , withCtxThrow
     ) where
 
-import Prelude hiding (init)
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Storable (peek)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {- return the number of bytes of output for the digest -}
 peekHashlen :: Ptr Ctx -> IO Int
@@ -47,36 +45,14 @@ peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v
 sizeCtx :: Int
 sizeCtx = 360
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(45-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 360 f
 
 foreign import ccall unsafe "cryptonite_kekkak.h cryptonite_kekkak_init"
     c_kekkak_init :: Ptr Ctx -> Word32 -> IO ()
@@ -95,7 +71,7 @@ internalInitAt hashlen ptr = c_kekkak_init ptr (fromIntegral hashlen)
 
 -- | init a context
 internalInit :: Int -> IO Ctx
-internalInit hashlen = withCtxNew (internalInitAt hashlen)
+internalInit hashlen = Ctx `fmap` bytesAlloc 360 (internalInitAt hashlen)
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/MD2.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.MD2
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 16
 sizeCtx :: Int
 sizeCtx = 96
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 96 f
 
 foreign import ccall unsafe "cryptonite_md2.h cryptonite_md2_init"
     c_md2_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_md2_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 96 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/MD4.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.MD4
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 16
 sizeCtx :: Int
 sizeCtx = 96
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 96 f
 
 foreign import ccall unsafe "cryptonite_md4.h cryptonite_md4_init"
     c_md4_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_md4_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 96 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/MD5.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.MD5
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 16
 sizeCtx :: Int
 sizeCtx = 96
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 96 f
 
 foreign import ccall unsafe "cryptonite_md5.h cryptonite_md5_init"
     c_md5_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_md5_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 96 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/RIPEMD160.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.RIPEMD160
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 20
 sizeCtx :: Int
 sizeCtx = 128
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(16-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 128 f
 
 foreign import ccall unsafe "cryptonite_ripemd.h cryptonite_ripemd160_init"
     c_ripemd160_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_ripemd160_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 128 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/SHA1.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.SHA1
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 20
 sizeCtx :: Int
 sizeCtx = 96
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 96 f
 
 foreign import ccall unsafe "cryptonite_sha1.h cryptonite_sha1_init"
     c_sha1_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_sha1_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 96 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/SHA224.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.SHA224
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 28
 sizeCtx :: Int
 sizeCtx = 192
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(24-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 192 f
 
 foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha224_init"
     c_sha224_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_sha224_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 192 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/SHA256.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.SHA256
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 32
 sizeCtx :: Int
 sizeCtx = 192
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(24-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 192 f
 
 foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha256_init"
     c_sha256_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_sha256_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 192 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/SHA3.hs

@@ -25,17 +25,15 @@ module Crypto.Hash.Internal.SHA3
     , withCtxThrow
     ) where
 
-import Prelude hiding (init)
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Storable (peek)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {- return the number of bytes of output for the digest -}
 peekHashlen :: Ptr Ctx -> IO Int
@@ -47,36 +45,14 @@ peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v
 sizeCtx :: Int
 sizeCtx = 360
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(45-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 360 f
 
 foreign import ccall unsafe "cryptonite_sha3.h cryptonite_sha3_init"
     c_sha3_init :: Ptr Ctx -> Word32 -> IO ()
@@ -95,7 +71,7 @@ internalInitAt hashlen ptr = c_sha3_init ptr (fromIntegral hashlen)
 
 -- | init a context
 internalInit :: Int -> IO Ctx
-internalInit hashlen = withCtxNew (internalInitAt hashlen)
+internalInit hashlen = Ctx `fmap` bytesAlloc 360 (internalInitAt hashlen)
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/SHA384.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.SHA384
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 48
 sizeCtx :: Int
 sizeCtx = 256
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(32-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 256 f
 
 foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha384_init"
     c_sha384_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_sha384_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 256 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/SHA512.hs

@@ -21,22 +21,20 @@ module Crypto.Hash.Internal.SHA512
     , internalUpdateUnsafe
     , internalFinalize
     -- * Context copy and creation
-    , withCtxNew
     , withCtxCopy
     , withCtxNewThrow
     , withCtxThrow
+    , withCtxNew
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -46,36 +44,17 @@ digestSize = 64
 sizeCtx :: Int
 sizeCtx = 256
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(32-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 256 f
+
+withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
+withCtxNew f = Ctx `fmap` bytesAlloc 256 f
 
 foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_init"
     c_sha512_init :: Ptr Ctx -> IO ()
@@ -94,7 +73,7 @@ internalInitAt = c_sha512_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 256 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/SHA512t.hs

@@ -21,7 +21,8 @@ module Crypto.Hash.Internal.SHA512t
 
 import Foreign.Ptr
 import Data.Word
-import Crypto.Hash.Internal.SHA512 (withCtxNew, Ctx)
+import Crypto.Hash.Internal.SHA512 (Ctx)
+import qualified Crypto.Hash.Internal.SHA512 as SHA512
 
 foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_init_t"
     c_sha512_init_t :: Ptr Ctx -> Word32 -> IO ()
@@ -32,4 +33,5 @@ internalInitAt hashlen ptr = c_sha512_init_t ptr (fromIntegral hashlen)
 
 -- | init a context using FIPS 180-4 for truncated SHA512
 internalInit :: Int -> IO Ctx
-internalInit hashlen = withCtxNew (internalInitAt hashlen)
+internalInit hashlen = do
+    SHA512.withCtxNew (internalInitAt hashlen)

Crypto/Hash/Internal/Skein256.hs

@@ -25,17 +25,15 @@ module Crypto.Hash.Internal.Skein256
     , withCtxThrow
     ) where
 
-import Prelude hiding (init)
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Storable (peek)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {- return the number of bytes of output for the digest -}
 peekHashlen :: Ptr Ctx -> IO Int
@@ -47,36 +45,14 @@ peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v
 sizeCtx :: Int
 sizeCtx = 96
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 96 f
 
 foreign import ccall unsafe "cryptonite_skein256.h cryptonite_skein256_init"
     c_skein256_init :: Ptr Ctx -> Word32 -> IO ()
@@ -95,7 +71,7 @@ internalInitAt hashlen ptr = c_skein256_init ptr (fromIntegral hashlen)
 
 -- | init a context
 internalInit :: Int -> IO Ctx
-internalInit hashlen = withCtxNew (internalInitAt hashlen)
+internalInit hashlen = Ctx `fmap` bytesAlloc 96 (internalInitAt hashlen)
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/Skein512.hs

@@ -25,17 +25,15 @@ module Crypto.Hash.Internal.Skein512
     , withCtxThrow
     ) where
 
-import Prelude hiding (init)
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Storable (peek)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {- return the number of bytes of output for the digest -}
 peekHashlen :: Ptr Ctx -> IO Int
@@ -47,36 +45,14 @@ peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v
 sizeCtx :: Int
 sizeCtx = 160
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(20-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 160 f
 
 foreign import ccall unsafe "cryptonite_skein512.h cryptonite_skein512_init"
     c_skein512_init :: Ptr Ctx -> Word32 -> IO ()
@@ -95,7 +71,7 @@ internalInitAt hashlen ptr = c_skein512_init ptr (fromIntegral hashlen)
 
 -- | init a context
 internalInit :: Int -> IO Ctx
-internalInit hashlen = withCtxNew (internalInitAt hashlen)
+internalInit hashlen = Ctx `fmap` bytesAlloc 160 (internalInitAt hashlen)
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/Tiger.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.Tiger
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 24
 sizeCtx :: Int
 sizeCtx = 96
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 96 f
 
 foreign import ccall unsafe "cryptonite_tiger.h cryptonite_tiger_init"
     c_tiger_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_tiger_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 96 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Internal/Whirlpool.hs

@@ -27,15 +27,13 @@ module Crypto.Hash.Internal.Whirlpool
     ) where
 
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {-# INLINE digestSize #-}
 digestSize :: Int
@@ -45,36 +43,14 @@ digestSize = 64
 sizeCtx :: Int
 sizeCtx = 168
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(21-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary 168 f
 
 foreign import ccall unsafe "cryptonite_whirlpool.h cryptonite_whirlpool_init"
     c_whirlpool_init :: Ptr Ctx -> IO ()
@@ -93,7 +69,7 @@ internalInitAt = c_whirlpool_init
 
 -- | init a context
 internalInit :: IO Ctx
-internalInit = withCtxNew internalInitAt
+internalInit = Ctx `fmap` bytesAlloc 168 internalInitAt
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()

Crypto/Hash/Types.hs

@@ -11,16 +11,16 @@ module Crypto.Hash.Types
     ( HashAlgorithm(..)
     , Context(..)
     , Digest(..)
-    -- * deprecated
-    , contextToByteString
     , digestToByteString
     )
     where
 
 import Data.ByteString (ByteString)
+import Crypto.Internal.Memory
 import Data.Byteable
 import qualified Data.ByteString.Char8 as BC
 import Crypto.Hash.Utils (toHex)
+import Data.Word
 
 -- | Class representing hashing algorithms.
 --
@@ -50,15 +50,9 @@ class HashAlgorithm a where
     -- | Try to convert a binary digest bytestring to a digest.
     digestFromByteString :: ByteString -> Maybe (Digest a)
 
+
 -- | Represent a context for a given hash algorithm.
-newtype Context a = Context ByteString
+newtype Context a = Context Bytes
-
-instance Byteable (Context a) where
-    toBytes (Context bs) = bs
-
--- | return the binary bytestring. deprecated use toBytes.
-contextToByteString :: Context a -> ByteString
-contextToByteString = toBytes
 
 -- | Represent a digest for a given hash algorithm.
 newtype Digest a = Digest ByteString

cryptonite.cabal

@@ -62,10 +62,9 @@ Library
                      Crypto.Random.Entropy
                      Crypto.Random.EntropyPool
                      Crypto.Random.Entropy.Unsafe
-  Other-modules:     Crypto.Hash.Internal
+  Other-modules:     Crypto.Hash.Utils
-                   , Crypto.Hash.Utils
+                     Crypto.Hash.Utils.Cpu
-                   , Crypto.Hash.Utils.Cpu
+                     Crypto.Hash.Types
-                   , Crypto.Hash.Types
                      Crypto.Hash.Internal.SHA1
                      Crypto.Hash.Internal.SHA224
                      Crypto.Hash.Internal.SHA256
@@ -86,6 +85,7 @@ Library
                    , Crypto.Random.Entropy.Backend
                    , Crypto.Internal.Compat
                    , Crypto.Internal.Bytes
+                   , Crypto.Internal.Memory
   Build-depends:     base >= 4.3 && < 5
                    , bytestring
                    , securemem >= 0.1.7

gen/Gen.hs

@@ -42,6 +42,7 @@ renderHashModules genOpts = do
     hashInternalTemplate    <- readTemplate "template/hash-internal.hs"
     hashLenTemplate         <- readTemplate "template/hash-len.hs"
     hashLenInternalTemplate <- readTemplate "template/hash-internal-len.hs"
+
     forM_ hashModules $ \ghm -> do
         let vars = [ ("MODULENAME", ghmModuleName ghm)
                    , ("HEADER_FILE", ghmHeaderFile ghm)
@@ -58,6 +59,7 @@ renderHashModules genOpts = do
 
         createDirectoryIfMissing True mainDir
         createDirectoryIfMissing True internalDir
+
         if ghmCustomizable ghm
             then do writeTemplate mainName vars hashLenTemplate
                     writeTemplate internalName vars hashLenInternalTemplate

gen/template/hash-internal-len.hs

@@ -25,17 +25,15 @@ module Crypto.Hash.Internal.%%MODULENAME%%
     , withCtxThrow
     ) where
 
-import Prelude hiding (init)
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Storable (peek)
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, toForeignPtr)
+import Data.ByteString.Internal (create)
 import Data.Word
+import Crypto.Internal.Memory
 
-newtype Ctx = Ctx ByteString
+newtype Ctx = Ctx Bytes
 
 {- return the number of bytes of output for the digest -}
 peekHashlen :: Ptr Ctx -> IO Int
@@ -47,36 +45,14 @@ peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v
 sizeCtx :: Int
 sizeCtx = %%SIZECTX%%
 
-{-# INLINE withByteStringPtr #-}
-withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
-withByteStringPtr b f =
-    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
-    where (fptr, off, _) = toForeignPtr b
-
-{-# INLINE memcopy64 #-}
-memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
-memcopy64 dst src = mapM_ peekAndPoke [0..(%%SIZECTX8%%-1)]
-    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
-
 withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
+withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
-    where createCtx = create sizeCtx $ \dstPtr ->
-                      withByteStringPtr ctxB $ \srcPtr -> do
-                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-                          f (castPtr dstPtr)
 
 withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-withCtxThrow (Ctx ctxB) f =
+withCtxThrow (Ctx b) f = bytesCopyTemporary b f
-    allocaBytes sizeCtx $ \dstPtr ->
-    withByteStringPtr ctxB $ \srcPtr -> do
-        memcopy64 (castPtr dstPtr) (castPtr srcPtr)
-        f (castPtr dstPtr)
-
-withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
-withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
 
 withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
-withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
+withCtxNewThrow f = bytesTemporary %%SIZECTX%% f
 
 foreign import ccall unsafe "cryptonite_%%HEADER_FILE%% cryptonite_%%HASHNAME%%_init"
     c_%%HASHNAME%%_init :: Ptr Ctx -> Word32 -> IO ()
@@ -95,7 +71,7 @@ internalInitAt hashlen ptr = c_%%HASHNAME%%_init ptr (fromIntegral hashlen)
 
 -- | init a context
 internalInit :: Int -> IO Ctx
-internalInit hashlen = withCtxNew (internalInitAt hashlen)
+internalInit hashlen = Ctx `fmap` bytesAlloc %%SIZECTX%% (internalInitAt hashlen)
 
 -- | Update a context in place
 internalUpdate :: Ptr Ctx -> ByteString -> IO ()