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

missing template from previous commit

Browse Source
This commit is contained in:
Vincent Hanquez 2015-03-08 15:18:45 +08:00
parent 95160dee56
commit d9183b7d9b
1 changed files with 7 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
gen/template/hash-internal.hs
View File

@ -27,15 +27,13 @@ module Crypto.Hash.Internal.%%MODULENAME%%
) where ) where
import Foreign.Ptr import Foreign.Ptr
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable
import Foreign.Marshal.Alloc
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.ByteString.Internal (create, toForeignPtr) import Data.ByteString.Internal (create)
import Data.Word import Data.Word
import Crypto.Internal.Memory
newtype Ctx = Ctx ByteString newtype Ctx = Ctx Bytes
{-# INLINE digestSize #-} {-# INLINE digestSize #-}
digestSize :: Int digestSize :: Int
@ -45,36 +43,14 @@ digestSize = %%DIGESTSIZE%%
sizeCtx :: Int sizeCtx :: Int
sizeCtx = %%SIZECTX%% 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 -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx withCtxCopy (Ctx b) f = Ctx `fmap` bytesCopyAndModify b f
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 -> (Ptr Ctx -> IO a) -> IO a
withCtxThrow (Ctx ctxB) f = withCtxThrow (Ctx b) f = bytesCopyTemporary b 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 :: (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" foreign import ccall unsafe "cryptonite_%%HEADER_FILE%% cryptonite_%%HASHNAME%%_init"
c_%%HASHNAME%%_init :: Ptr Ctx -> IO () c_%%HASHNAME%%_init :: Ptr Ctx -> IO ()
@ -93,7 +69,7 @@ internalInitAt = c_%%HASHNAME%%_init
-- | init a context -- | init a context
internalInit :: IO Ctx internalInit :: IO Ctx
internalInit = withCtxNew internalInitAt internalInit = Ctx `fmap` bytesAlloc %%SIZECTX%% internalInitAt
-- | Update a context in place -- | Update a context in place
internalUpdate :: Ptr Ctx -> ByteString -> IO () internalUpdate :: Ptr Ctx -> ByteString -> IO ()