Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Overhaul for GHC 6.12.1

Ignore-this: f870717e85483d7ef02734b295ad3e76

* Translated Japanese comments to English. The primary purpose of these changes is to work around an hsc2hs bug, but they make no sense for non-Japanese speakers anyway.

* Suppress warnings which GHC 6.12.1 emits.

darcs-hash:20100124114543-62b54-e55df341e4735aa276f5697b70291a2f80764b92.gz
  • Loading branch information...
commit 1aabbfa43432845108549ce532016ec198b8ba1d 1 parent 1e80bf3
@phonohawk authored
View
9 OpenSSL/ASN1.hsc
@@ -21,7 +21,6 @@ module OpenSSL.ASN1
import Control.Exception
-import Control.Monad
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.Format
@@ -86,7 +85,7 @@ peekASN1Integer :: Ptr ASN1_INTEGER -> IO Integer
peekASN1Integer intPtr
= allocaBN $ \ bn ->
do _ASN1_INTEGER_to_BN intPtr (unwrapBN bn)
- >>= failIfNull
+ >>= failIfNull_
peekBN bn
@@ -100,7 +99,7 @@ withASN1Integer int m
= withBN int $ \ bn ->
allocaASN1Integer $ \ intPtr ->
do _BN_to_ASN1_INTEGER (unwrapBN bn) intPtr
- >>= failIfNull
+ >>= failIfNull_
m intPtr
@@ -126,7 +125,7 @@ peekASN1Time time
= 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 :: UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time utc m
= allocaASN1Time $ \ time ->
do _ASN1_TIME_set time (fromIntegral $ (round $ utcTimeToPOSIXSeconds utc :: Integer))
- >>= failIfNull
+ >>= failIfNull_
m time
View
18 OpenSSL/BIO.hsc
@@ -125,10 +125,11 @@ withBioPtr' Nothing f = f nullPtr
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 -> BIO -> IO ()
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 @@ bioFlush bio
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 :: B.ByteString -> IO BIO
newConstMemBS bs
= let (foreignBuf, off, len) = toForeignPtr bs
in
- -- ByteString への參照を BIOfinalizer に持たせる。
+ -- 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
View
16 OpenSSL/BN.hsc
@@ -52,14 +52,14 @@ import Foreign.C
#else
import Foreign.C.Types
import GHC.Base
+#if __GLASGOW_HASKELL__ < 612
import GHC.Num
import GHC.Prim
-#if __GLASGOW_HASKELL__ < 612
import GHC.Integer.Internals
+import GHC.IOBase (IO(..))
#else
import GHC.Integer.GMP.Internals
#endif
-import GHC.IOBase (IO(..))
#endif
-- |'BigNum' is an opaque object representing a big number.
@@ -177,8 +177,8 @@ bnToInteger bn = do
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)
@@ -269,7 +269,7 @@ bnToMPI :: BigNum -> IO BS.ByteString
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
@@ -313,7 +313,7 @@ modexp a p m = unsafePerformIO (do
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 ------------------------------------------------ -}
@@ -332,7 +332,7 @@ randIntegerUptoNMinusOneSuchThat :: (Integer -> Bool) -- ^ a filter function
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
@@ -347,7 +347,7 @@ prandIntegerUptoNMinusOneSuchThat :: (Integer -> Bool) -- ^ a filter function
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
View
4 OpenSSL/Cipher.hsc
@@ -75,8 +75,8 @@ newAESCtx mode key iv = do
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
View
8 OpenSSL/DSA.hsc
@@ -39,7 +39,9 @@ import Foreign.C (CString)
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 @@ generateDSAParameters nbits mseed = do
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 @@ generateDSAParametersAndKey nbits mseed = do
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 @@ signDigestedDataWithDSA dsa bytes = do
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
View
12 OpenSSL/EVP/Base64.hsc
@@ -26,11 +26,13 @@ import Foreign
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 @@ encodeBase64LBS inLBS
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'
View
2  OpenSSL/EVP/Cipher.hsc
@@ -142,7 +142,7 @@ cipherInit (Cipher c) key iv mode
withCString key $ \ keyPtr ->
withCString iv $ \ ivPtr ->
_CipherInit ctxPtr c keyPtr ivPtr (cryptoModeToInt mode)
- >>= failIf (/= 1)
+ >>= failIf_ (/= 1)
return ctx
View
13 OpenSSL/EVP/Digest.hsc
@@ -116,7 +116,7 @@ digestInit :: Digest -> IO DigestCtx
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 @@ digestFinal ctx
= 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 @@ digestFinalBS ctx =
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 @@ pkcs5_pbkdf2_hmac_sha1 pass salt iter dkeylen =
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
View
3  OpenSSL/EVP/Open.hsc
@@ -10,7 +10,6 @@ module OpenSSL.EVP.Open
)
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 @@ openInit cipher encKey iv pkey
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
View
4 OpenSSL/EVP/PKey.hsc
@@ -217,7 +217,7 @@ rsaToPKey :: RSAKey k => k -> IO VaguePKey
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 :: DSAKey k => k -> IO VaguePKey
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)
View
23 OpenSSL/EVP/Seal.hsc
@@ -10,7 +10,6 @@ module OpenSSL.EVP.Seal
)
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 _ []
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 @@ sealInit cipher pubKeys
free pubKeysPtr
mapM_ touchPKey pkeys
- -- いよいよ EVP_SealInit を呼ぶ。
+ -- Call EVP_SealInit finally.
ret <- withCipherCtxPtr ctx $ \ ctxPtr ->
_SealInit ctxPtr cipher encKeyBufsPtr encKeyBufsLenPtr ivPtr pubKeysPtr (fromIntegral nKeys)
View
2  OpenSSL/EVP/Sign.hsc
@@ -32,7 +32,7 @@ signFinal ctx k
allocaArray maxLen $ \ bufPtr ->
alloca $ \ bufLenPtr ->
do _SignFinal ctxPtr bufPtr bufLenPtr pkeyPtr
- >>= failIf (/= 1)
+ >>= failIf_ (/= 1)
bufLen <- liftM fromIntegral $ peek bufLenPtr
peekCStringLen (bufPtr, bufLen)
View
1  OpenSSL/EVP/Verify.hsc
@@ -11,7 +11,6 @@ module OpenSSL.EVP.Verify
)
where
-import Control.Monad
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.Typeable
View
5 OpenSSL/PEM.hsc
@@ -162,8 +162,7 @@ writePKCS8PrivateKey' bio key encryption
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 @@ readPrivateKey' bio supply
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.
View
6 OpenSSL/RSA.hsc
@@ -34,7 +34,9 @@ import Foreign
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 :: Int -- ^ The number of bits of the public modulus
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 @@ generateRSAKey nbits e (Just cb)
$ \ 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'
View
2  OpenSSL/Random.hsc
@@ -33,7 +33,7 @@ randBytes :: Int -- ^ the number of bytes requested
-> 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
View
14 OpenSSL/Session.hsc
@@ -48,13 +48,13 @@ import qualified Data.ByteString.Internal as B
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 @@ foreign import ccall unsafe "SSL_CTX_load_verify_locations"
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 @@ contextSetCAFile context path = do
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)
View
15 OpenSSL/Utils.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE CPP #-}
module OpenSSL.Utils
( failIfNull
+ , failIfNull_
, failIf
+ , failIf_
, raiseOpenSSLError
, toHex
, fromHex
@@ -11,8 +14,10 @@ module OpenSSL.Utils
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,6 +26,9 @@ failIfNull ptr
else
return ptr
+failIfNull_ :: Ptr a -> IO ()
+failIfNull_ ptr
+ = failIfNull ptr >> return ()
failIf :: (a -> Bool) -> a -> IO a
failIf f a
@@ -28,6 +36,11 @@ failIf f a
| otherwise = return a
+failIf_ :: (a -> Bool) -> a -> IO ()
+failIf_ f a
+ = failIf f a >> return ()
+
+
raiseOpenSSLError :: IO a
raiseOpenSSLError = getError >>= errorString >>= fail
View
4 OpenSSL/X509.hsc
@@ -203,7 +203,7 @@ signX509 x509 key mDigest
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 @@ printX509 x509
withX509Ptr x509 $ \ x509Ptr ->
withBioPtr mem $ \ memPtr ->
_print memPtr x509Ptr
- >>= failIf (/= 1)
+ >>= failIf_ (/= 1)
bioRead mem
-- |@'getVersion' cert@ returns the version number of certificate. It
View
5 OpenSSL/X509/Request.hsc
@@ -123,8 +123,7 @@ signX509Req req pkey mDigest
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 @@ printX509Req req
withBioPtr mem $ \ memPtr ->
withX509ReqPtr req $ \ reqPtr ->
_print memPtr reqPtr
- >>= failIf (/= 1)
+ >>= failIf_ (/= 1)
bioRead mem
-- |@'getVersion' req@ returns the version number of certificate
View
4 OpenSSL/X509/Revocation.hsc
@@ -176,7 +176,7 @@ signCRL crl key mDigest
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 @@ printCRL crl
withBioPtr mem $ \ memPtr ->
withCRLPtr crl $ \ crlPtr ->
_print memPtr crlPtr
- >>= failIf (/= 1)
+ >>= failIf_ (/= 1)
bioRead mem
-- |@'getVersion' crl@ returns the version number of revocation list.
Please sign in to comment.
Something went wrong with that request. Please try again.