diff --git a/Crypto/Cipher/Types.hs b/Crypto/Cipher/Types.hs new file mode 100644 index 0000000..155b154 --- /dev/null +++ b/Crypto/Cipher/Types.hs @@ -0,0 +1,3 @@ +module Crypto.Cipher.Types + ( + ) where diff --git a/Crypto/Hash/Internal/Kekkak.hs b/Crypto/Hash/Internal/Kekkak.hs index 16830af..8048c06 100644 --- a/Crypto/Hash/Internal/Kekkak.hs +++ b/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 -import Foreign.Marshal.Alloc +import Foreign.Storable (peek) 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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/MD2.hs b/Crypto/Hash/Internal/MD2.hs index 301d532..8f5dabd 100644 --- a/Crypto/Hash/Internal/MD2.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/MD4.hs b/Crypto/Hash/Internal/MD4.hs index db1f889..021322a 100644 --- a/Crypto/Hash/Internal/MD4.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/MD5.hs b/Crypto/Hash/Internal/MD5.hs index 26be51d..6b9024d 100644 --- a/Crypto/Hash/Internal/MD5.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/RIPEMD160.hs b/Crypto/Hash/Internal/RIPEMD160.hs index 8b6f112..3c71849 100644 --- a/Crypto/Hash/Internal/RIPEMD160.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/SHA1.hs b/Crypto/Hash/Internal/SHA1.hs index 575facb..cac99bd 100644 --- a/Crypto/Hash/Internal/SHA1.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/SHA224.hs b/Crypto/Hash/Internal/SHA224.hs index 086241a..3ab5e46 100644 --- a/Crypto/Hash/Internal/SHA224.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/SHA256.hs b/Crypto/Hash/Internal/SHA256.hs index 728376a..986ac1f 100644 --- a/Crypto/Hash/Internal/SHA256.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/SHA3.hs b/Crypto/Hash/Internal/SHA3.hs index ca6c93c..f6e5efc 100644 --- a/Crypto/Hash/Internal/SHA3.hs +++ b/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 -import Foreign.Marshal.Alloc +import Foreign.Storable (peek) 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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/SHA384.hs b/Crypto/Hash/Internal/SHA384.hs index 9d934e2..e8419fd 100644 --- a/Crypto/Hash/Internal/SHA384.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/SHA512.hs b/Crypto/Hash/Internal/SHA512.hs index dfe4a8d..d4a04a0 100644 --- a/Crypto/Hash/Internal/SHA512.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/SHA512t.hs b/Crypto/Hash/Internal/SHA512t.hs index bc91dca..7419bf1 100644 --- a/Crypto/Hash/Internal/SHA512t.hs +++ b/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) diff --git a/Crypto/Hash/Internal/Skein256.hs b/Crypto/Hash/Internal/Skein256.hs index 1f29c7f..d0d5970 100644 --- a/Crypto/Hash/Internal/Skein256.hs +++ b/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 -import Foreign.Marshal.Alloc +import Foreign.Storable (peek) 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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/Skein512.hs b/Crypto/Hash/Internal/Skein512.hs index 67b3ad6..783a315 100644 --- a/Crypto/Hash/Internal/Skein512.hs +++ b/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 -import Foreign.Marshal.Alloc +import Foreign.Storable (peek) 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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/Tiger.hs b/Crypto/Hash/Internal/Tiger.hs index b8d6cef..efb3b9a 100644 --- a/Crypto/Hash/Internal/Tiger.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Internal/Whirlpool.hs b/Crypto/Hash/Internal/Whirlpool.hs index 8c15b50..7fb6f4e 100644 --- a/Crypto/Hash/Internal/Whirlpool.hs +++ b/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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 () diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs index 193637c..9f17cd2 100644 --- a/Crypto/Hash/Types.hs +++ b/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 - -instance Byteable (Context a) where - toBytes (Context bs) = bs - --- | return the binary bytestring. deprecated use toBytes. -contextToByteString :: Context a -> ByteString -contextToByteString = toBytes +newtype Context a = Context Bytes -- | Represent a digest for a given hash algorithm. newtype Digest a = Digest ByteString diff --git a/cryptonite.cabal b/cryptonite.cabal index f46087a..b40164b 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -62,10 +62,9 @@ Library Crypto.Random.Entropy Crypto.Random.EntropyPool Crypto.Random.Entropy.Unsafe - Other-modules: Crypto.Hash.Internal - , Crypto.Hash.Utils - , Crypto.Hash.Utils.Cpu - , Crypto.Hash.Types + Other-modules: Crypto.Hash.Utils + Crypto.Hash.Utils.Cpu + 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 diff --git a/gen/Gen.hs b/gen/Gen.hs index 4838878..f862d43 100644 --- a/gen/Gen.hs +++ b/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 diff --git a/gen/template/hash-internal-len.hs b/gen/template/hash-internal-len.hs index abc7e64..38493c8 100644 --- a/gen/template/hash-internal-len.hs +++ b/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 -import Foreign.Marshal.Alloc +import Foreign.Storable (peek) 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 - where createCtx = create sizeCtx $ \dstPtr -> - withByteStringPtr ctxB $ \srcPtr -> do - memcopy64 (castPtr dstPtr) (castPtr srcPtr) - f (castPtr dstPtr) +withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a -withCtxThrow (Ctx ctxB) 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) +withCtxThrow (Ctx b) f = bytesCopyTemporary b f 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 ()