{-# LINE 1 "src/OpenSSL/EVP/Digest/Algorithm.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

{- |
   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.Algorithm where

import OpenSSL.EVP.Digest.Initialization
import OpenSSL.EVP.Digest.Error ( UnknownAlgorithm(..) )

import Control.Exception
import Data.Maybe
import Data.String ( IsString(..) )
import Foreign
import Foreign.C
import System.IO.Unsafe as IO




-- | An opaque handle into OpenSSL's collection of message digest algorithms.
-- Use 'digestByName' to look up any of the available algorithms by name. For
-- the sake of convenience, 'Algorithm' is an instance of 'IsString' so
-- that the compiler can transparently map 'String' literals to algorithms via
-- 'fromString' if the @XOverloadedStrings@ extension is enabled.
--
-- >>> fromString "sha256" == digestByName "sha256"
-- True

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

instance IsString Algorithm where
  fromString :: String -> Algorithm
fromString = String -> Algorithm
digestByName

-- | Look up a digest algorithm engine by name. Algorithms usually offered by
-- OpenSSL are "md2", "md5", "sha1", "mdc2", "ripemd160", "blake2b512",
-- "blake2s256", "sha224", "sha256", "sha384", and "sha512", but the exact set
-- may vary between platforms. Throws 'UnknownAlgorithm' if the requested
-- algorithm is not known.

digestByName :: String -> Algorithm
digestByName :: String -> Algorithm
digestByName String
algo =
  forall a. a -> Maybe a -> a
fromMaybe (forall a e. Exception e => e -> a
throw (String -> UnknownAlgorithm
UnknownAlgorithm String
algo)) (String -> Maybe Algorithm
digestByName' String
algo)

-- | Variant of 'digestByName' that signals failure by evaluating to 'Nothing'
-- rather than failing.
--
-- >>> digestByName' "sha256" == Just (digestByName "sha256")
-- True
-- >>> digestByName' "Guess what?" :: Maybe Algorithm
-- Nothing

digestByName' :: String -> Maybe Algorithm
digestByName' :: String -> Maybe Algorithm
digestByName' String
algo = do
  let Algorithm Ptr ()
p = forall a. IO a -> a
IO.unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
                      IO ()
initializeEVPDigests
                      forall a. String -> (CString -> IO a) -> IO a
withCString String
algo (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Algorithm
_digestByName)
  if Ptr ()
p forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Ptr () -> Algorithm
Algorithm Ptr ()
p)

-- | Return the size of the digest in bytes that the given algorithm will produce.
--
-- >>> digestSize (digestByName "sha256")
-- 32

digestSize :: Algorithm -> Int
digestSize :: Algorithm -> Int
digestSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algorithm -> CInt
_digestSize

-- | The largest possible digest size of any of the algorithms supported by
-- this library will generate. So if you want to store a digest without
-- bothering to retrieve the appropriate size with 'digestSize' first, allocate
-- a buffer of that size.

maxDigestSize :: Int
maxDigestSize :: Int
maxDigestSize = Int
64
{-# LINE 82 "src/OpenSSL/EVP/Digest/Algorithm.hsc" #-}

-- | Return the block size the the given algorithm operates with.
--
-- >>> digestBlockSize (digestByName "sha256")
-- 64

digestBlockSize :: Algorithm -> Int
digestBlockSize :: Algorithm -> Int
digestBlockSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algorithm -> CInt
_digestBlockSize

-------------------------------------------------------------------------------

foreign import ccall unsafe "openssl/evp.h EVP_get_digestbyname"
  _digestByName :: CString -> Algorithm

foreign import ccall unsafe

{-# LINE 98 "src/OpenSSL/EVP/Digest/Algorithm.hsc" #-}
  "openssl/evp.h EVP_MD_size"

{-# LINE 102 "src/OpenSSL/EVP/Digest/Algorithm.hsc" #-}
  _digestSize :: Algorithm -> CInt

foreign import ccall unsafe

{-# LINE 106 "src/OpenSSL/EVP/Digest/Algorithm.hsc" #-}
  "openssl/evp.h EVP_MD_block_size"

{-# LINE 110 "src/OpenSSL/EVP/Digest/Algorithm.hsc" #-}
  _digestBlockSize :: Algorithm -> CInt