haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update architectures of modules to separate IO and mutable parts from the immutable part

Browse Source
This commit is contained in:
Vincent Hanquez 2015-02-08 12:03:00 +00:00
parent bc75680084
commit 70e2321d95
33 changed files with 1689 additions and 1107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
Crypto/Hash/Internal/Kekkak.hs Normal file
View File

@ -0,0 +1,104 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.Kekkak
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/MD2.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.MD2
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/MD4.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.MD4
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/MD5.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.MD5
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/RIPEMD160.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.RIPEMD160
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/SHA1.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.SHA1
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/SHA224.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.SHA224
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/SHA256.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.SHA256
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

104
Crypto/Hash/Internal/SHA3.hs Normal file
View File

@ -0,0 +1,104 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.SHA3
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/SHA384.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.SHA384
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

102
Crypto/Hash/Internal/SHA512.hs Normal file
View File

@ -0,0 +1,102 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.SHA512
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

35
Crypto/Hash/Internal/SHA512t.hs Normal file
View File

@ -0,0 +1,35 @@
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module : Crypto.Hash.SHA512
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

104
Crypto/Hash/Internal/Skein256.hs Normal file
View File

@ -0,0 +1,104 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.Skein256
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

104
Crypto/Hash/Internal/Skein512.hs Normal file
View File

@ -0,0 +1,104 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.Skein512
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/Tiger.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.Tiger
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

101
Crypto/Hash/Internal/Whirlpool.hs Normal file
View File

@ -0,0 +1,101 @@
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.Internal.Whirlpool
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- 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)

86
Crypto/Hash/Kekkak.hs
View File

@ -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

78
Crypto/Hash/MD2.hs
View File

@ -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

78
Crypto/Hash/MD4.hs
View File

@ -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

78
Crypto/Hash/MD5.hs
View File

@ -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

78
Crypto/Hash/RIPEMD160.hs
View File

@ -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

78
Crypto/Hash/SHA1.hs
View File

@ -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

78
Crypto/Hash/SHA224.hs
View File

@ -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

78
Crypto/Hash/SHA256.hs
View File

@ -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

86
Crypto/Hash/SHA3.hs
View File

@ -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

78
Crypto/Hash/SHA384.hs
View File

@ -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

87
Crypto/Hash/SHA512.hs
View File

@ -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

6
Crypto/Hash/SHA512t.hs
View File

@ -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

86
Crypto/Hash/Skein256.hs
View File

@ -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

86
Crypto/Hash/Skein512.hs
View File

@ -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

78
Crypto/Hash/Tiger.hs
View File

@ -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

78
Crypto/Hash/Whirlpool.hs
View File

@ -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

16
cryptonite.cabal
View File

@ -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