Md5.hs

{-# language BangPatterns #-}
{-# language DataKinds #-}
{-# language MagicHash #-}
{-# language UnliftedFFITypes #-}

module Hash.Md5
  ( Context(..)
    -- * Context Reuse
  , context
  , reinitialize
  , update
  , finalize
    -- * One Shot
  , boundedBuilder
  ) where

import Control.Monad.ST (ST)
import Data.Bytes.Builder.Bounded as BB
import Data.Bytes.Builder.Bounded.Unsafe as BBU
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (ByteArray(..),MutableByteArray(..))
import Data.Primitive (newByteArray)
import GHC.Exts (Int(I#),Int#,MutableByteArray#,ByteArray#,unsafeCoerce#)
import GHC.Exts (RealWorld)
import GHC.IO (unsafeIOToST)

import Hash.Md5.Internal

newtype Context s = Context (MutableByteArray s)

-- | Create a new context. The context is initialized.
context :: ST s (Context s)
context = do
  b <- newByteArray 88
  reinitialize (Context b)
  pure (Context b)

-- | Reset the context so that it may be used to hash another byte sequence.
reinitialize :: Context s -> ST s ()
reinitialize (Context (MutableByteArray ctx)) =
  unsafeIOToST (c_md5_init (unsafeCoerce# ctx))

finalize ::
     Context s
  -> MutableByteArray s -- ^ Destination, implied length is 16
  -> Int -- ^ Destination offset
  -> ST s ()
finalize (Context (MutableByteArray ctx)) (MutableByteArray x) !a =
  unsafeIOToST (c_md5_finalize (unsafeCoerce# ctx) (unsafeCoerce# x) a)

update ::
     Context s
  -> Bytes
  -> ST s ()
update (Context (MutableByteArray ctx)) (Bytes (ByteArray arr) off len) =
  unsafeIOToST (c_md5_update_unsafe (unsafeCoerce# ctx) arr off len)

performHash :: MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
performHash (MutableByteArray x) !a (ByteArray y) !b !c =
  unsafeIOToST $ do
    MutableByteArray ctx <- newByteArray 88
    c_md5_init ctx
    c_md5_update_unsafe ctx y b c
    c_md5_finalize ctx (unsafeCoerce# x) a

boundedBuilder :: Bytes -> BB.Builder 16
boundedBuilder (Bytes arr off len) = BBU.construct
  (\buf ix -> do
    performHash buf ix arr off len
    pure (ix + 16)
  )