module Data.CryptoHash.SHA384 (
Ctx(..),
init,
update,
finalize,
hash,
hashlazy
) where
import Prelude hiding (init)
import Foreign
import Foreign.C.String
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)
import Data.ByteString.Internal (create, memcpy)
data Ctx = Ctx !ByteString
digestSize :: Int
sizeCtx :: Int
digestSize = 48
sizeCtx = 256
instance Storable Ctx where
sizeOf _ = sizeCtx
alignment _ = 16
poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))
peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx
foreign import ccall unsafe "sha512.h sha384_init"
c_sha384_init :: Ptr Ctx -> IO ()
foreign import ccall "sha512.h sha384_update"
c_sha384_update :: Ptr Ctx -> CString -> Word32 -> IO ()
foreign import ccall unsafe "sha512.h sha384_finalize"
c_sha384_finalize :: Ptr Ctx -> CString -> IO ()
allocInternal :: (Ptr Ctx -> IO a) -> IO a
allocInternal = alloca
allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a
allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)
updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
updateInternalIO ptr d =
unsafeUseAsCStringLen d (\(cs, len) -> c_sha384_update ptr cs (fromIntegral len))
finalizeInternalIO :: Ptr Ctx -> IO ByteString
finalizeInternalIO ptr =
allocaBytes digestSize (\cs -> c_sha384_finalize ptr cs >> B.packCStringLen (cs, digestSize))
init :: Ctx
init = unsafePerformIO $ allocInternal $ \ptr -> do (c_sha384_init ptr >> peek ptr)
update :: Ctx -> ByteString -> Ctx
update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr
finalize :: Ctx -> ByteString
finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr
hash :: ByteString -> ByteString
hash d = unsafePerformIO $ allocInternal $ \ptr -> do
c_sha384_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr
hashlazy :: L.ByteString -> ByteString
hashlazy l = unsafePerformIO $ allocInternal $ \ptr -> do
c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr