From 70e2321d95ec15786f0b1e904dacbbb20432b2a4 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sun, 8 Feb 2015 12:03:00 +0000 Subject: [PATCH] update architectures of modules to separate IO and mutable parts from the immutable part --- Crypto/Hash/Internal/Kekkak.hs | 104 ++++++++++++++++++++++++++++++ Crypto/Hash/Internal/MD2.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/MD4.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/MD5.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/RIPEMD160.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/SHA1.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/SHA224.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/SHA256.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/SHA3.hs | 104 ++++++++++++++++++++++++++++++ Crypto/Hash/Internal/SHA384.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/SHA512.hs | 102 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/SHA512t.hs | 35 ++++++++++ Crypto/Hash/Internal/Skein256.hs | 104 ++++++++++++++++++++++++++++++ Crypto/Hash/Internal/Skein512.hs | 104 ++++++++++++++++++++++++++++++ Crypto/Hash/Internal/Tiger.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Internal/Whirlpool.hs | 101 +++++++++++++++++++++++++++++ Crypto/Hash/Kekkak.hs | 86 ++---------------------- Crypto/Hash/MD2.hs | 78 ++-------------------- Crypto/Hash/MD4.hs | 78 ++-------------------- Crypto/Hash/MD5.hs | 78 ++-------------------- Crypto/Hash/RIPEMD160.hs | 78 ++-------------------- Crypto/Hash/SHA1.hs | 78 ++-------------------- Crypto/Hash/SHA224.hs | 78 ++-------------------- Crypto/Hash/SHA256.hs | 78 ++-------------------- Crypto/Hash/SHA3.hs | 86 ++---------------------- Crypto/Hash/SHA384.hs | 78 ++-------------------- Crypto/Hash/SHA512.hs | 87 ++----------------------- Crypto/Hash/SHA512t.hs | 6 +- Crypto/Hash/Skein256.hs | 86 ++---------------------- Crypto/Hash/Skein512.hs | 86 ++---------------------- Crypto/Hash/Tiger.hs | 78 ++-------------------- Crypto/Hash/Whirlpool.hs | 78 ++-------------------- cryptonite.cabal | 16 +++++ 33 files changed, 1689 insertions(+), 1107 deletions(-) create mode 100644 Crypto/Hash/Internal/Kekkak.hs create mode 100644 Crypto/Hash/Internal/MD2.hs create mode 100644 Crypto/Hash/Internal/MD4.hs create mode 100644 Crypto/Hash/Internal/MD5.hs create mode 100644 Crypto/Hash/Internal/RIPEMD160.hs create mode 100644 Crypto/Hash/Internal/SHA1.hs create mode 100644 Crypto/Hash/Internal/SHA224.hs create mode 100644 Crypto/Hash/Internal/SHA256.hs create mode 100644 Crypto/Hash/Internal/SHA3.hs create mode 100644 Crypto/Hash/Internal/SHA384.hs create mode 100644 Crypto/Hash/Internal/SHA512.hs create mode 100644 Crypto/Hash/Internal/SHA512t.hs create mode 100644 Crypto/Hash/Internal/Skein256.hs create mode 100644 Crypto/Hash/Internal/Skein512.hs create mode 100644 Crypto/Hash/Internal/Tiger.hs create mode 100644 Crypto/Hash/Internal/Whirlpool.hs diff --git a/Crypto/Hash/Internal/Kekkak.hs b/Crypto/Hash/Internal/Kekkak.hs new file mode 100644 index 0000000..bcc24ba --- /dev/null +++ b/Crypto/Hash/Internal/Kekkak.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.Kekkak +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing Kekkak bindings +-- +module Crypto.Hash.Internal.Kekkak + ( Ctx(..) + -- * Internal values + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) where + +import Prelude hiding (init) +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.Word + +newtype Ctx = Ctx ByteString + +{- return the number of bytes of output for the digest -} +peekHashlen :: Ptr Ctx -> IO Int +peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v + where iptr :: Ptr Word32 + iptr = castPtr ptr + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_kekkak.h cryptonite_kekkak_init" + c_kekkak_init :: Ptr Ctx -> Word32 -> IO () + +foreign import ccall "cryptonite_kekkak.h cryptonite_kekkak_update" + c_kekkak_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_kekkak.h cryptonite_kekkak_finalize" + c_kekkak_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Int -> Ptr Ctx -> IO () +internalInitAt hashlen ptr = c_kekkak_init ptr (fromIntegral hashlen) + +-- | init a context +internalInit :: Int -> IO Ctx +internalInit hashlen = withCtxNew (internalInitAt hashlen) + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_kekkak_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = + peekHashlen ptr >>= \digestSize -> create digestSize (c_kekkak_finalize ptr) diff --git a/Crypto/Hash/Internal/MD2.hs b/Crypto/Hash/Internal/MD2.hs new file mode 100644 index 0000000..d7d9aa4 --- /dev/null +++ b/Crypto/Hash/Internal/MD2.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.MD2 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing MD2 bindings +-- +module Crypto.Hash.Internal.MD2 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 16 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_md2.h cryptonite_md2_init" + c_md2_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_md2.h cryptonite_md2_update" + c_md2_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_md2.h cryptonite_md2_finalize" + c_md2_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_md2_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_md2_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_md2_finalize ptr) diff --git a/Crypto/Hash/Internal/MD4.hs b/Crypto/Hash/Internal/MD4.hs new file mode 100644 index 0000000..a2b8ecd --- /dev/null +++ b/Crypto/Hash/Internal/MD4.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.MD4 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing MD4 bindings +-- +module Crypto.Hash.Internal.MD4 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 16 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_md4.h cryptonite_md4_init" + c_md4_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_md4.h cryptonite_md4_update" + c_md4_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_md4.h cryptonite_md4_finalize" + c_md4_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_md4_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_md4_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_md4_finalize ptr) diff --git a/Crypto/Hash/Internal/MD5.hs b/Crypto/Hash/Internal/MD5.hs new file mode 100644 index 0000000..4039a98 --- /dev/null +++ b/Crypto/Hash/Internal/MD5.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.MD5 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing MD5 bindings +-- +module Crypto.Hash.Internal.MD5 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 16 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_md5.h cryptonite_md5_init" + c_md5_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_md5.h cryptonite_md5_update" + c_md5_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_md5.h cryptonite_md5_finalize" + c_md5_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_md5_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_md5_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_md5_finalize ptr) diff --git a/Crypto/Hash/Internal/RIPEMD160.hs b/Crypto/Hash/Internal/RIPEMD160.hs new file mode 100644 index 0000000..ad3e64b --- /dev/null +++ b/Crypto/Hash/Internal/RIPEMD160.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.RIPEMD160 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing RIPEMD160 bindings +-- +module Crypto.Hash.Internal.RIPEMD160 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 20 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_ripemd.h cryptonite_ripemd160_init" + c_ripemd160_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_ripemd.h cryptonite_ripemd160_update" + c_ripemd160_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_ripemd.h cryptonite_ripemd160_finalize" + c_ripemd160_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_ripemd160_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_ripemd160_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_ripemd160_finalize ptr) diff --git a/Crypto/Hash/Internal/SHA1.hs b/Crypto/Hash/Internal/SHA1.hs new file mode 100644 index 0000000..87e2bc6 --- /dev/null +++ b/Crypto/Hash/Internal/SHA1.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.SHA1 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing SHA1 bindings +-- +module Crypto.Hash.Internal.SHA1 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 20 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_sha1.h cryptonite_sha1_init" + c_sha1_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_sha1.h cryptonite_sha1_update" + c_sha1_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_sha1.h cryptonite_sha1_finalize" + c_sha1_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_sha1_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_sha1_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_sha1_finalize ptr) diff --git a/Crypto/Hash/Internal/SHA224.hs b/Crypto/Hash/Internal/SHA224.hs new file mode 100644 index 0000000..9f5fe20 --- /dev/null +++ b/Crypto/Hash/Internal/SHA224.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.SHA224 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing SHA224 bindings +-- +module Crypto.Hash.Internal.SHA224 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 28 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha224_init" + c_sha224_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_sha256.h cryptonite_sha224_update" + c_sha224_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha224_finalize" + c_sha224_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_sha224_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_sha224_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_sha224_finalize ptr) diff --git a/Crypto/Hash/Internal/SHA256.hs b/Crypto/Hash/Internal/SHA256.hs new file mode 100644 index 0000000..e418bb1 --- /dev/null +++ b/Crypto/Hash/Internal/SHA256.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.SHA256 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing SHA256 bindings +-- +module Crypto.Hash.Internal.SHA256 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 32 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha256_init" + c_sha256_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_sha256.h cryptonite_sha256_update" + c_sha256_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha256_finalize" + c_sha256_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_sha256_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_sha256_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_sha256_finalize ptr) diff --git a/Crypto/Hash/Internal/SHA3.hs b/Crypto/Hash/Internal/SHA3.hs new file mode 100644 index 0000000..8f5ee6b --- /dev/null +++ b/Crypto/Hash/Internal/SHA3.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.SHA3 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing SHA3 bindings +-- +module Crypto.Hash.Internal.SHA3 + ( Ctx(..) + -- * Internal values + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) where + +import Prelude hiding (init) +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.Word + +newtype Ctx = Ctx ByteString + +{- return the number of bytes of output for the digest -} +peekHashlen :: Ptr Ctx -> IO Int +peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v + where iptr :: Ptr Word32 + iptr = castPtr ptr + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_sha3.h cryptonite_sha3_init" + c_sha3_init :: Ptr Ctx -> Word32 -> IO () + +foreign import ccall "cryptonite_sha3.h cryptonite_sha3_update" + c_sha3_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_sha3.h cryptonite_sha3_finalize" + c_sha3_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Int -> Ptr Ctx -> IO () +internalInitAt hashlen ptr = c_sha3_init ptr (fromIntegral hashlen) + +-- | init a context +internalInit :: Int -> IO Ctx +internalInit hashlen = withCtxNew (internalInitAt hashlen) + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_sha3_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = + peekHashlen ptr >>= \digestSize -> create digestSize (c_sha3_finalize ptr) diff --git a/Crypto/Hash/Internal/SHA384.hs b/Crypto/Hash/Internal/SHA384.hs new file mode 100644 index 0000000..ff65663 --- /dev/null +++ b/Crypto/Hash/Internal/SHA384.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.SHA384 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing SHA384 bindings +-- +module Crypto.Hash.Internal.SHA384 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 48 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha384_init" + c_sha384_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_sha512.h cryptonite_sha384_update" + c_sha384_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha384_finalize" + c_sha384_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_sha384_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_sha384_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_sha384_finalize ptr) diff --git a/Crypto/Hash/Internal/SHA512.hs b/Crypto/Hash/Internal/SHA512.hs new file mode 100644 index 0000000..793d4b3 --- /dev/null +++ b/Crypto/Hash/Internal/SHA512.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.SHA512 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing SHA512 bindings +-- +module Crypto.Hash.Internal.SHA512 + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxNew + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 64 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_init" + c_sha512_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_sha512.h cryptonite_sha512_update" + c_sha512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_finalize" + c_sha512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_sha512_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_sha512_finalize ptr) diff --git a/Crypto/Hash/Internal/SHA512t.hs b/Crypto/Hash/Internal/SHA512t.hs new file mode 100644 index 0000000..bc91dca --- /dev/null +++ b/Crypto/Hash/Internal/SHA512t.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | +-- Module : Crypto.Hash.SHA512 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- module containing the internal functions to work with the +-- SHA512t cryptographic hash (FIPS-180-4 truncated SHA512). +-- +-- it is recommended to import this module qualified. +-- +module Crypto.Hash.Internal.SHA512t + ( + -- * Internal IO hash functions + internalInit + , internalInitAt + ) where + +import Foreign.Ptr +import Data.Word +import Crypto.Hash.Internal.SHA512 (withCtxNew, Ctx) + +foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_init_t" + c_sha512_init_t :: Ptr Ctx -> Word32 -> IO () + +-- | init a context using FIPS 180-4 for truncated SHA512 +internalInitAt :: Int -> Ptr Ctx -> IO () +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) diff --git a/Crypto/Hash/Internal/Skein256.hs b/Crypto/Hash/Internal/Skein256.hs new file mode 100644 index 0000000..4eff565 --- /dev/null +++ b/Crypto/Hash/Internal/Skein256.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.Skein256 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing Skein256 bindings +-- +module Crypto.Hash.Internal.Skein256 + ( Ctx(..) + -- * Internal values + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) where + +import Prelude hiding (init) +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.Word + +newtype Ctx = Ctx ByteString + +{- return the number of bytes of output for the digest -} +peekHashlen :: Ptr Ctx -> IO Int +peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v + where iptr :: Ptr Word32 + iptr = castPtr ptr + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_skein256.h cryptonite_skein256_init" + c_skein256_init :: Ptr Ctx -> Word32 -> IO () + +foreign import ccall "cryptonite_skein256.h cryptonite_skein256_update" + c_skein256_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_skein256.h cryptonite_skein256_finalize" + c_skein256_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Int -> Ptr Ctx -> IO () +internalInitAt hashlen ptr = c_skein256_init ptr (fromIntegral hashlen) + +-- | init a context +internalInit :: Int -> IO Ctx +internalInit hashlen = withCtxNew (internalInitAt hashlen) + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_skein256_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = + peekHashlen ptr >>= \digestSize -> create digestSize (c_skein256_finalize ptr) diff --git a/Crypto/Hash/Internal/Skein512.hs b/Crypto/Hash/Internal/Skein512.hs new file mode 100644 index 0000000..e3ecdda --- /dev/null +++ b/Crypto/Hash/Internal/Skein512.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.Skein512 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing Skein512 bindings +-- +module Crypto.Hash.Internal.Skein512 + ( Ctx(..) + -- * Internal values + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) where + +import Prelude hiding (init) +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.Word + +newtype Ctx = Ctx ByteString + +{- return the number of bytes of output for the digest -} +peekHashlen :: Ptr Ctx -> IO Int +peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v + where iptr :: Ptr Word32 + iptr = castPtr ptr + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_skein512.h cryptonite_skein512_init" + c_skein512_init :: Ptr Ctx -> Word32 -> IO () + +foreign import ccall "cryptonite_skein512.h cryptonite_skein512_update" + c_skein512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_skein512.h cryptonite_skein512_finalize" + c_skein512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Int -> Ptr Ctx -> IO () +internalInitAt hashlen ptr = c_skein512_init ptr (fromIntegral hashlen) + +-- | init a context +internalInit :: Int -> IO Ctx +internalInit hashlen = withCtxNew (internalInitAt hashlen) + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_skein512_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = + peekHashlen ptr >>= \digestSize -> create digestSize (c_skein512_finalize ptr) diff --git a/Crypto/Hash/Internal/Tiger.hs b/Crypto/Hash/Internal/Tiger.hs new file mode 100644 index 0000000..4fa5f55 --- /dev/null +++ b/Crypto/Hash/Internal/Tiger.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.Tiger +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing Tiger bindings +-- +module Crypto.Hash.Internal.Tiger + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 24 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_tiger.h cryptonite_tiger_init" + c_tiger_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_tiger.h cryptonite_tiger_update" + c_tiger_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_tiger.h cryptonite_tiger_finalize" + c_tiger_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_tiger_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_tiger_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_tiger_finalize ptr) diff --git a/Crypto/Hash/Internal/Whirlpool.hs b/Crypto/Hash/Internal/Whirlpool.hs new file mode 100644 index 0000000..e4ee4bf --- /dev/null +++ b/Crypto/Hash/Internal/Whirlpool.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-} + +-- | +-- Module : Crypto.Hash.Internal.Whirlpool +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- A module containing Whirlpool bindings +-- +module Crypto.Hash.Internal.Whirlpool + ( Ctx(..) + -- * Internal values + , digestSize + , sizeCtx + -- * Internal IO hash functions + , internalInit + , internalInitAt + , internalUpdate + , internalFinalize + -- * Context copy and creation + , withCtxCopy + , withCtxNewThrow + , withCtxThrow + ) 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.Word + +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 64 + +{-# INLINE sizeCtx #-} +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) + +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) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "cryptonite_whirlpool.h cryptonite_whirlpool_init" + c_whirlpool_init :: Ptr Ctx -> IO () + +foreign import ccall "cryptonite_whirlpool.h cryptonite_whirlpool_update" + c_whirlpool_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "cryptonite_whirlpool.h cryptonite_whirlpool_finalize" + c_whirlpool_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +internalInitAt :: Ptr Ctx -> IO () +internalInitAt = c_whirlpool_init + +-- | init a context +internalInit :: IO Ctx +internalInit = withCtxNew internalInitAt + +-- | Update a context in place +internalUpdate :: Ptr Ctx -> ByteString -> IO () +internalUpdate ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_whirlpool_update ptr (castPtr cs) (fromIntegral len)) + +-- | Finalize a context in place +internalFinalize :: Ptr Ctx -> IO ByteString +internalFinalize ptr = create digestSize (c_whirlpool_finalize ptr) diff --git a/Crypto/Hash/Kekkak.hs b/Crypto/Hash/Kekkak.hs index 0ea665b..f3ef85a 100644 --- a/Crypto/Hash/Kekkak.hs +++ b/Crypto/Hash/Kekkak.hs @@ -27,107 +27,35 @@ module Crypto.Hash.Kekkak ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | Kekkak Context. -newtype Ctx = Ctx ByteString - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 360 - -{- return the number of bytes of output for the digest -} -peekHashlen :: Ptr Ctx -> IO Int -peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v - where iptr :: Ptr Word32 - iptr = castPtr ptr - -{-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-} -{-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-} -{-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-} -{-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-} - -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_kekkak.h cryptonite_kekkak_init" - c_kekkak_init :: Ptr Ctx -> Word32 -> IO () - -foreign import ccall "cryptonite_kekkak.h cryptonite_kekkak_update" - c_kekkak_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_kekkak.h cryptonite_kekkak_finalize" - c_kekkak_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_kekkak_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = - peekHashlen ptr >>= \digestSize -> create digestSize (c_kekkak_finalize ptr) +import Crypto.Hash.Internal.Kekkak {-# NOINLINE init #-} -- | init a context where init :: Int -- ^ algorithm hash size in bits -> Ctx -init hashlen = unsafeDoIO $ withCtxNew $ \ptr -> c_kekkak_init ptr (fromIntegral hashlen) +init hashlen = unsafeDoIO (internalInit hashlen) {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring @@ -135,7 +63,7 @@ hash :: Int -- ^ algorithm hash size in bits -> ByteString -- ^ the data to hash -> ByteString -- ^ the digest output hash hashlen d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_kekkak_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring @@ -143,4 +71,4 @@ hashlazy :: Int -- ^ algorithm hash size in bits -> L.ByteString -- ^ the data to hash as a lazy bytestring -> ByteString -- ^ the digest output hashlazy hashlen l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_kekkak_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/MD2.hs b/Crypto/Hash/MD2.hs index 842fbb3..931950e 100644 --- a/Crypto/Hash/MD2.hs +++ b/Crypto/Hash/MD2.hs @@ -27,112 +27,48 @@ module Crypto.Hash.MD2 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | MD2 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 16 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 96 +import Crypto.Hash.Internal.MD2 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_md2.h cryptonite_md2_init" - c_md2_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_md2.h cryptonite_md2_update" - c_md2_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_md2.h cryptonite_md2_finalize" - c_md2_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_md2_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_md2_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_md2_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_md2_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_md2_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/MD4.hs b/Crypto/Hash/MD4.hs index cf00fe2..3253f84 100644 --- a/Crypto/Hash/MD4.hs +++ b/Crypto/Hash/MD4.hs @@ -27,112 +27,48 @@ module Crypto.Hash.MD4 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | MD4 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 16 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 96 +import Crypto.Hash.Internal.MD4 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_md4.h cryptonite_md4_init" - c_md4_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_md4.h cryptonite_md4_update" - c_md4_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_md4.h cryptonite_md4_finalize" - c_md4_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_md4_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_md4_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_md4_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_md4_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_md4_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/MD5.hs b/Crypto/Hash/MD5.hs index 3197017..a20aa8e 100644 --- a/Crypto/Hash/MD5.hs +++ b/Crypto/Hash/MD5.hs @@ -27,112 +27,48 @@ module Crypto.Hash.MD5 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | MD5 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 16 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 96 +import Crypto.Hash.Internal.MD5 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_md5.h cryptonite_md5_init" - c_md5_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_md5.h cryptonite_md5_update" - c_md5_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_md5.h cryptonite_md5_finalize" - c_md5_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_md5_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_md5_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_md5_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_md5_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/RIPEMD160.hs b/Crypto/Hash/RIPEMD160.hs index 19e972b..75dc7c4 100644 --- a/Crypto/Hash/RIPEMD160.hs +++ b/Crypto/Hash/RIPEMD160.hs @@ -27,112 +27,48 @@ module Crypto.Hash.RIPEMD160 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | RIPEMD160 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 20 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 128 +import Crypto.Hash.Internal.RIPEMD160 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_ripemd.h cryptonite_ripemd160_init" - c_ripemd160_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_ripemd.h cryptonite_ripemd160_update" - c_ripemd160_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_ripemd.h cryptonite_ripemd160_finalize" - c_ripemd160_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_ripemd160_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_ripemd160_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_ripemd160_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_ripemd160_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_ripemd160_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/SHA1.hs b/Crypto/Hash/SHA1.hs index b6fd1c6..feda1e6 100644 --- a/Crypto/Hash/SHA1.hs +++ b/Crypto/Hash/SHA1.hs @@ -27,112 +27,48 @@ module Crypto.Hash.SHA1 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | SHA1 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 20 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 96 +import Crypto.Hash.Internal.SHA1 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_sha1.h cryptonite_sha1_init" - c_sha1_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_sha1.h cryptonite_sha1_update" - c_sha1_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_sha1.h cryptonite_sha1_finalize" - c_sha1_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_sha1_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_sha1_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_sha1_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha1_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/SHA224.hs b/Crypto/Hash/SHA224.hs index caf9d1d..9558691 100644 --- a/Crypto/Hash/SHA224.hs +++ b/Crypto/Hash/SHA224.hs @@ -27,112 +27,48 @@ module Crypto.Hash.SHA224 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | SHA224 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 28 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 192 +import Crypto.Hash.Internal.SHA224 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha224_init" - c_sha224_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_sha256.h cryptonite_sha224_update" - c_sha224_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha224_finalize" - c_sha224_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_sha224_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_sha224_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_sha224_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha224_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha224_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/SHA256.hs b/Crypto/Hash/SHA256.hs index 403ae2c..8121c93 100644 --- a/Crypto/Hash/SHA256.hs +++ b/Crypto/Hash/SHA256.hs @@ -27,112 +27,48 @@ module Crypto.Hash.SHA256 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | SHA256 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 32 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 192 +import Crypto.Hash.Internal.SHA256 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha256_init" - c_sha256_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_sha256.h cryptonite_sha256_update" - c_sha256_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_sha256.h cryptonite_sha256_finalize" - c_sha256_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_sha256_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_sha256_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_sha256_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha256_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/SHA3.hs b/Crypto/Hash/SHA3.hs index 6a4b9cd..9d64ecb 100644 --- a/Crypto/Hash/SHA3.hs +++ b/Crypto/Hash/SHA3.hs @@ -27,107 +27,35 @@ module Crypto.Hash.SHA3 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | SHA3 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 360 - -{- return the number of bytes of output for the digest -} -peekHashlen :: Ptr Ctx -> IO Int -peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v - where iptr :: Ptr Word32 - iptr = castPtr ptr - -{-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-} -{-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-} -{-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-} -{-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-} - -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_sha3.h cryptonite_sha3_init" - c_sha3_init :: Ptr Ctx -> Word32 -> IO () - -foreign import ccall "cryptonite_sha3.h cryptonite_sha3_update" - c_sha3_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_sha3.h cryptonite_sha3_finalize" - c_sha3_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_sha3_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = - peekHashlen ptr >>= \digestSize -> create digestSize (c_sha3_finalize ptr) +import Crypto.Hash.Internal.SHA3 {-# NOINLINE init #-} -- | init a context where init :: Int -- ^ algorithm hash size in bits -> Ctx -init hashlen = unsafeDoIO $ withCtxNew $ \ptr -> c_sha3_init ptr (fromIntegral hashlen) +init hashlen = unsafeDoIO (internalInit hashlen) {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring @@ -135,7 +63,7 @@ hash :: Int -- ^ algorithm hash size in bits -> ByteString -- ^ the data to hash -> ByteString -- ^ the digest output hash hashlen d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha3_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring @@ -143,4 +71,4 @@ hashlazy :: Int -- ^ algorithm hash size in bits -> L.ByteString -- ^ the data to hash as a lazy bytestring -> ByteString -- ^ the digest output hashlazy hashlen l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha3_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/SHA384.hs b/Crypto/Hash/SHA384.hs index 6f3aa73..a3f8d12 100644 --- a/Crypto/Hash/SHA384.hs +++ b/Crypto/Hash/SHA384.hs @@ -27,112 +27,48 @@ module Crypto.Hash.SHA384 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | SHA384 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 48 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 256 +import Crypto.Hash.Internal.SHA384 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha384_init" - c_sha384_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_sha512.h cryptonite_sha384_update" - c_sha384_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha384_finalize" - c_sha384_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_sha384_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_sha384_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_sha384_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha384_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/SHA512.hs b/Crypto/Hash/SHA512.hs index 8d68b90..8e92fa5 100644 --- a/Crypto/Hash/SHA512.hs +++ b/Crypto/Hash/SHA512.hs @@ -17,7 +17,6 @@ module Crypto.Hash.SHA512 -- * Incremental hashing Functions , init -- :: Ctx - , init_t -- :: Int -> Ctx , update -- :: Ctx -> ByteString -> Ctx , updates -- :: Ctx -> [ByteString] -> Ctx , finalize -- :: Ctx -> ByteString @@ -28,120 +27,48 @@ module Crypto.Hash.SHA512 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | SHA512 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 64 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 256 +import Crypto.Hash.Internal.SHA512 {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_init" - c_sha512_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_sha512.h cryptonite_sha512_update" - c_sha512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_finalize" - c_sha512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -foreign import ccall unsafe "cryptonite_sha512.h cryptonite_sha512_init_t" - c_sha512_init_t :: Ptr Ctx -> Int -> IO () - -{-# NOINLINE init_t #-} --- | init a context using FIPS 180-4 for truncated SHA512 -init_t :: Int -> Ctx -init_t t = unsafeDoIO $ withCtxNew $ \ptr -> c_sha512_init_t ptr t - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_sha512_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_sha512_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha512_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_sha512_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/SHA512t.hs b/Crypto/Hash/SHA512t.hs index 401532c..8337556 100644 --- a/Crypto/Hash/SHA512t.hs +++ b/Crypto/Hash/SHA512t.hs @@ -27,13 +27,17 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Crypto.Hash.SHA512 as SHA512 +import Crypto.Internal.Compat +--import qualified Crypto.Hash.Internal.SHA512 as SHA512 +import qualified Crypto.Hash.Internal.SHA512t as SHA512t +import Crypto.Hash.Internal.SHA512 (withCtxNew) -- | SHA512 Context with variable size output data Ctx = Ctx !Int !SHA512.Ctx -- | init a context init :: Int -> Ctx -init t = Ctx t (SHA512.init_t t) +init t = Ctx t $ unsafeDoIO $ withCtxNew $ \ptr -> SHA512t.internalInitAt t ptr -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx diff --git a/Crypto/Hash/Skein256.hs b/Crypto/Hash/Skein256.hs index 601e6ba..de1d466 100644 --- a/Crypto/Hash/Skein256.hs +++ b/Crypto/Hash/Skein256.hs @@ -27,107 +27,35 @@ module Crypto.Hash.Skein256 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | Skein256 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 96 - -{- return the number of bytes of output for the digest -} -peekHashlen :: Ptr Ctx -> IO Int -peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v - where iptr :: Ptr Word32 - iptr = castPtr ptr - -{-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-} -{-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-} -{-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-} -{-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-} - -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_skein256.h cryptonite_skein256_init" - c_skein256_init :: Ptr Ctx -> Word32 -> IO () - -foreign import ccall "cryptonite_skein256.h cryptonite_skein256_update" - c_skein256_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_skein256.h cryptonite_skein256_finalize" - c_skein256_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_skein256_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = - peekHashlen ptr >>= \digestSize -> create digestSize (c_skein256_finalize ptr) +import Crypto.Hash.Internal.Skein256 {-# NOINLINE init #-} -- | init a context where init :: Int -- ^ algorithm hash size in bits -> Ctx -init hashlen = unsafeDoIO $ withCtxNew $ \ptr -> c_skein256_init ptr (fromIntegral hashlen) +init hashlen = unsafeDoIO (internalInit hashlen) {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring @@ -135,7 +63,7 @@ hash :: Int -- ^ algorithm hash size in bits -> ByteString -- ^ the data to hash -> ByteString -- ^ the digest output hash hashlen d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_skein256_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring @@ -143,4 +71,4 @@ hashlazy :: Int -- ^ algorithm hash size in bits -> L.ByteString -- ^ the data to hash as a lazy bytestring -> ByteString -- ^ the digest output hashlazy hashlen l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_skein256_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/Skein512.hs b/Crypto/Hash/Skein512.hs index d17bf49..083b59b 100644 --- a/Crypto/Hash/Skein512.hs +++ b/Crypto/Hash/Skein512.hs @@ -27,107 +27,35 @@ module Crypto.Hash.Skein512 ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | Skein512 Context. -newtype Ctx = Ctx ByteString - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 160 - -{- return the number of bytes of output for the digest -} -peekHashlen :: Ptr Ctx -> IO Int -peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v - where iptr :: Ptr Word32 - iptr = castPtr ptr - -{-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-} -{-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-} -{-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-} -{-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-} - -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_skein512.h cryptonite_skein512_init" - c_skein512_init :: Ptr Ctx -> Word32 -> IO () - -foreign import ccall "cryptonite_skein512.h cryptonite_skein512_update" - c_skein512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_skein512.h cryptonite_skein512_finalize" - c_skein512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_skein512_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = - peekHashlen ptr >>= \digestSize -> create digestSize (c_skein512_finalize ptr) +import Crypto.Hash.Internal.Skein512 {-# NOINLINE init #-} -- | init a context where init :: Int -- ^ algorithm hash size in bits -> Ctx -init hashlen = unsafeDoIO $ withCtxNew $ \ptr -> c_skein512_init ptr (fromIntegral hashlen) +init hashlen = unsafeDoIO (internalInit hashlen) {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring @@ -135,7 +63,7 @@ hash :: Int -- ^ algorithm hash size in bits -> ByteString -- ^ the data to hash -> ByteString -- ^ the digest output hash hashlen d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_skein512_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring @@ -143,4 +71,4 @@ hashlazy :: Int -- ^ algorithm hash size in bits -> L.ByteString -- ^ the data to hash as a lazy bytestring -> ByteString -- ^ the digest output hashlazy hashlen l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_skein512_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt hashlen ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/Tiger.hs b/Crypto/Hash/Tiger.hs index e052743..3f77d6f 100644 --- a/Crypto/Hash/Tiger.hs +++ b/Crypto/Hash/Tiger.hs @@ -27,112 +27,48 @@ module Crypto.Hash.Tiger ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | Tiger Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 24 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 96 +import Crypto.Hash.Internal.Tiger {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_tiger.h cryptonite_tiger_init" - c_tiger_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_tiger.h cryptonite_tiger_update" - c_tiger_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_tiger.h cryptonite_tiger_finalize" - c_tiger_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_tiger_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_tiger_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_tiger_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_tiger_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_tiger_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/Crypto/Hash/Whirlpool.hs b/Crypto/Hash/Whirlpool.hs index e5fcca4..ab08c9e 100644 --- a/Crypto/Hash/Whirlpool.hs +++ b/Crypto/Hash/Whirlpool.hs @@ -27,112 +27,48 @@ module Crypto.Hash.Whirlpool ) where import Prelude hiding (init) -import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.ByteString.Internal (create, toForeignPtr) -import Data.Word import Crypto.Hash.Internal (unsafeDoIO) - --- | Whirlpool Context. -newtype Ctx = Ctx ByteString - -{-# INLINE digestSize #-} -digestSize :: Int -digestSize = 64 - -{-# INLINE sizeCtx #-} -sizeCtx :: Int -sizeCtx = 168 +import Crypto.Hash.Internal.Whirlpool {-# RULES "hash" forall b. finalize (update init b) = hash b #-} {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} -{-# 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) - -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) - -withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a -withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) - -foreign import ccall unsafe "cryptonite_whirlpool.h cryptonite_whirlpool_init" - c_whirlpool_init :: Ptr Ctx -> IO () - -foreign import ccall "cryptonite_whirlpool.h cryptonite_whirlpool_update" - c_whirlpool_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () - -foreign import ccall unsafe "cryptonite_whirlpool.h cryptonite_whirlpool_finalize" - c_whirlpool_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - -updateInternalIO :: Ptr Ctx -> ByteString -> IO () -updateInternalIO ptr d = - unsafeUseAsCStringLen d (\(cs, len) -> c_whirlpool_update ptr (castPtr cs) (fromIntegral len)) - -finalizeInternalIO :: Ptr Ctx -> IO ByteString -finalizeInternalIO ptr = create digestSize (c_whirlpool_finalize ptr) - {-# NOINLINE init #-} -- | init a context init :: Ctx -init = unsafeDoIO $ withCtxNew $ c_whirlpool_init +init = unsafeDoIO internalInit {-# NOINLINE update #-} -- | update a context with a bytestring returning the new updated context update :: Ctx -- ^ the context to update -> ByteString -- ^ the data to update with -> Ctx -- ^ the updated context -update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> internalUpdate ptr d {-# NOINLINE updates #-} -- | updates a context with multiples bytestring returning the new updated context updates :: Ctx -- ^ the context to update -> [ByteString] -- ^ a list of data bytestring to update with -> Ctx -- ^ the updated context -updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (internalUpdate ptr) d {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString -finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO +finalize ctx = unsafeDoIO $ withCtxThrow ctx internalFinalize {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_whirlpool_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + internalInitAt ptr >> internalUpdate ptr d >> internalFinalize ptr {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do - c_whirlpool_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + internalInitAt ptr >> mapM_ (internalUpdate ptr) (L.toChunks l) >> internalFinalize ptr diff --git a/cryptonite.cabal b/cryptonite.cabal index fe86601..c6ff823 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -57,6 +57,22 @@ Library Other-modules: Crypto.Hash.Internal , Crypto.Hash.Utils , Crypto.Hash.Types + Crypto.Hash.Internal.SHA1 + Crypto.Hash.Internal.SHA224 + Crypto.Hash.Internal.SHA256 + Crypto.Hash.Internal.SHA384 + Crypto.Hash.Internal.SHA512 + Crypto.Hash.Internal.SHA512t + Crypto.Hash.Internal.SHA3 + Crypto.Hash.Internal.Kekkak + Crypto.Hash.Internal.MD2 + Crypto.Hash.Internal.MD4 + Crypto.Hash.Internal.MD5 + Crypto.Hash.Internal.RIPEMD160 + Crypto.Hash.Internal.Skein256 + Crypto.Hash.Internal.Skein512 + Crypto.Hash.Internal.Tiger + Crypto.Hash.Internal.Whirlpool , Crypto.Random.Entropy.Source , Crypto.Random.Entropy.Backend , Crypto.Internal.Compat