diff --git a/hopenssl.cabal b/hopenssl.cabal --- a/hopenssl.cabal +++ b/hopenssl.cabal @@ -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 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 . 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 diff --git a/src/OpenSSL/Digest.hs b/src/OpenSSL/Digest.hs --- a/src/OpenSSL/Digest.hs +++ b/src/OpenSSL/Digest.hs @@ -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) diff --git a/src/OpenSSL/EVP/Digest.hs b/src/OpenSSL/EVP/Digest.hs new file mode 100644 --- /dev/null +++ b/src/OpenSSL/EVP/Digest.hs @@ -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 diff --git a/src/OpenSSL/EVP/Digest.hsc b/src/OpenSSL/EVP/Digest.hsc deleted file mode 100644 --- a/src/OpenSSL/EVP/Digest.hsc +++ /dev/null @@ -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 diff --git a/src/OpenSSL/EVP/Digest/Algorithm.hsc b/src/OpenSSL/EVP/Digest/Algorithm.hsc new file mode 100644 --- /dev/null +++ b/src/OpenSSL/EVP/Digest/Algorithm.hsc @@ -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 diff --git a/src/OpenSSL/EVP/Digest/Context.hs b/src/OpenSSL/EVP/Digest/Context.hs new file mode 100644 --- /dev/null +++ b/src/OpenSSL/EVP/Digest/Context.hs @@ -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 diff --git a/src/OpenSSL/EVP/Digest/Digest.hs b/src/OpenSSL/EVP/Digest/Digest.hs new file mode 100644 --- /dev/null +++ b/src/OpenSSL/EVP/Digest/Digest.hs @@ -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 diff --git a/src/OpenSSL/EVP/Digest/Error.hs b/src/OpenSSL/EVP/Digest/Error.hs new file mode 100644 --- /dev/null +++ b/src/OpenSSL/EVP/Digest/Error.hs @@ -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 diff --git a/src/OpenSSL/EVP/Digest/Initialization.hs b/src/OpenSSL/EVP/Digest/Initialization.hs new file mode 100644 --- /dev/null +++ b/src/OpenSSL/EVP/Digest/Initialization.hs @@ -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 diff --git a/src/OpenSSL/Util.hs b/src/OpenSSL/Util.hs new file mode 100644 --- /dev/null +++ b/src/OpenSSL/Util.hs @@ -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 []" diff --git a/test/CheckLowLevelDigestAPI.hs b/test/CheckLowLevelDigestAPI.hs --- a/test/CheckLowLevelDigestAPI.hs +++ b/test/CheckLowLevelDigestAPI.hs @@ -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) diff --git a/test/doctests.hs b/test/doctests.hs --- a/test/doctests.hs +++ b/test/doctests.hs @@ -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 ]