hopenssl 2.1 → 2.2

raw patch · 12 files changed

+406/−307 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hopenssl.cabal +11/−5
• src/OpenSSL/Digest.hs +28/−33
• src/OpenSSL/EVP/Digest.hs +26/−0
• src/OpenSSL/EVP/Digest.hsc +0/−263
• src/OpenSSL/EVP/Digest/Algorithm.hsc +100/−0
• src/OpenSSL/EVP/Digest/Context.hs +68/−0
• src/OpenSSL/EVP/Digest/Digest.hs +67/−0
• src/OpenSSL/EVP/Digest/Error.hs +33/−0
• src/OpenSSL/EVP/Digest/Initialization.hs +41/−0
• src/OpenSSL/Util.hs +24/−0
• test/CheckLowLevelDigestAPI.hs +7/−5
• test/doctests.hs +1/−1

@@ -1,5 +1,5 @@ name:                   hopenssl-version:                2.1+version:                2.2 copyright:              (c) 2004-2017 Peter Simons license:                BSD3 license-file:           LICENSE@@ -7,11 +7,11 @@ maintainer:             Peter Simons <simons@cryp.to> homepage:               http://github.com/peti/hopenssl category:               Foreign, Cryptography-synopsis:               FFI bindings to OpenSSL's EVP digest interface+synopsis:               FFI Bindings to OpenSSL's EVP Digest Interface description:            Foreign-function bindings to the                         <http://www.openssl.org/ OpenSSL library>. Currently                         provides access to the messages digests MD5, DSS, DSS1,-                        RIPEMD160, and several variants of SHA through the EVP+                        RIPEMD160, and various SHA variants through the EVP                         digest interface. cabal-version:          >= 1.8 build-type:             Simple@@ -24,12 +24,18 @@ library   build-depends:        base >= 4.6 && < 5, bytestring   hs-source-dirs:       src-  other-extensions:     ForeignFunctionInterface, EmptyDataDecls, DeriveDataTypeable,-                        FlexibleInstances, TypeSynonymInstances+  other-extensions:     CPP, DeriveDataTypeable, EmptyDataDecls, FlexibleInstances,+                        ForeignFunctionInterface, TypeSynonymInstances   extra-libraries:      crypto   includes:             "openssl/evp.h"   exposed-modules:      OpenSSL.Digest+                        OpenSSL.Util                         OpenSSL.EVP.Digest+                        OpenSSL.EVP.Digest.Algorithm+                        OpenSSL.EVP.Digest.Digest+                        OpenSSL.EVP.Digest.Context+                        OpenSSL.EVP.Digest.Error+                        OpenSSL.EVP.Digest.Initialization  test-suite check-low-level-digest-api   type:                 exitcode-stdio-1.0

@@ -9,9 +9,9 @@    This module provides a generic high-level API to the message digest    algorithms found in OpenSSL's @crypto@ library. There are two functions of    particular interest: 'digestByName' and 'digest'. The former can be used to-   retrieve a 'DigestDescription', i.e. an OpenSSL object that implements a-   particular algorithm. That type can then be used to compute actual message-   digests with the latter function:+   retrieve an 'Algorithm', i.e. an OpenSSL object that implements a particular+   algorithm. That type can then be used to compute actual message digests with+   the latter function:     >>> import Data.ByteString.Char8 ( pack )    >>> digest (digestByName "md5") (pack "Hello, world.")@@ -36,9 +36,8 @@    >>> digestByName' "i bet this algorithm won't exist"    Nothing -   'DigestDescription' is an instance of 'IsString', so with the proper GHC-   extensions enabled it's possible to simplify the call to 'digest' even-   further:+   'Algorithm' is an instance of 'IsString', so with the proper GHC extensions+   enabled it's possible to simplify the call to 'digest' even further:     >>> :set -XOverloadedStrings    >>> toHex $ digest "sha256" (pack "The 'Through the Universe' podcast rules.")@@ -50,12 +49,12 @@    construct of "void pointer plus a length". @digest@ can use with any of the    following signatures: -   >>> let shape1 = digest :: DigestDescription -> (Ptr (),    CSize) -> MessageDigest-   >>> let shape2 = digest :: DigestDescription -> (Ptr Word8, CSize) -> MessageDigest-   >>> let shape3 = digest :: DigestDescription -> (Ptr Word8, CUInt) -> MessageDigest-   >>> let shape4 = digest :: DigestDescription -> (Ptr (),    Int)   -> MessageDigest-   >>> let shape5 = digest :: DigestDescription -> StrictByteString   -> MessageDigest-   >>> let shape6 = digest :: DigestDescription -> LazyByteString     -> MessageDigest+   >>> let shape1 = digest :: Algorithm -> (Ptr (),    CSize) -> MessageDigest+   >>> let shape2 = digest :: Algorithm -> (Ptr Word8, CSize) -> MessageDigest+   >>> let shape3 = digest :: Algorithm -> (Ptr Word8, CUInt) -> MessageDigest+   >>> let shape4 = digest :: Algorithm -> (Ptr (),    Int)   -> MessageDigest+   >>> let shape5 = digest :: Algorithm -> StrictByteString   -> MessageDigest+   >>> let shape6 = digest :: Algorithm -> LazyByteString     -> MessageDigest     'StrictByteString' and 'LazyByteString' are also instances of 'IsString' and    therefore subject to implicit construction from string literals:@@ -83,7 +82,7 @@  module OpenSSL.Digest   ( -- * Generic digest API-    MessageDigest, digest, Digestable(..), digestByName, digestByName', DigestDescription+    MessageDigest, digest, Digestable(..), digestByName, digestByName', Algorithm   , -- * Special instances     digestString   , -- * Helper Types and Functions@@ -91,7 +90,8 @@   )   where -import OpenSSL.EVP.Digest hiding ( toHex )+import OpenSSL.EVP.Digest+import qualified OpenSSL.Util as Util  import Control.Exception import qualified Data.ByteString as Strict ( ByteString, packCStringLen, concatMap )@@ -100,38 +100,39 @@ import Data.ByteString.Unsafe ( unsafeUseAsCStringLen ) import Foreign import Foreign.C-import Numeric ( showHex ) import System.IO.Unsafe as IO --- $setup--- >>> import Data.Maybe- -- Generic Class API ---------------------------------------------------------- --- |A message digest is essentially an array of 'Word8' octets.+-- | A message digest is essentially an array of 'Word8' octets.  type MessageDigest = StrictByteString  -- | Compute the given message digest of any 'Digestable' thing, i.e. any type -- that can be converted /efficiently/ and /unambiguously/ into a continuous -- memory buffer or a sequence of continuous memory buffers. Note that 'String'--- does /not/ have that property, because there . The actual--- binary representation chosen for Unicode characters during that process is--- determined by the system's locale and is therefore non-deterministic.+-- does /not/ have that property, because the binary representation chosen for+-- Unicode characters during the marshaling process is determined by the+-- system's locale and is therefore non-deterministic. -digest :: Digestable a => DigestDescription -> a -> MessageDigest+digest :: Digestable a => Algorithm -> a -> MessageDigest digest algo input =   IO.unsafePerformIO $     bracket newContext freeContext $ \ctx -> do       initDigest algo ctx       updateChunk ctx input-      let mdSize = fromIntegral (_digestSize (getDigestDescription algo))+      let mdSize = fromIntegral (digestSize algo)       allocaArray mdSize $ \md -> do         finalizeDigest ctx md         Strict.packCStringLen (castPtr md, mdSize) +-- | A class of things that can be part of a digest computations. By default,+-- we define instances only for various representations of plain memory+-- buffers, but in theory that class can be extended to contain all kinds of+-- complex data types.+ class Digestable a where-  updateChunk :: DigestContext -> a -> IO ()+  updateChunk :: Context -> a -> IO ()  instance Digestable (Ptr a, CSize) where   {-# INLINE updateChunk #-}@@ -171,7 +172,7 @@ -- >>> toHex $ digestString (digestByName "sha1") "Hello, world." -- "2ae01472317d1935a84797ec1983ae243fc6aa28" -digestString :: DigestDescription -> String -> MessageDigest+digestString :: Algorithm -> String -> MessageDigest digestString algo str = IO.unsafePerformIO $   withCStringLen str (return . digest algo) @@ -192,10 +193,4 @@ -- "000102030405060708090a0b0c0d0e0f"  toHex :: MessageDigest -> StrictByteString-toHex = Strict.concatMap f-  where-    f :: Word8 -> StrictByteString-    f w = case showHex w "" of-            [w1,w2] -> pack [w1, w2]-            [w2]    -> pack ['0', w2]-            _       -> error "showHex returned []"+toHex = Strict.concatMap (pack . Util.toHex)

@@ -0,0 +1,26 @@+{- |+   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+ (+   -- * Digest Algorithms+   Algorithm+ , digestByName, digestByName', digestSize, maxDigestSize, digestBlockSize+ , UnknownAlgorithm+ , -- * Digest Contexts+   Context, newContext, freeContext, resetDigest+ , -- * Digest Computations+   initDigest, updateDigest, finalizeDigest+ )+ where++import OpenSSL.EVP.Digest.Algorithm+import OpenSSL.EVP.Digest.Context+import OpenSSL.EVP.Digest.Digest+import OpenSSL.EVP.Digest.Error

@@ -1,263 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE DeriveDataTypeable #-}--{- |-   Maintainer:  simons@cryp.to-   Stability:   provisional-   Portability: portable--   Computing message digests with OpenSSL's EVP interface involves the-   following types:--    * Every digest algorithm has an description, 'OpaqueDigestDescription' that-      can be looked up by name. We can do very few things with that type. We-      can use it to retrieve the size of the algorithm's output, '_digestSize'--    * TODO: complete this when I know what the high-level API looks like.---}--module OpenSSL.EVP.Digest where--import Control.Concurrent.MVar-import Control.Exception-import Control.Monad-import Data.Maybe-import Data.String ( IsString(..) )-import Data.Typeable ( Typeable )-import Foreign-import Foreign.C-import Numeric ( showHex )-import System.IO.Unsafe as IO--#include "openssl/opensslv.h"-#include "openssl/evp.h"--#if __GLASGOW_HASKELL__ < 800-#  let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)-#endif---- * Low-level API--#if OPENSSL_VERSION_NUMBER < 0x1010000f----------------------------------------------------------------------------------- ** OpenSSL Library Initialization------------------------------------------------------------------------------------ | Initialize the OpenSSL EVP engine and register all known digest types in--- the internal data structures. This function must be called before--- '_digestByName' can succeed. Calling it multiple times is probably not--- harmful, but it certainly unnecessary and should be avoided. Users of--- 'digestByName'' and 'digestByName' don't have to worry about this.--foreign import ccall unsafe "openssl/evp.h OpenSSL_add_all_digests" _addAllDigests :: IO ()-#endif------------------------------------------------------------------------------------ ** Accessing the Supported Digest Types----------------------------------------------------------------------------------data OpaqueDigestDescription---- | Look up a 'Digest' by name.-#if OPENSSL_VERSION_NUMBER < 0x1010000f--- Be sure to call '_addAllDigests' before you use this function.-#endif--foreign import ccall unsafe "openssl/evp.h EVP_get_digestbyname" _digestByName :: CString -> Ptr OpaqueDigestDescription---- | Return the size of the digest the given algorithm will produce.--foreign import ccall unsafe "openssl/evp.h EVP_MD_size" _digestSize :: Ptr OpaqueDigestDescription -> CInt---- | Return the block size the the given algorithm operates with.--foreign import ccall unsafe "openssl/evp.h EVP_MD_block_size" _digestBlockSize :: Ptr OpaqueDigestDescription -> CInt---- | The largest possible digest size of any of the algorithms supported by--- this library. 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 = #{const EVP_MAX_MD_SIZE}---- | We don't support choosing specific engines. Always pass 'nullPtr' where--- such a thing is expected to get the default engine for the given algorithm.--data OpaqueDigestEngine------------------------------------------------------------------------------------ ** Digest Contexts------------------------------------------------------------------------------------ | A context in which -- when initialized -- digest computations can be run.--- Use '_newContext' and '_freeContext' to allocate/deallocate this type.--data OpaqueDigestContext---- | Allocate and initialize an 'OpaqueDigestContext' for use in a digest--- computation on the heap. Release its underlying memory after use with--- '_freeContext'.--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 (Ptr OpaqueDigestContext)--#if OPENSSL_VERSION_NUMBER >= 0x1010000f--- | Re-initialize a previously created 'OpaqueDigestContext' for use in a new--- digest computation.--foreign import ccall unsafe "openssl/evp.h EVP_MD_CTX_reset" _resetContext :: Ptr OpaqueDigestContext -> IO ()-#endif---- | Release all resources associated with a digest computation's context and--- the context structure itself. Use this only for context's acquired with--- '_newContext'.--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 :: Ptr OpaqueDigestContext -> IO ()------------------------------------------------------------------------------------ ** State of a Digest Computation------------------------------------------------------------------------------------ | Configure the given digest context to use the given message digest--- algorithm. The third parameter allows developers to choose a specific engine--- for that digest, too, but these bindings don't support choosing any specific--- engine, so pass 'nullPtr' here to the default choice determined by OpenSSL.--foreign import ccall unsafe "openssl/evp.h EVP_DigestInit_ex" _initDigest :: Ptr OpaqueDigestContext -> Ptr OpaqueDigestDescription -> Ptr OpaqueDigestEngine -> IO CInt---- | Hash the given block of memory and update the digest state accordingly.--- Naturally, this function can be called many times. Then use--- '_finalizeDigest' to retrieve the actual hash value.--foreign import ccall unsafe "openssl/evp.h EVP_DigestUpdate" _updateDigest :: Ptr OpaqueDigestContext -> Ptr a -> CSize -> IO CInt---- | Finalize the digest calculation and return the result in the 'Word8' array--- passed as an argument. Naturally, that array is expected to be large enough--- to contain the digest. '_digestSize' or 'maxDigestSize' are your friends. If--- the 'CUInt' pointer is not 'nullPtr', then the actual size of the generated--- digest is written into that integer. This function does /not/ clean up the--- digest context; this has to be done with an explicit call to '_freeContext'.--- However, it does invalidate the digest state so that no further calls of--- '_digestUpdate' can be made without re-initializing the state with--- '_resetDigest' first.--foreign import ccall unsafe "openssl/evp.h EVP_DigestFinal_ex" _finalizeDigest :: Ptr OpaqueDigestContext -> Ptr Word8 -> Ptr CUInt -> IO CInt------------------------------------------------------------------------------------ * High-level interface----------------------------------------------------------------------------------newtype DigestDescription = DigestDescription { getDigestDescription :: Ptr OpaqueDigestDescription }-  deriving (Show, Eq)--digestByName :: String -> DigestDescription-digestByName algo =-  fromMaybe (throw (DigestAlgorithmNotAvailableInOpenSSL algo))-            (digestByName' algo)--digestByName' :: String -> Maybe DigestDescription-digestByName' algo = if ptr == nullPtr then Nothing else Just (DigestDescription ptr)-  where ptr = IO.unsafePerformIO $ withCString algo $ \name -> do-#if OPENSSL_VERSION_NUMBER < 0x1010000f-                modifyMVar_ isDigestEngineInitialized $ \isInitialized ->-                  unless isInitialized _addAllDigests >> return True-#endif-                return (_digestByName name)--newtype DigestContext = DigestContext { getDigestContext :: Ptr OpaqueDigestContext }--digestContext :: Ptr OpaqueDigestContext -> DigestContext-digestContext ptr-  | ptr == nullPtr = throw AttemptToConstructDigestContextFromNullPointer-  | otherwise      = DigestContext ptr--#if OPENSSL_VERSION_NUMBER >= 0x1010000f-resetContext :: DigestContext -> IO ()-resetContext (DigestContext ctx) = _resetContext ctx-#endif--newContext :: IO DigestContext-newContext =-  fmap DigestContext (throwIfNull "OpenSSL.EVP.Digest.newContext failed" _newContext)---- | Simplified variant of '_initDigest' that (a) always chooses the default--- digest engine and (b) reports failure by means of an exception.--initDigest :: DigestDescription -> DigestContext -> IO ()-initDigest (DigestDescription algo) (DigestContext ctx) =-  throwIfZero "OpenSSL.EVP.Digest.initDigest" (_initDigest ctx algo nullPtr)--freeContext :: DigestContext -> IO ()-freeContext (DigestContext ctx) = _freeContext ctx--updateDigest :: DigestContext -> Ptr a -> CSize -> IO ()-updateDigest (DigestContext ctx) ptr len =-  throwIfZero "OpenSSL.EVP.Digest.updateDigest" (_updateDigest ctx ptr len)--finalizeDigest :: DigestContext -> Ptr Word8 -> IO ()-finalizeDigest (DigestContext ctx) ptr =-  throwIfZero "OpenSSL.EVP.Digest.finalizeDigest" (_finalizeDigest ctx ptr nullPtr)---- * Helper Types and Functions---- | Most OpenSSL functions return an approximation of @Bool@ to signify--- failure. This wrapper makes it easier to move the error handling to the--- exception layer where appropriate.--throwIfZero :: String -> IO CInt -> IO ()-throwIfZero fname =-  throwIf_ (==0) (const (showString fname " failed with error code 0"))---- |Neat helper to pretty-print digests into the common hexadecimal notation:------ >>> [0..15] >>= toHex--- "000102030405060708090a0b0c0d0e0f"--toHex :: Word8 -> String-toHex w = case showHex w "" of-           [w1,w2] -> [w1, w2]-           [w2]    -> ['0', w2]-           _       -> "showHex returned []"--{-# NOINLINE isDigestEngineInitialized #-}-isDigestEngineInitialized :: MVar Bool-isDigestEngineInitialized = IO.unsafePerformIO $ newMVar False---- | This instance allows the compiler to translate the string @"sha256"@ into--- @digestByName "sha256"@ whenever a 'String' is passed in a location that--- expects a 'DigestDescription'. If that digest engine does not exist, then an--- exception is thrown. This feature requires the @OverloadedStrings@ extension--- enabled.--instance IsString DigestDescription where-  fromString = digestByName---- | A custom exception type which is thrown by 'digestByName' in case the--- requested digest algorithm is not available in the OpenSSL system library.--newtype DigestAlgorithmNotAvailableInOpenSSL = DigestAlgorithmNotAvailableInOpenSSL String-  deriving (Show, Typeable)--instance Exception DigestAlgorithmNotAvailableInOpenSSL---- | A custom exception type thrown by 'digestContext' if the function is used--- to construct a 'DigestContext' from a 'nullPtr'.--data AttemptToConstructDigestContextFromNullPointer = AttemptToConstructDigestContextFromNullPointer-  deriving (Show, Typeable)--instance Exception AttemptToConstructDigestContextFromNullPointer

@@ -0,0 +1,100 @@+{-# 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++#include "openssl/opensslv.h"+#include "openssl/evp.h"++-- | 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 (Show, Eq)++instance IsString Algorithm where+  fromString = 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 algo =+  fromMaybe (throw (UnknownAlgorithm algo)) (digestByName' 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' algo = do+  let Algorithm p = IO.unsafePerformIO $ do+                      initializeEVPDigests+                      withCString algo (return . _digestByName)+  if p == nullPtr then Nothing else Just (Algorithm p)++-- | Return the size of the digest in bytes that the given algorithm will produce.+--+-- >>> digestSize (digestByName "sha256")+-- 32++digestSize :: Algorithm -> Int+digestSize = fromIntegral . _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 = #{const EVP_MAX_MD_SIZE}++-- | Return the block size the the given algorithm operates with.+--+-- >>> digestBlockSize (digestByName "sha256")+-- 64++digestBlockSize :: Algorithm -> Int+digestBlockSize = fromIntegral . _digestBlockSize++-------------------------------------------------------------------------------++foreign import ccall unsafe "openssl/evp.h EVP_get_digestbyname"+  _digestByName :: CString -> Algorithm++foreign import ccall unsafe "openssl/evp.h EVP_MD_size"+  _digestSize :: Algorithm -> CInt++foreign import ccall unsafe "openssl/evp.h EVP_MD_block_size"+  _digestBlockSize :: Algorithm -> CInt

@@ -0,0 +1,68 @@+{-# 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 (Show, 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 = do ctx@(Context p) <- _newContext+                when (p == nullPtr) (fail "OpenSSL.EVP.Digest.Context.newContext failed")+                return 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 ctx =+  throwIfZero "OpenSSL.EVP.Digest.resetDigest" (_resetContext 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

@@ -0,0 +1,67 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}++{- |+   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.Digest where++import OpenSSL.EVP.Digest.Algorithm+import OpenSSL.EVP.Digest.Context+import OpenSSL.EVP.Digest.Error ( throwIfZero )++import Foreign+import Foreign.C++-- | Configure the given digest context to use the given message digest+-- algorithm. Throws an exception to signal failure, i.e. because the system is+-- out of memory.++initDigest :: Algorithm -> Context -> IO ()+initDigest algo ctx =+  throwIfZero "OpenSSL.EVP.Digest.initDigest" (_initDigest ctx algo nullPtr)++-- | Hash the given block of memory and update the digest state accordingly.+-- This function can be called many times. Then use 'finalizeDigest' to+-- retrieve the actual hash value.++updateDigest :: Context -> Ptr a -> CSize -> IO ()+updateDigest ctx ptr len =+  throwIfZero "OpenSSL.EVP.Digest.updateDigest" (_updateDigest ctx ptr len)++-- | Finalize the digest calculation and return the result in the 'Word8' array+-- passed as an argument. Naturally, that array is expected to be large enough+-- to contain the digest. 'digestSize' or 'maxDigestSize' are your friends.+-- This function does /not/ clean up the digest context; this has to be done+-- with an explicit call to 'freeContext' (or 'resetContext', if you want to+-- re-use it). However, it does invalidate the digest state so that no further+-- calls of 'digestUpdate' can be made without re-initializing the context+-- first.++finalizeDigest :: Context -> Ptr Word8 -> IO ()+finalizeDigest ctx ptr =+  throwIfZero "OpenSSL.EVP.Digest.finalizeDigest" (_finalizeDigest ctx ptr nullPtr)++-------------------------------------------------------------------------------++-- | We don't support choosing a custom engine to implement the given+-- algorithm. This type is just a place holder, and we always pass 'nullPtr'+-- whereever it is required to let OpenSSL choose whatever engine it thinks is+-- best.++data OpaqueEngine++foreign import ccall unsafe "openssl/evp.h EVP_DigestInit_ex"+  _initDigest :: Context -> Algorithm -> Ptr OpaqueEngine -> IO CInt++foreign import ccall unsafe "openssl/evp.h EVP_DigestUpdate"+  _updateDigest :: Context -> Ptr a -> CSize -> IO CInt++foreign import ccall unsafe "openssl/evp.h EVP_DigestFinal_ex"+  _finalizeDigest :: Context -> Ptr Word8 -> Ptr CUInt -> IO CInt

@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveDataTypeable #-}++{- |+   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.Error where++import Control.Exception+import Data.Typeable ( Typeable )+import Foreign+import Foreign.C++-- | Most OpenSSL functions return an approximation of @Bool@ to signify+-- failure. This wrapper makes it easier to move the error handling to the+-- exception layer where appropriate.++throwIfZero :: String -> IO CInt -> IO ()+throwIfZero fname =+  throwIf_ (==0) (const (showString fname " failed with error code 0"))++-- | A custom exception type which is thrown by 'digestByName' in case the+-- requested digest algorithm is not available in the OpenSSL system library.++newtype UnknownAlgorithm = UnknownAlgorithm String+  deriving (Show, Typeable)++instance Exception UnknownAlgorithm

@@ -0,0 +1,41 @@+{-# LANGUAGE CPP #-}+{-# 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.Initialization ( initializeEVPDigests ) where++import Control.Concurrent.MVar+import Control.Monad+import System.IO.Unsafe as IO++#include "openssl/opensslv.h"++-- | Initialize the OpenSSL EVP engine and register all known digest types in+-- the internal data structures. This function must be called before any of the+-- message digest functions can succeed. This is generally handled+-- transparently by the Haskell implementation and users do not need to worry+-- about this.++initializeEVPDigests :: IO ()+initializeEVPDigests =+#if OPENSSL_VERSION_NUMBER >= 0x1010000f+  return ()+#else+  modifyMVar_ isDigestEngineInitialized $ \isInitialized ->+    unless isInitialized _addAllDigests >> return True++{-# NOINLINE isDigestEngineInitialized #-}+isDigestEngineInitialized :: MVar Bool+isDigestEngineInitialized = IO.unsafePerformIO $ newMVar False++foreign import ccall unsafe "openssl/evp.h OpenSSL_add_all_digests" _addAllDigests :: IO ()++#endif

@@ -0,0 +1,24 @@+{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: portable++   Random collection of utility functions that may be useful, but which aren't+   useful enough to be included in the main API modules.+-}++module OpenSSL.Util where++import Data.Word+import Numeric++-- |Neat helper to pretty-print digests into the common hexadecimal notation:+--+-- >>> [0..15] >>= toHex+-- "000102030405060708090a0b0c0d0e0f"++toHex :: Word8 -> String+toHex w = case showHex w "" of+           [w1,w2] -> [w1, w2]+           [w2]    -> ['0', w2]+           _       -> "showHex returned []"

@@ -1,8 +1,10 @@ module Main ( main ) where -import OpenSSL.EVP.Digest import OpenSesame +import OpenSSL.EVP.Digest+import OpenSSL.Util+ import Control.Exception import Foreign import Foreign.C.String@@ -20,13 +22,13 @@     Nothing -> return ()     Just algo -> digest algo input >>= assertEqual algoName expect -digest :: DigestDescription -> String -> IO String+digest :: Algorithm -> String -> IO String digest algo input = do-  let digestSize = _digestSize (getDigestDescription algo)+  let mdSize = digestSize algo   md <- bracket newContext freeContext $ \ctx -> do     initDigest algo ctx     withCStringLen input $ \(ptr,len) -> updateDigest ctx ptr (fromIntegral len)-    allocaArray (fromIntegral digestSize) $ \md -> do+    allocaArray mdSize $ \md -> do       finalizeDigest ctx md-      peekArray (fromIntegral digestSize) md+      peekArray mdSize md   return (md >>= toHex)

@@ -9,4 +9,4 @@   distDir <- fromMaybe "dist" `fmap` lookupEnv "HASKELL_DIST_DIR"   let hscFilesDir = distDir ++ "/build"       packageDB = distDir ++ "/package.conf.inplace"-  doctest [ "-i" ++ hscFilesDir, "-package-db=" ++ packageDB, "-package=hopenssl", "src" ]+  doctest [ "-package-db=" ++ packageDB, "-package=hopenssl", "src", hscFilesDir ]