139 lines
4.8 KiB
Haskell
139 lines
4.8 KiB
Haskell
{-# LANGUAGE ForeignFunctionInterface #-}
|
|
|
|
-- |
|
|
-- Module : Crypto.Hash.SHA256
|
|
-- License : BSD-style
|
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
-- Stability : experimental
|
|
-- Portability : unknown
|
|
--
|
|
-- module containing the pure functions to work with the
|
|
-- SHA256 cryptographic hash.
|
|
--
|
|
-- it is recommended to import this module qualified.
|
|
--
|
|
module Crypto.Hash.SHA256
|
|
( Ctx(..)
|
|
|
|
-- * Incremental hashing Functions
|
|
, init -- :: Ctx
|
|
, update -- :: Ctx -> ByteString -> Ctx
|
|
, updates -- :: Ctx -> [ByteString] -> Ctx
|
|
, finalize -- :: Ctx -> ByteString
|
|
|
|
-- * Single Pass hashing
|
|
, hash -- :: ByteString -> ByteString
|
|
, hashlazy -- :: ByteString -> ByteString
|
|
) 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
|
|
|
|
{-# 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
|
|
|
|
{-# 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
|
|
|
|
{-# 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
|
|
|
|
{-# NOINLINE finalize #-}
|
|
-- | finalize the context into a digest bytestring
|
|
finalize :: Ctx -> ByteString
|
|
finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO
|
|
|
|
{-# 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
|
|
|
|
{-# 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
|