{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}

{- |
   Maintainer:  simons@cryp.to
   Stability:   provisional
   Portability: portable

   Low-level bindings to OpenSSL's EVP interface. Most users do not need this
   code. Check out "OpenSSL.Digest" for a more comfortable interface.
-}

module OpenSSL.EVP.Digest.Context where

import OpenSSL.EVP.Digest.Error ( throwIfZero )

import Control.Monad
import Foreign
import Foreign.C

#include "openssl/opensslv.h"

-- | A context for digest computations. Use 'newContext' and 'freeContext' to
-- allocate/deallocate this type.

newtype Context = Context (Ptr ())
  deriving (Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, Context -> Context -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq)

-- | Allocate and initialize an 'Context' for use in a digest computation
-- on the heap. Release its underlying memory after use with 'freeContext'.

newContext :: IO Context
newContext :: IO Context
newContext = do ctx :: Context
ctx@(Context Ptr ()
p) <- IO Context
_newContext
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr ()
p forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"OpenSSL.EVP.Digest.Context.newContext failed")
                forall (m :: * -> *) a. Monad m => a -> m a
return Context
ctx

foreign import ccall unsafe
#if OPENSSL_VERSION_NUMBER < 0x1010000f
  "openssl/evp.h EVP_MD_CTX_create"
#else
  "openssl/evp.h EVP_MD_CTX_new"
#endif
  _newContext :: IO Context

-- | Release all resources associated with a digest computation.

foreign import ccall unsafe
#if OPENSSL_VERSION_NUMBER < 0x1010000f
  "openssl/evp.h EVP_MD_CTX_destroy"
#else
  "openssl/evp.h EVP_MD_CTX_free"
#endif
  freeContext :: Context -> IO ()

-- | Free all resources associated with this 'Context', but don't destroy the
-- context itself so that it can be re-used for a new digest computation.

resetDigest :: Context -> IO ()
resetDigest :: Context -> IO ()
resetDigest Context
ctx =
  String -> IO CInt -> IO ()
throwIfZero String
"OpenSSL.EVP.Digest.resetDigest" (Context -> IO CInt
_resetContext Context
ctx)

foreign import ccall unsafe
#if OPENSSL_VERSION_NUMBER < 0x1010000f
  "openssl/evp.h EVP_MD_CTX_cleanup"
#else
  "openssl/evp.h EVP_MD_CTX_reset"
#endif
  _resetContext :: Context -> IO CInt