missing template from previous commit

This commit is contained in:
Vincent Hanquez 2015-03-08 15:18:45 +08:00
parent 95160dee56
commit d9183b7d9b

View File

@ -27,15 +27,13 @@ module Crypto.Hash.Internal.%%MODULENAME%%
) where
import Foreign.Ptr
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable
import Foreign.Marshal.Alloc
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.ByteString.Internal (create, toForeignPtr)
import Data.ByteString.Internal (create)
import Data.Word
import Crypto.Internal.Memory
newtype Ctx = Ctx ByteString
newtype Ctx = Ctx Bytes
{-# INLINE digestSize #-}
digestSize :: Int
@ -45,36 +43,14 @@ digestSize = %%DIGESTSIZE%%
sizeCtx :: Int
sizeCtx = %%SIZECTX%%
{-# INLINE withByteStringPtr #-}
withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr b f =
withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
where (fptr, off, _) = toForeignPtr b
{-# INLINE memcopy64 #-}
memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
memcopy64 dst src = mapM_ peekAndPoke [0..(%%SIZECTX8%%-1)]
where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
where createCtx = create sizeCtx $ \dstPtr ->
withByteStringPtr ctxB $ \srcPtr -> do
memcopy64 (castPtr dstPtr) (castPtr srcPtr)
f (castPtr dstPtr)
withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
withCtxThrow (Ctx ctxB) f =
allocaBytes sizeCtx $ \dstPtr ->
withByteStringPtr ctxB $ \srcPtr -> do
memcopy64 (castPtr dstPtr) (castPtr srcPtr)
f (castPtr dstPtr)
withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
withCtxThrow (Ctx b) f = bytesCopyTemporary b f
withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
withCtxNewThrow f = bytesTemporary %%SIZECTX%% f
foreign import ccall unsafe "cryptonite_%%HEADER_FILE%% cryptonite_%%HASHNAME%%_init"
c_%%HASHNAME%%_init :: Ptr Ctx -> IO ()
@ -93,7 +69,7 @@ internalInitAt = c_%%HASHNAME%%_init
-- | init a context
internalInit :: IO Ctx
internalInit = withCtxNew internalInitAt
internalInit = Ctx `fmap` bytesAlloc %%SIZECTX%% internalInitAt
-- | Update a context in place
internalUpdate :: Ptr Ctx -> ByteString -> IO ()