105 lines
3.3 KiB
Haskell
105 lines
3.3 KiB
Haskell
{-# 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)
|