{-# LINE 1 "OpenSSL/EVP/Digest.hsc" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
-- |An interface to message digest algorithms.
module OpenSSL.EVP.Digest
    ( Digest
    , getDigestByName
    , getDigestNames

    , digest
    , digestBS
    , digestLBS

    , hmacBS
    , hmacLBS
    , pkcs5_pbkdf2_hmac_sha1
    )
    where

import Data.ByteString.Internal (create)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as L8

{-# LINE 27 "OpenSSL/EVP/Digest.hsc" #-}
import Foreign.C.String (CString, withCString)

{-# LINE 29 "OpenSSL/EVP/Digest.hsc" #-}
import Foreign.C.Types (CChar(..), CInt(..), CSize(..), CUInt(..))

{-# LINE 33 "OpenSSL/EVP/Digest.hsc" #-}
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (peek)
import OpenSSL.EVP.Internal
import OpenSSL.Objects
import System.IO.Unsafe (unsafePerformIO)

foreign import capi unsafe "openssl/evp.h EVP_get_digestbyname"
        _get_digestbyname :: CString -> IO (Ptr EVP_MD)

-- |@'getDigestByName' name@ returns a message digest algorithm whose
-- name is @name@. If no algorithms are found, the result is
-- @Nothing@.
getDigestByName :: String -> IO (Maybe Digest)
getDigestByName :: String -> IO (Maybe Digest)
getDigestByName String
name
    = String -> (CString -> IO (Maybe Digest)) -> IO (Maybe Digest)
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO (Maybe Digest)) -> IO (Maybe Digest))
-> (CString -> IO (Maybe Digest)) -> IO (Maybe Digest)
forall a b. (a -> b) -> a -> b
$ \ CString
namePtr ->
      do Ptr EVP_MD
ptr <- CString -> IO (Ptr EVP_MD)
_get_digestbyname CString
namePtr
         if Ptr EVP_MD
ptr Ptr EVP_MD -> Ptr EVP_MD -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr EVP_MD
forall a. Ptr a
nullPtr then
             Maybe Digest -> IO (Maybe Digest)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Digest
forall a. Maybe a
Nothing
           else
             Maybe Digest -> IO (Maybe Digest)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Digest -> IO (Maybe Digest))
-> Maybe Digest -> IO (Maybe Digest)
forall a b. (a -> b) -> a -> b
$ Digest -> Maybe Digest
forall a. a -> Maybe a
Just (Digest -> Maybe Digest) -> Digest -> Maybe Digest
forall a b. (a -> b) -> a -> b
$ Ptr EVP_MD -> Digest
Digest Ptr EVP_MD
ptr

-- |@'getDigestNames'@ returns a list of name of message digest
-- algorithms.
getDigestNames :: IO [String]
getDigestNames :: IO [String]
getDigestNames = ObjNameType -> Bool -> IO [String]
getObjNames ObjNameType
MDMethodType Bool
True

{- digest -------------------------------------------------------------------- -}

-- |@'digest'@ digests a stream of data. The string must
-- not contain any letters which aren't in the range of U+0000 -
-- U+00FF.
digest :: Digest -> String -> String
{-# DEPRECATED digest "Use digestBS or digestLBS instead." #-}
digest :: Digest -> String -> String
digest Digest
md String
input
    = ByteString -> String
B8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Digest -> ByteString -> ByteString
digestLBS Digest
md (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
L8.pack String
input

-- |@'digestBS'@ digests a chunk of data.
digestBS :: Digest -> B8.ByteString -> B8.ByteString
digestBS :: Digest -> ByteString -> ByteString
digestBS Digest
md ByteString
input
    = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest -> ByteString -> IO DigestCtx
digestStrictly Digest
md ByteString
input IO DigestCtx -> (DigestCtx -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DigestCtx -> IO ByteString
digestFinalBS

-- |@'digestLBS'@ digests a stream of data.
digestLBS :: Digest -> L8.ByteString -> B8.ByteString
digestLBS :: Digest -> ByteString -> ByteString
digestLBS Digest
md ByteString
input
    = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest -> ByteString -> IO DigestCtx
digestLazily Digest
md ByteString
input IO DigestCtx -> (DigestCtx -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DigestCtx -> IO ByteString
digestFinalBS

{- HMAC ---------------------------------------------------------------------- -}

foreign import capi unsafe "openssl/hmac.h HMAC"
        _HMAC :: Ptr EVP_MD -> Ptr CChar -> CInt -> Ptr CChar -> CSize
              -> Ptr CChar -> Ptr CUInt -> IO ()

-- | Perform a private key signing using the HMAC template with a given hash
hmacBS :: Digest  -- ^ the hash function to use in the HMAC calculation
       -> B8.ByteString  -- ^ the HMAC key
       -> B8.ByteString  -- ^ the data to be signed
       -> B8.ByteString  -- ^ resulting HMAC
hmacBS :: Digest -> ByteString -> ByteString -> ByteString
hmacBS (Digest Ptr EVP_MD
md) ByteString
key ByteString
input =
  IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int
64) ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
bufPtr ->
{-# LINE 95 "OpenSSL/EVP/Digest.hsc" #-}
  alloca $ \bufLenPtr ->
  unsafeUseAsCStringLen key $ \(keydata, keylen) ->
  unsafeUseAsCStringLen input $ \(inputdata, inputlen) -> do
     _HMAC md
       keydata (fromIntegral keylen) inputdata (fromIntegral inputlen)
       bufPtr bufLenPtr
     bufLen <- fromIntegral <$> peek bufLenPtr
     B8.packCStringLen (bufPtr, bufLen)

hmacLBS :: Digest -> B8.ByteString -> L8.ByteString -> B8.ByteString
hmacLBS :: Digest -> ByteString -> ByteString -> ByteString
hmacLBS Digest
md ByteString
key ByteString
input
    = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest -> ByteString -> ByteString -> IO HmacCtx
hmacLazily Digest
md ByteString
key ByteString
input IO HmacCtx -> (HmacCtx -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HmacCtx -> IO ByteString
hmacFinalBS

-- | Calculate a PKCS5-PBKDF2 SHA1-HMAC suitable for password hashing.
pkcs5_pbkdf2_hmac_sha1 :: B8.ByteString -- ^ password
                       -> B8.ByteString -- ^ salt
                       -> Int           -- ^ iterations
                       -> Int           -- ^ destination key length
                       -> B8.ByteString -- ^ destination key
pkcs5_pbkdf2_hmac_sha1 :: ByteString -> ByteString -> Int -> Int -> ByteString
pkcs5_pbkdf2_hmac_sha1 ByteString
pass ByteString
salt Int
iter Int
dkeylen =
  IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
pass ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
passdata, Int
passlen) ->
  ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
salt ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
saltdata, Int
saltlen) ->
  Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
dkeylen ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dkeydata ->
      CString
-> CInt -> CString -> CInt -> CInt -> CInt -> CString -> IO CInt
_PKCS5_PBKDF2_HMAC_SHA1
           CString
passdata (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passlen)
           CString
saltdata (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
saltlen)
           (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iter) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dkeylen) (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dkeydata)
      IO CInt -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

foreign import capi unsafe "openssl/hmac.h PKCS5_PBKDF2_HMAC_SHA1"
  _PKCS5_PBKDF2_HMAC_SHA1 :: Ptr CChar -> CInt
                          -> Ptr CChar -> CInt
                          -> CInt -> CInt -> Ptr CChar
                          -> IO CInt