diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -5,7 +5,7 @@ can generate RSA and DSA keys, read and write PEM files, generate message digests, sign and verify messages, encrypt and decrypt messages. -Version: 0.6.5 +Version: 0.7 License: PublicDomain License-File: COPYING Author: Adam Langley , PHO @@ -35,7 +35,12 @@ Location: http://darcs.cielonegro.org/HsOpenSSL/ Library - Build-Depends: base >= 4 && < 5, bytestring, ghc-prim, integer, time >= 1.1.1, old-locale, network>=2.1.0.0 + Build-Depends: base >= 4 && < 5, bytestring, ghc-prim, time >= 1.1.1, old-locale, network>=2.1.0.0 + + if impl(ghc >= 6.11) + Build-Depends: integer-gmp + else + Build-Depends: integer if os(mingw32) Extra-Libraries: eay32 diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,5 +1,14 @@ -*- Coding: utf-8 -*- +Changes from 0.6.5 to 0.7 +------------------------- +* Applied patches by Taru Karttunen to make HsOpenSSL compatible with + GHC 6.12.1. + +* Many cosmetic changes to suppress warnings which GHC 6.12.1 + emits. It shouldn't change any semantics. + + Changes from 0.6.4 to 0.6.5 --------------------------- * Suggestion by Carl Mackey: diff --git a/OpenSSL/ASN1.hsc b/OpenSSL/ASN1.hsc --- a/OpenSSL/ASN1.hsc +++ b/OpenSSL/ASN1.hsc @@ -21,7 +21,6 @@ import Control.Exception -import Control.Monad import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Time.Format @@ -86,7 +85,7 @@ peekASN1Integer intPtr = allocaBN $ \ bn -> do _ASN1_INTEGER_to_BN intPtr (unwrapBN bn) - >>= failIfNull + >>= failIfNull_ peekBN bn @@ -100,7 +99,7 @@ = withBN int $ \ bn -> allocaASN1Integer $ \ intPtr -> do _BN_to_ASN1_INTEGER (unwrapBN bn) intPtr - >>= failIfNull + >>= failIfNull_ m intPtr @@ -126,7 +125,7 @@ = do bio <- newMem withBioPtr bio $ \ bioPtr -> _ASN1_TIME_print bioPtr time - >>= failIf (/= 1) + >>= failIf_ (/= 1) timeStr <- bioRead bio case parseTime locale "%b %e %H:%M:%S %Y %Z" timeStr of Just utc -> return utc @@ -158,5 +157,5 @@ withASN1Time utc m = allocaASN1Time $ \ time -> do _ASN1_TIME_set time (fromIntegral $ (round $ utcTimeToPOSIXSeconds utc :: Integer)) - >>= failIfNull + >>= failIfNull_ m time diff --git a/OpenSSL/BIO.hsc b/OpenSSL/BIO.hsc --- a/OpenSSL/BIO.hsc +++ b/OpenSSL/BIO.hsc @@ -125,10 +125,11 @@ withBioPtr' (Just bio) f = withBioPtr bio f --- a の後ろに b を付ける。a の參照だけ保持してそこに書き込む事も、b の --- 參照だけ保持してそこから讀み出す事も、兩方考へられるので、双方の --- ForeignPtr が双方を touch する。參照カウント方式ではないから循環參照 --- しても問題無い。 +-- Connect 'b' behind 'a'. It's possible that 1. we only retain 'a' +-- and write to 'a', and 2. we only retain 'b' and read from 'b', so +-- both ForeignPtr's have to touch each other. This involves a +-- circular dependency but that won't be a problem as the garbage +-- collector isn't reference-counting. -- |Computation of @'bioPush' a b@ connects @b@ behind @a@. -- @@ -150,7 +151,7 @@ bioPush (BIO a) (BIO b) = withForeignPtr a $ \ aPtr -> withForeignPtr b $ \ bPtr -> - do _push aPtr bPtr + do _ <- _push aPtr bPtr Conc.addForeignPtrFinalizer a $ touchForeignPtr b Conc.addForeignPtrFinalizer b $ touchForeignPtr a return () @@ -205,8 +206,9 @@ bioReset :: BIO -> IO () bioReset bio = withBioPtr bio $ \ bioPtr -> - _reset bioPtr >> return () -- BIO_reset の戻り値は全 BIO で共通で - -- ないのでエラーチェックが出來ない。 + _reset bioPtr >> return () -- Return value of BIO_reset is not + -- consistent in every BIO's so we + -- can't do error-checking. -- |@'bioEOF' bio@ returns 1 if @bio@ has read EOF, the precise -- meaning of EOF varies according to the BIO type. @@ -442,7 +444,7 @@ newConstMemBS bs = let (foreignBuf, off, len) = toForeignPtr bs in - -- ByteString への參照を BIO の finalizer に持たせる。 + -- Let the BIO's finalizer have a reference to the ByteString. withForeignPtr foreignBuf $ \ buf -> do bioPtr <- _new_mem_buf (castPtr $ buf `plusPtr` off) (fromIntegral len) >>= failIfNull diff --git a/OpenSSL/BN.hsc b/OpenSSL/BN.hsc --- a/OpenSSL/BN.hsc +++ b/OpenSSL/BN.hsc @@ -52,11 +52,15 @@ #else import Foreign.C.Types import GHC.Base +#if __GLASGOW_HASKELL__ < 612 import GHC.Num import GHC.Prim import GHC.Integer.Internals import GHC.IOBase (IO(..)) +#else +import GHC.Integer.GMP.Internals #endif +#endif -- |'BigNum' is an opaque object representing a big number. newtype BigNum = BigNum (Ptr BIGNUM) @@ -173,8 +177,8 @@ then return $ S## i else return $ 0 - (S## i) _ -> do - let (I## nlimbsi) = fromIntegral nlimbs - (I## limbsize) = (#size unsigned long) + let !(I## nlimbsi) = fromIntegral nlimbs + !(I## limbsize) = (#size unsigned long) (MBA arr) <- newByteArray (nlimbsi *## limbsize) (BA ba) <- freezeByteArray arr limbs <- (#peek BIGNUM, d) (unwrapBN bn) @@ -265,7 +269,7 @@ bnToMPI bn = do bytes <- _bn2mpi (unwrapBN bn) nullPtr allocaBytes (fromIntegral bytes) (\buffer -> do - _bn2mpi (unwrapBN bn) buffer + _ <- _bn2mpi (unwrapBN bn) buffer BS.packCStringLen (buffer, fromIntegral bytes)) -- | Convert an MPI into a BigNum. See bnToMPI for details of the format @@ -309,7 +313,7 @@ withBN m (\bnM -> (do withBNCtx (\ctx -> (do r <- newBN 0 - _mod_exp (unwrapBN r) (unwrapBN bnA) (unwrapBN bnP) (unwrapBN bnM) ctx + _ <- _mod_exp (unwrapBN r) (unwrapBN bnA) (unwrapBN bnP) (unwrapBN bnM) ctx bnToInteger r >>= return))))))))) {- Random Integer generation ------------------------------------------------ -} @@ -328,7 +332,7 @@ randIntegerUptoNMinusOneSuchThat f range = withBN range (\bnRange -> (do r <- newBN 0 let try = do - _BN_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf (/= 1) + _BN_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf_ (/= 1) i <- bnToInteger r if f i then return i @@ -343,7 +347,7 @@ prandIntegerUptoNMinusOneSuchThat f range = withBN range (\bnRange -> (do r <- newBN 0 let try = do - _BN_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf (/= 1) + _BN_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf_ (/= 1) i <- bnToInteger r if f i then return i diff --git a/OpenSSL/Cipher.hsc b/OpenSSL/Cipher.hsc --- a/OpenSSL/Cipher.hsc +++ b/OpenSSL/Cipher.hsc @@ -75,8 +75,8 @@ withForeignPtr ctx $ \ctxPtr -> BS.useAsCStringLen key (\(ptr, _) -> case mode of - Encrypt -> _AES_set_encrypt_key ptr (fromIntegral keyLen) ctxPtr >>= failIf (/= 0) - Decrypt -> _AES_set_decrypt_key ptr (fromIntegral keyLen) ctxPtr >>= failIf (/= 0)) + Encrypt -> _AES_set_encrypt_key ptr (fromIntegral keyLen) ctxPtr >>= failIf_ (/= 0) + Decrypt -> _AES_set_decrypt_key ptr (fromIntegral keyLen) ctxPtr >>= failIf_ (/= 0)) ivbytes <- mallocForeignPtrBytes 16 ecounter <- mallocForeignPtrBytes 16 nref <- newIORef 0 diff --git a/OpenSSL/DSA.hsc b/OpenSSL/DSA.hsc --- a/OpenSSL/DSA.hsc +++ b/OpenSSL/DSA.hsc @@ -39,7 +39,9 @@ import Foreign.C.Types import OpenSSL.BN import OpenSSL.Utils +#if !(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 612) import System.IO.Unsafe +#endif -- | The type of a DSA public key, includes parameters p, q, g and public. newtype DSAPubKey = DSAPubKey (ForeignPtr DSA) @@ -166,7 +168,7 @@ Nothing -> x (nullPtr, 0) Just seed -> BS.useAsCStringLen seed x) (\(seedptr, seedlen) -> do ptr <- _generate_params (fromIntegral nbits) seedptr (fromIntegral seedlen) i1 i2 nullPtr nullPtr - failIfNull ptr + failIfNull_ ptr itcount <- peek i1 gencount <- peek i2 p <- (#peek DSA, p) ptr >>= peekBN . wrapBN @@ -269,7 +271,7 @@ Nothing -> x (nullPtr, 0) Just seed -> BS.useAsCStringLen seed x) (\(seedptr, seedlen) -> do ptr <- _generate_params (fromIntegral nbits) seedptr (fromIntegral seedlen) nullPtr nullPtr nullPtr nullPtr - failIfNull ptr + failIfNull_ ptr _dsa_generate_key ptr newForeignPtr _free ptr >>= return . DSAKeyPair) @@ -282,7 +284,7 @@ alloca (\rptr -> do alloca (\sptr -> do withDSAPtr dsa (\dsaptr -> do - _dsa_sign dsaptr ptr (fromIntegral len) rptr sptr >>= failIf (== 0) + _dsa_sign dsaptr ptr (fromIntegral len) rptr sptr >>= failIf_ (== 0) r <- peek rptr >>= peekBN . wrapBN peek rptr >>= _bn_free s <- peek sptr >>= peekBN . wrapBN diff --git a/OpenSSL/EVP/Base64.hsc b/OpenSSL/EVP/Base64.hsc --- a/OpenSSL/EVP/Base64.hsc +++ b/OpenSSL/EVP/Base64.hsc @@ -26,11 +26,13 @@ import Foreign.C --- エンコード時: 最低 3 バイト以上になるまで次のブロックを取り出し續け --- る。返された[ByteString] は B8.concat してから、その文字列長より小さ --- な最大の 3 の倍數の位置で分割し、殘りは次のブロックの一部と見做す。 +-- On encoding, we keep fetching the next block until we get at least +-- 3 bytes. Then we apply B8.concat to the returned [ByteString] and +-- split it at the offset in multiple of 3, then prepend the remaining +-- bytes to the next block. -- --- デコード時: 分割のアルゴリズムは同じだが最低バイト数が 4。 +-- On decoding, we apply the same algorithm but we split the input in +-- multiple of 4. nextBlock :: Int -> ([B8.ByteString], L8.ByteString) -> ([B8.ByteString], L8.ByteString) nextBlock minLen (xs, src) = if foldl' (+) 0 (map B8.length xs) >= minLen then @@ -79,7 +81,7 @@ block' = B8.concat blockParts' blockLen' = B8.length block' (block , leftover) = if blockLen' < 3 then - -- 最後の半端 + -- The last remnant. (block', B8.empty) else B8.splitAt (blockLen' - blockLen' `mod` 3) block' diff --git a/OpenSSL/EVP/Cipher.hsc b/OpenSSL/EVP/Cipher.hsc --- a/OpenSSL/EVP/Cipher.hsc +++ b/OpenSSL/EVP/Cipher.hsc @@ -142,7 +142,7 @@ withCString key $ \ keyPtr -> withCString iv $ \ ivPtr -> _CipherInit ctxPtr c keyPtr ivPtr (cryptoModeToInt mode) - >>= failIf (/= 1) + >>= failIf_ (/= 1) return ctx diff --git a/OpenSSL/EVP/Digest.hsc b/OpenSSL/EVP/Digest.hsc --- a/OpenSSL/EVP/Digest.hsc +++ b/OpenSSL/EVP/Digest.hsc @@ -116,7 +116,7 @@ digestInit (Digest md) = do ctx <- newCtx withDigestCtxPtr ctx $ \ ctxPtr -> - _DigestInit ctxPtr md >>= failIf (/= 1) + _DigestInit ctxPtr md >>= failIf_ (/= 1) return ctx @@ -132,7 +132,7 @@ = withDigestCtxPtr ctx $ \ ctxPtr -> allocaArray (#const EVP_MAX_MD_SIZE) $ \ bufPtr -> alloca $ \ bufLenPtr -> - do _DigestFinal ctxPtr bufPtr bufLenPtr >>= failIf (/= 1) + do _DigestFinal ctxPtr bufPtr bufLenPtr >>= failIf_ (/= 1) bufLen <- liftM fromIntegral $ peek bufLenPtr peekCStringLen (bufPtr, bufLen) @@ -141,7 +141,7 @@ withDigestCtxPtr ctx $ \ctxPtr -> createAndTrim (#const EVP_MAX_MD_SIZE) $ \bufPtr -> alloca $ \bufLenPtr -> - do _DigestFinal ctxPtr (castPtr bufPtr) bufLenPtr >>= failIf (/= 1) + do _DigestFinal ctxPtr (castPtr bufPtr) bufLenPtr >>= failIf_ (/= 1) liftM fromIntegral $ peek bufLenPtr @@ -216,8 +216,11 @@ unsafeUseAsCStringLen pass $ \(passdata, passlen) -> unsafeUseAsCStringLen salt $ \(saltdata, saltlen) -> create dkeylen $ \dkeydata -> - do _PKCS5_PBKDF2_HMAC_SHA1 passdata (fromIntegral passlen) saltdata (fromIntegral saltlen) (fromIntegral iter) (fromIntegral dkeylen) (castPtr dkeydata) - return () + _PKCS5_PBKDF2_HMAC_SHA1 + passdata (fromIntegral passlen) + saltdata (fromIntegral saltlen) + (fromIntegral iter) (fromIntegral dkeylen) (castPtr dkeydata) + >> return () foreign import ccall unsafe "PKCS5_PBKDF2_HMAC_SHA1" _PKCS5_PBKDF2_HMAC_SHA1 :: Ptr CChar -> CInt -> Ptr CChar -> CInt diff --git a/OpenSSL/EVP/Open.hsc b/OpenSSL/EVP/Open.hsc --- a/OpenSSL/EVP/Open.hsc +++ b/OpenSSL/EVP/Open.hsc @@ -10,7 +10,6 @@ ) where -import Control.Monad import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 import Foreign @@ -38,7 +37,7 @@ withCString iv $ \ ivPtr -> withPKeyPtr' pkey $ \ pkeyPtr -> _OpenInit ctxPtr cipher encKeyPtr (fromIntegral encKeyLen) ivPtr pkeyPtr - >>= failIf (== 0) + >>= failIf_ (== 0) return ctx -- |@'open'@ lazilly decrypts a stream of data. The input string diff --git a/OpenSSL/EVP/PKey.hsc b/OpenSSL/EVP/PKey.hsc --- a/OpenSSL/EVP/PKey.hsc +++ b/OpenSSL/EVP/PKey.hsc @@ -217,7 +217,7 @@ rsaToPKey rsa = withRSAPtr rsa $ \ rsaPtr -> do pkeyPtr <- _pkey_new >>= failIfNull - _set1_RSA pkeyPtr rsaPtr >>= failIf (/= 1) + _set1_RSA pkeyPtr rsaPtr >>= failIf_ (/= 1) wrapPKeyPtr pkeyPtr rsaFromPKey :: RSAKey k => VaguePKey -> IO (Maybe k) @@ -259,7 +259,7 @@ dsaToPKey dsa = withDSAPtr dsa $ \ dsaPtr -> do pkeyPtr <- _pkey_new >>= failIfNull - _set1_DSA pkeyPtr dsaPtr >>= failIf (/= 1) + _set1_DSA pkeyPtr dsaPtr >>= failIf_ (/= 1) wrapPKeyPtr pkeyPtr dsaFromPKey :: DSAKey k => VaguePKey -> IO (Maybe k) diff --git a/OpenSSL/EVP/Seal.hsc b/OpenSSL/EVP/Seal.hsc --- a/OpenSSL/EVP/Seal.hsc +++ b/OpenSSL/EVP/Seal.hsc @@ -10,7 +10,6 @@ ) where -import Control.Monad import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 import Foreign @@ -38,27 +37,27 @@ sealInit cipher pubKeys = do ctx <- newCtx - - -- 暗号化された共通鍵の配列が書き込まれる場所を作る。各共通鍵 - -- は最大で pkeySize の長さになる。 + + -- Allocate a list of buffers to write encrypted symmetric + -- keys. Each keys will be at most pkeySize bytes long. encKeyBufs <- mapM mallocEncKeyBuf pubKeys - -- encKeys は [Ptr a] なので、これを Ptr (Ptr CChar) にしなけ - -- ればならない。 + -- encKeyBufs is [Ptr a] but we want Ptr (Ptr CChar). encKeyBufsPtr <- newArray encKeyBufs - -- 暗号化された共通鍵の各々の長さが書き込まれる場所を作る。 + -- Allocate a buffer to write lengths of each encrypted + -- symmetric keys. encKeyBufsLenPtr <- mallocArray nKeys - -- IV の書き込まれる場所を作る。 + -- Allocate a buffer to write IV. ivPtr <- mallocArray (cipherIvLength cipher) - -- [PKey] から Ptr (Ptr EVP_PKEY) を作る。後でそれぞれの - -- PKey を touchForeignPtr する事を忘れてはならない。 + -- Create Ptr (Ptr EVP_PKEY) from [PKey]. Don't forget to + -- apply touchForeignPtr to each PKey's later. pkeys <- mapM toPKey pubKeys pubKeysPtr <- newArray $ map unsafePKeyToPtr pkeys - -- 確保した領域を解放する IO アクションを作って置く + -- Prepare an IO action to free buffers we allocated above. let cleanup = do mapM_ free encKeyBufs free encKeyBufsPtr free encKeyBufsLenPtr @@ -66,7 +65,7 @@ free pubKeysPtr mapM_ touchPKey pkeys - -- いよいよ EVP_SealInit を呼ぶ。 + -- Call EVP_SealInit finally. ret <- withCipherCtxPtr ctx $ \ ctxPtr -> _SealInit ctxPtr cipher encKeyBufsPtr encKeyBufsLenPtr ivPtr pubKeysPtr (fromIntegral nKeys) diff --git a/OpenSSL/EVP/Sign.hsc b/OpenSSL/EVP/Sign.hsc --- a/OpenSSL/EVP/Sign.hsc +++ b/OpenSSL/EVP/Sign.hsc @@ -32,7 +32,7 @@ allocaArray maxLen $ \ bufPtr -> alloca $ \ bufLenPtr -> do _SignFinal ctxPtr bufPtr bufLenPtr pkeyPtr - >>= failIf (/= 1) + >>= failIf_ (/= 1) bufLen <- liftM fromIntegral $ peek bufLenPtr peekCStringLen (bufPtr, bufLen) diff --git a/OpenSSL/EVP/Verify.hsc b/OpenSSL/EVP/Verify.hsc --- a/OpenSSL/EVP/Verify.hsc +++ b/OpenSSL/EVP/Verify.hsc @@ -11,7 +11,6 @@ ) where -import Control.Monad import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Typeable diff --git a/OpenSSL/PEM.hsc b/OpenSSL/PEM.hsc --- a/OpenSSL/PEM.hsc +++ b/OpenSSL/PEM.hsc @@ -162,8 +162,7 @@ Just (cipher, PwTTY) -> withCipherPtr cipher $ \ cipherPtr -> _write_bio_PKCS8PrivateKey bioPtr pkeyPtr cipherPtr nullPtr 0 nullFunPtr nullPtr - failIf (/= 1) ret - return () + failIf_ (/= 1) ret -- |@'writePKCS8PrivateKey'@ writes a private key to PEM string in -- PKCS#8 format. @@ -212,7 +211,7 @@ return pkeyPtr PwTTY -> _read_bio_PrivateKey bioPtr nullPtr nullFunPtr nullPtr - failIfNull pkeyPtr + failIfNull_ pkeyPtr wrapPKeyPtr pkeyPtr >>= fromPKey >>= return . fromJust -- |@'readPrivateKey' pem supply@ reads a private key in PEM string. diff --git a/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc --- a/OpenSSL/RSA.hsc +++ b/OpenSSL/RSA.hsc @@ -34,7 +34,9 @@ import Foreign.C import OpenSSL.BN import OpenSSL.Utils +#if !(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__) import System.IO.Unsafe +#endif -- |@'RSAPubKey'@ is an opaque object that represents RSA public key. newtype RSAPubKey = RSAPubKey (ForeignPtr RSA) @@ -155,7 +157,7 @@ generateRSAKey nbits e Nothing = do ptr <- _generate_key (fromIntegral nbits) (fromIntegral e) nullFunPtr nullPtr - failIfNull ptr + failIfNull_ ptr newForeignPtr _free ptr >>= return . RSAKeyPair generateRSAKey nbits e (Just cb) @@ -163,7 +165,7 @@ $ \ arg1 arg2 _ -> cb arg1 arg2 ptr <- _generate_key (fromIntegral nbits) (fromIntegral e) cbPtr nullPtr freeHaskellFunPtr cbPtr - failIfNull ptr + failIfNull_ ptr newForeignPtr _free ptr >>= return . RSAKeyPair -- |A simplified alternative to 'generateRSAKey' diff --git a/OpenSSL/Random.hsc b/OpenSSL/Random.hsc --- a/OpenSSL/Random.hsc +++ b/OpenSSL/Random.hsc @@ -33,7 +33,7 @@ -> IO BS.ByteString randBytes n = allocaArray n $ \bufPtr -> - do _RAND_bytes bufPtr (fromIntegral n) >>= failIf (/= 1) + do _RAND_bytes bufPtr (fromIntegral n) >>= failIf_ (/= 1) BS.packCStringLen (bufPtr, n) -- | Return a bytestring consisting of the given number of pseudo random diff --git a/OpenSSL/Session.hsc b/OpenSSL/Session.hsc --- a/OpenSSL/Session.hsc +++ b/OpenSSL/Session.hsc @@ -48,13 +48,13 @@ import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as L -import System.IO.Error (mkIOError, ioError, eofErrorType, catch, isEOFError) +import System.IO.Error (mkIOError, ioError, eofErrorType, isEOFError) import System.IO.Unsafe import System.Posix.Types (Fd(..)) import Network.Socket (Socket(..)) import OpenSSL.EVP.PKey -import OpenSSL.Utils (failIfNull, failIf) +import OpenSSL.Utils import OpenSSL.X509 (X509, X509_, wrapX509, withX509Ptr) import OpenSSL.X509.Store @@ -203,9 +203,8 @@ contextSetCAFile :: SSLContext -> FilePath -> IO () contextSetCAFile context path = do withContext context $ \ctx -> - withCString path $ \cpath -> do - _ssl_load_verify_locations ctx cpath nullPtr >>= failIf (/= 1) - return () + withCString path $ \cpath -> + _ssl_load_verify_locations ctx cpath nullPtr >>= failIf_ (/= 1) -- | Set the path to a directory which contains the PEM encoded CA root -- certificates. This is an alternative to 'contextSetCAFile'. See @@ -214,9 +213,8 @@ contextSetCADirectory :: SSLContext -> FilePath -> IO () contextSetCADirectory context path = do withContext context $ \ctx -> - withCString path $ \cpath -> do - _ssl_load_verify_locations ctx nullPtr cpath >>= failIf (/= 1) - return () + withCString path $ \cpath -> + _ssl_load_verify_locations ctx nullPtr cpath >>= failIf_ (/= 1) foreign import ccall unsafe "SSL_CTX_get_cert_store" _ssl_get_cert_store :: Ptr SSLContext_ -> IO (Ptr X509_STORE) diff --git a/OpenSSL/Utils.hs b/OpenSSL/Utils.hs --- a/OpenSSL/Utils.hs +++ b/OpenSSL/Utils.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE CPP #-} module OpenSSL.Utils ( failIfNull + , failIfNull_ , failIf + , failIf_ , raiseOpenSSLError , toHex , fromHex @@ -11,8 +14,10 @@ import Foreign import Foreign.C import OpenSSL.ERR -import Data.Bits ((.&.), (.|.), shiftR, shiftL) import Data.List (unfoldr) +#if !(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__) +import Data.Bits ((.&.), (.|.), shiftR, shiftL) +#endif failIfNull :: Ptr a -> IO (Ptr a) failIfNull ptr @@ -21,11 +26,19 @@ else return ptr +failIfNull_ :: Ptr a -> IO () +failIfNull_ ptr + = failIfNull ptr >> return () failIf :: (a -> Bool) -> a -> IO a failIf f a | f a = raiseOpenSSLError | otherwise = return a + + +failIf_ :: (a -> Bool) -> a -> IO () +failIf_ f a + = failIf f a >> return () raiseOpenSSLError :: IO a diff --git a/OpenSSL/X509.hsc b/OpenSSL/X509.hsc --- a/OpenSSL/X509.hsc +++ b/OpenSSL/X509.hsc @@ -203,7 +203,7 @@ Nothing -> pkeyDefaultMD key withMDPtr digest $ \ digestPtr -> _sign x509Ptr pkeyPtr digestPtr - >>= failIf (== 0) + >>= failIf_ (== 0) return () -- |@'verifyX509'@ verifies a signature of certificate with an issuer @@ -231,7 +231,7 @@ withX509Ptr x509 $ \ x509Ptr -> withBioPtr mem $ \ memPtr -> _print memPtr x509Ptr - >>= failIf (/= 1) + >>= failIf_ (/= 1) bioRead mem -- |@'getVersion' cert@ returns the version number of certificate. It diff --git a/OpenSSL/X509/Request.hsc b/OpenSSL/X509/Request.hsc --- a/OpenSSL/X509/Request.hsc +++ b/OpenSSL/X509/Request.hsc @@ -123,8 +123,7 @@ Nothing -> pkeyDefaultMD pkey withMDPtr digest $ \ digestPtr -> _sign reqPtr pkeyPtr digestPtr - >>= failIf (== 0) - return () + >>= failIf_ (== 0) -- |@'verifyX509Req'@ verifies a signature of certificate request with -- a subject public key. @@ -151,7 +150,7 @@ withBioPtr mem $ \ memPtr -> withX509ReqPtr req $ \ reqPtr -> _print memPtr reqPtr - >>= failIf (/= 1) + >>= failIf_ (/= 1) bioRead mem -- |@'getVersion' req@ returns the version number of certificate diff --git a/OpenSSL/X509/Revocation.hsc b/OpenSSL/X509/Revocation.hsc --- a/OpenSSL/X509/Revocation.hsc +++ b/OpenSSL/X509/Revocation.hsc @@ -176,7 +176,7 @@ Nothing -> pkeyDefaultMD key withMDPtr digest $ \ digestPtr -> _sign crlPtr pkeyPtr digestPtr - >>= failIf (== 0) + >>= failIf_ (== 0) return () -- |@'verifyCRL'@ verifies a signature of revocation list with an @@ -201,7 +201,7 @@ withBioPtr mem $ \ memPtr -> withCRLPtr crl $ \ crlPtr -> _print memPtr crlPtr - >>= failIf (/= 1) + >>= failIf_ (/= 1) bioRead mem -- |@'getVersion' crl@ returns the version number of revocation list.