Skip to content
Browse files

Cosmetic changes suggested by hlint.

Ignore-this: 559b7ed22eed958a551c5ff2e45f7d45

darcs-hash:20100208161936-62b54-98ba470151d95547710165407d37848902960576.gz
  • Loading branch information...
1 parent 231b6c8 commit be44eaae669049b4c8baa4b9cf3f7f96896f1216 @phonohawk committed
View
10 OpenSSL/ASN1.hsc
@@ -90,8 +90,8 @@ peekASN1Integer intPtr
allocaASN1Integer :: (Ptr ASN1_INTEGER -> IO a) -> IO a
-allocaASN1Integer m
- = bracket _ASN1_INTEGER_new _ASN1_INTEGER_free m
+allocaASN1Integer
+ = bracket _ASN1_INTEGER_new _ASN1_INTEGER_free
withASN1Integer :: Integer -> (Ptr ASN1_INTEGER -> IO a) -> IO a
@@ -149,13 +149,13 @@ peekASN1Time time
allocaASN1Time :: (Ptr ASN1_TIME -> IO a) -> IO a
-allocaASN1Time m
- = bracket _ASN1_TIME_new _ASN1_TIME_free m
+allocaASN1Time
+ = bracket _ASN1_TIME_new _ASN1_TIME_free
withASN1Time :: UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time utc m
= allocaASN1Time $ \ time ->
- do _ASN1_TIME_set time (fromIntegral $ (round $ utcTimeToPOSIXSeconds utc :: Integer))
+ do _ASN1_TIME_set time (fromIntegral (round $ utcTimeToPOSIXSeconds utc :: Integer))
>>= failIfNull_
m time
View
13 OpenSSL/BIO.hsc
@@ -113,7 +113,8 @@ new method
wrapBioPtr :: Ptr BIO_ -> IO BIO
-wrapBioPtr bioPtr = Conc.newForeignPtr bioPtr (_free bioPtr) >>= return . BIO
+wrapBioPtr bioPtr
+ = fmap BIO (Conc.newForeignPtr bioPtr (_free bioPtr))
withBioPtr :: BIO -> (Ptr BIO_ -> IO a) -> IO a
@@ -174,13 +175,13 @@ bioJoin (a:b:xs) = bioPush a b >> bioJoin (b:xs)
setFlags :: BIO -> CInt -> IO ()
setFlags bio flags
- = withBioPtr bio $ \ bioPtr ->
- _set_flags bioPtr flags
+ = withBioPtr bio $ flip _set_flags flags
+
bioShouldRetry :: BIO -> IO Bool
bioShouldRetry bio
= withBioPtr bio $ \ bioPtr ->
- _should_retry bioPtr >>= return . (/= 0)
+ fmap (/= 0) (_should_retry bioPtr)
{- ctrl --------------------------------------------------------------------- -}
@@ -215,7 +216,7 @@ bioReset bio
bioEOF :: BIO -> IO Bool
bioEOF bio
= withBioPtr bio $ \ bioPtr ->
- _eof bioPtr >>= return . (== 1)
+ fmap (==1) (_eof bioPtr)
{- I/O ---------------------------------------------------------------------- -}
@@ -253,7 +254,7 @@ bioReadBS bio maxLen
-- |@'bioReadLBS' bio@ lazily reads all data in @bio@, then return a
-- LazyByteString.
bioReadLBS :: BIO -> IO L.ByteString
-bioReadLBS bio = lazyRead >>= return . L.fromChunks
+bioReadLBS bio = fmap L.fromChunks lazyRead
where
chunkSize = L.defaultChunkSize
View
6 OpenSSL/Cipher.hsc
@@ -20,7 +20,7 @@ module OpenSSL.Cipher
, aesCTR)
where
-import Control.Monad (when)
+import Control.Monad (when, unless)
import Data.IORef
import Foreign
import Foreign.C.Types
@@ -69,7 +69,7 @@ newAESCtx :: Mode -- ^ For CTR mode, this must always be Encrypt
-> IO AESCtx
newAESCtx mode key iv = do
let keyLen = BS.length key * 8
- when (not $ any ((==) keyLen) [128, 192, 256]) $ fail "Bad AES key length"
+ unless (any (keyLen ==) [128, 192, 256]) $ fail "Bad AES key length"
when (BS.length iv /= 16) $ fail "Bad AES128 iv length"
ctx <- mallocForeignPtrBytes (#size AES_KEY)
withForeignPtr ctx $ \ctxPtr ->
@@ -105,7 +105,7 @@ aesCTR :: AESCtx -- ^ context
-> BS.ByteString -- ^ input, any number of bytes
-> IO BS.ByteString
aesCTR (AESCtx _ _ _ _ Decrypt) _ = fail "the context mode must be Encrypt"
-aesCTR (AESCtx ctx iv ecounter nref Encrypt) input = do
+aesCTR (AESCtx ctx iv ecounter nref Encrypt) input =
withForeignPtr ctx $ \ctxPtr ->
withForeignPtr iv $ \ivPtr ->
withForeignPtr ecounter $ \ecptr ->
View
67 OpenSSL/DSA.hsc
@@ -62,7 +62,7 @@ class DSAKey k where
dsaSize dsa
= unsafePerformIO $
withDSAPtr dsa $ \ dsaPtr ->
- _size dsaPtr >>= return . fromIntegral
+ fmap fromIntegral (_size dsaPtr)
-- |Return the public prime number of the key.
dsaP :: k -> Integer
@@ -89,7 +89,7 @@ class DSAKey k where
instance DSAKey DSAPubKey where
withDSAPtr (DSAPubKey fp) = withForeignPtr fp
peekDSAPtr dsaPtr = _pubDup dsaPtr >>= absorbDSAPtr
- absorbDSAPtr dsaPtr = newForeignPtr _free dsaPtr >>= return . Just . DSAPubKey
+ absorbDSAPtr dsaPtr = fmap (Just . DSAPubKey) (newForeignPtr _free dsaPtr)
instance DSAKey DSAKeyPair where
@@ -103,14 +103,14 @@ instance DSAKey DSAKeyPair where
absorbDSAPtr dsaPtr
= do hasP <- hasDSAPrivateKey dsaPtr
if hasP then
- newForeignPtr _free dsaPtr >>= return . Just . DSAKeyPair
+ fmap (Just . DSAKeyPair) (newForeignPtr _free dsaPtr)
else
return Nothing
hasDSAPrivateKey :: Ptr DSA -> IO Bool
hasDSAPrivateKey dsaPtr
- = (#peek DSA, priv_key) dsaPtr >>= return . (/= nullPtr)
+ = fmap (/= nullPtr) ((#peek DSA, priv_key) dsaPtr)
foreign import ccall unsafe "&DSA_free"
@@ -162,8 +162,8 @@ generateDSAParameters :: Int -- ^ The number of bits in the generated prime: 51
-> IO (Int, Int, Integer, Integer, Integer) -- ^ (iteration count, generator count, p, q, g)
generateDSAParameters nbits mseed = do
when (nbits < 512 || nbits > 1024) $ fail "Invalid DSA bit size"
- alloca (\i1 -> do
- alloca (\i2 -> do
+ alloca (\i1 ->
+ alloca (\i2 ->
(\x -> case mseed of
Nothing -> x (nullPtr, 0)
Just seed -> BS.useAsCStringLen seed x) (\(seedptr, seedlen) -> do
@@ -204,11 +204,11 @@ generateDSAKey :: Integer -- ^ p
-> IO DSAKeyPair
generateDSAKey p q g = do
ptr <- _dsa_new
- newBN p >>= return . unwrapBN >>= (#poke DSA, p) ptr
- newBN q >>= return . unwrapBN >>= (#poke DSA, q) ptr
- newBN g >>= return . unwrapBN >>= (#poke DSA, g) ptr
+ fmap unwrapBN (newBN p) >>= (#poke DSA, p) ptr
+ fmap unwrapBN (newBN q) >>= (#poke DSA, q) ptr
+ fmap unwrapBN (newBN g) >>= (#poke DSA, g) ptr
_dsa_generate_key ptr
- newForeignPtr _free ptr >>= return . DSAKeyPair
+ fmap DSAKeyPair (newForeignPtr _free ptr)
-- |Return the private key @x@.
dsaPrivate :: DSAKeyPair -> Integer
@@ -242,47 +242,47 @@ dsaKeyPairToTuple dsa
tupleToDSAPubKey :: (Integer, Integer, Integer, Integer) -> DSAPubKey
tupleToDSAPubKey (p, q, g, pub) = unsafePerformIO $ do
ptr <- _dsa_new
- newBN p >>= return . unwrapBN >>= (#poke DSA, p) ptr
- newBN q >>= return . unwrapBN >>= (#poke DSA, q) ptr
- newBN g >>= return . unwrapBN >>= (#poke DSA, g) ptr
- newBN pub >>= return . unwrapBN >>= (#poke DSA, pub_key) ptr
+ fmap unwrapBN (newBN p ) >>= (#poke DSA, p) ptr
+ fmap unwrapBN (newBN q ) >>= (#poke DSA, q) ptr
+ fmap unwrapBN (newBN g ) >>= (#poke DSA, g) ptr
+ fmap unwrapBN (newBN pub) >>= (#poke DSA, pub_key) ptr
(#poke DSA, priv_key) ptr nullPtr
- newForeignPtr _free ptr >>= return . DSAPubKey
+ fmap DSAPubKey (newForeignPtr _free ptr)
-- | Convert a tuple of members (in the same format as from
-- 'dsaPubKeyToTuple') into a DSAPubKey object
tupleToDSAKeyPair :: (Integer, Integer, Integer, Integer, Integer) -> DSAKeyPair
tupleToDSAKeyPair (p, q, g, pub, pri) = unsafePerformIO $ do
ptr <- _dsa_new
- newBN p >>= return . unwrapBN >>= (#poke DSA, p) ptr
- newBN q >>= return . unwrapBN >>= (#poke DSA, q) ptr
- newBN g >>= return . unwrapBN >>= (#poke DSA, g) ptr
- newBN pub >>= return . unwrapBN >>= (#poke DSA, pub_key ) ptr
- newBN pri >>= return . unwrapBN >>= (#poke DSA, priv_key) ptr
- newForeignPtr _free ptr >>= return . DSAKeyPair
+ fmap unwrapBN (newBN p ) >>= (#poke DSA, p) ptr
+ fmap unwrapBN (newBN q ) >>= (#poke DSA, q) ptr
+ fmap unwrapBN (newBN g ) >>= (#poke DSA, g) ptr
+ fmap unwrapBN (newBN pub) >>= (#poke DSA, pub_key ) ptr
+ fmap unwrapBN (newBN pri) >>= (#poke DSA, priv_key) ptr
+ fmap DSAKeyPair (newForeignPtr _free ptr)
-- | A utility function to generate both the parameters and the key pair at the
-- same time. Saves serialising and deserialising the parameters too
generateDSAParametersAndKey :: Int -- ^ The number of bits in the generated prime: 512 <= x <= 1024
-> Maybe BS.ByteString -- ^ optional seed, its length must be 20 bytes
-> IO DSAKeyPair
-generateDSAParametersAndKey nbits mseed = do
+generateDSAParametersAndKey nbits mseed =
(\x -> case mseed of
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
_dsa_generate_key ptr
- newForeignPtr _free ptr >>= return . DSAKeyPair)
+ fmap DSAKeyPair (newForeignPtr _free ptr))
-- | Sign pre-digested data. The DSA specs call for SHA1 to be used so, if you
-- use anything else, YMMV. Returns a pair of Integers which, together, are
-- the signature
signDigestedDataWithDSA :: DSAKeyPair -> BS.ByteString -> IO (Integer, Integer)
-signDigestedDataWithDSA dsa bytes = do
- BS.useAsCStringLen bytes (\(ptr, len) -> do
- alloca (\rptr -> do
- alloca (\sptr -> do
+signDigestedDataWithDSA dsa bytes =
+ BS.useAsCStringLen bytes (\(ptr, len) ->
+ alloca (\rptr ->
+ alloca (\sptr ->
withDSAPtr dsa (\dsaptr -> do
_dsa_sign dsaptr ptr (fromIntegral len) rptr sptr >>= failIf_ (== 0)
r <- peek rptr >>= peekBN . wrapBN
@@ -293,12 +293,13 @@ signDigestedDataWithDSA dsa bytes = do
-- | Verify pre-digested data given a signature.
verifyDigestedDataWithDSA :: DSAKey k => k -> BS.ByteString -> (Integer, Integer) -> IO Bool
-verifyDigestedDataWithDSA dsa bytes (r, s) = do
- BS.useAsCStringLen bytes (\(ptr, len) -> do
- withBN r (\bnR -> do
- withBN s (\bnS -> do
- withDSAPtr dsa (\dsaptr -> do
- _dsa_verify dsaptr ptr (fromIntegral len) (unwrapBN bnR) (unwrapBN bnS) >>= return . (== 1)))))
+verifyDigestedDataWithDSA dsa bytes (r, s) =
+ BS.useAsCStringLen bytes (\(ptr, len) ->
+ withBN r (\bnR ->
+ withBN s (\bnS ->
+ withDSAPtr dsa (\dsaptr ->
+ fmap (== 1)
+ (_dsa_verify dsaptr ptr (fromIntegral len) (unwrapBN bnR) (unwrapBN bnS))))))
instance Eq DSAPubKey where
View
4 OpenSSL/ERR.hsc
@@ -21,11 +21,11 @@ foreign import ccall unsafe "ERR_error_string"
getError :: IO Integer
-getError = _get_error >>= return . fromIntegral
+getError = fmap fromIntegral _get_error
peekError :: IO Integer
-peekError = _peek_error >>= return . fromIntegral
+peekError = fmap fromIntegral _peek_error
errorString :: Integer -> IO String
View
3 OpenSSL/EVP/Base64.hsc
@@ -54,7 +54,8 @@ encodeBlock inBS
= unsafePerformIO $
unsafeUseAsCStringLen inBS $ \ (inBuf, inLen) ->
createAndTrim maxOutLen $ \ outBuf ->
- _EncodeBlock (castPtr outBuf) inBuf (fromIntegral inLen) >>= return . fromIntegral
+ fmap fromIntegral
+ (_EncodeBlock (castPtr outBuf) inBuf (fromIntegral inLen))
where
maxOutLen = (inputLen `div` 3 + 1) * 4 + 1 -- +1: '\0'
inputLen = B8.length inBS
View
13 OpenSSL/EVP/Cipher.hsc
@@ -109,8 +109,7 @@ foreign import ccall unsafe "HsOpenSSL_EVP_CIPHER_CTX_block_size"
newCtx :: IO CipherCtx
newCtx = do ctx <- mallocForeignPtrBytes (#size EVP_CIPHER_CTX)
- withForeignPtr ctx $ \ ctxPtr ->
- _ctx_init ctxPtr
+ withForeignPtr ctx _ctx_init
addForeignPtrFinalizer _ctx_cleanup ctx
return $ CipherCtx ctx
@@ -157,11 +156,11 @@ cipherStrictLBS :: Cipher -- ^ Cipher
-> CryptoMode -- ^ Encrypt\/Decrypt
-> L8.ByteString -- ^ Input
-> IO L8.ByteString
-cipherStrictLBS (Cipher c) key iv mode input = do
- allocaBytes (#size EVP_CIPHER_CTX) $ \cptr -> do
- bracket_ (_ctx_init cptr) (_ctx_cleanup' cptr) $ do
- unsafeUseAsCStringLen key $ \(keyp,_) -> do
- unsafeUseAsCStringLen iv $ \(ivp, _) -> do
+cipherStrictLBS (Cipher c) key iv mode input =
+ allocaBytes (#size EVP_CIPHER_CTX) $ \cptr ->
+ bracket_ (_ctx_init cptr) (_ctx_cleanup' cptr) $
+ unsafeUseAsCStringLen key $ \(keyp,_) ->
+ unsafeUseAsCStringLen iv $ \(ivp, _) -> do
failIf_ (/= 1) =<< _CipherInit cptr c keyp ivp (cryptoModeToInt mode)
cc <- fmap CipherCtx (newForeignPtr_ cptr)
rr <- cipherUpdateBS cc `mapM` L8.toChunks input
View
18 OpenSSL/EVP/Digest.hsc
@@ -90,8 +90,7 @@ foreign import ccall unsafe "&EVP_MD_CTX_cleanup"
newCtx :: IO DigestCtx
newCtx = do ctx <- mallocForeignPtrBytes (#size EVP_MD_CTX)
- withForeignPtr ctx $ \ ctxPtr ->
- _ctx_init ctxPtr
+ withForeignPtr ctx _ctx_init
addForeignPtrFinalizer _ctx_cleanup ctx
return $ DigestCtx ctx
@@ -168,22 +167,19 @@ digest md input
-- |@'digestBS'@ digests a chunk of data.
digestBS :: Digest -> B8.ByteString -> String
digestBS md input
- = unsafePerformIO $
- do ctx <- digestStrictly md input
- digestFinal ctx
+ = unsafePerformIO
+ (digestStrictly md input >>= digestFinal)
digestBS' :: Digest -> B8.ByteString -> B8.ByteString
digestBS' md input
- = unsafePerformIO $
- do ctx <- digestStrictly md input
- digestFinalBS ctx
+ = unsafePerformIO
+ (digestStrictly md input >>= digestFinalBS)
-- |@'digestLBS'@ digests a stream of data.
digestLBS :: Digest -> L8.ByteString -> String
digestLBS md input
- = unsafePerformIO $
- do ctx <- digestLazily md input
- digestFinal ctx
+ = unsafePerformIO
+ (digestLazily md input >>= digestFinal)
{- HMAC ---------------------------------------------------------------------- -}
View
12 OpenSSL/EVP/PKey.hsc
@@ -183,8 +183,8 @@ foreign import ccall unsafe "&EVP_PKEY_free"
wrapPKeyPtr :: Ptr EVP_PKEY -> IO VaguePKey
-wrapPKeyPtr ptr
- = newForeignPtr _pkey_free ptr >>= return . VaguePKey
+wrapPKeyPtr
+ = fmap VaguePKey . newForeignPtr _pkey_free
withPKeyPtr' :: PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
@@ -226,9 +226,7 @@ rsaFromPKey pk
do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt
case pkeyType of
(#const EVP_PKEY_RSA)
- -> do rsaPtr <- _get1_RSA pkeyPtr
- rsaM <- absorbRSAPtr rsaPtr
- return rsaM
+ -> _get1_RSA pkeyPtr >>= absorbRSAPtr
_ -> return Nothing
instance PublicKey RSAPubKey
@@ -268,9 +266,7 @@ dsaFromPKey pk
do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt
case pkeyType of
(#const EVP_PKEY_DSA)
- -> do dsaPtr <- _get1_DSA pkeyPtr
- dsaM <- absorbDSAPtr dsaPtr
- return dsaM
+ -> _get1_DSA pkeyPtr >>= absorbDSAPtr
_ -> return Nothing
instance PublicKey DSAPubKey
View
3 OpenSSL/Objects.hsc
@@ -52,8 +52,7 @@ iterateObjNames nameType wantSorted cb
objNameStr :: ObjName -> IO String
objNameStr name
- = do strPtr <- (#peek OBJ_NAME, name) name
- peekCString strPtr
+ = (#peek OBJ_NAME, name) name >>= peekCString
getObjNames :: ObjNameType -> Bool -> IO [String]
View
17 OpenSSL/PEM.hsc
@@ -200,8 +200,8 @@ readPrivateKey' bio supply
-> withCString "" $ \ strPtr ->
_read_bio_PrivateKey bioPtr nullPtr nullFunPtr (castPtr strPtr)
PwStr passStr
- -> withCString passStr $ \passPtr ->
- _read_bio_PrivateKey bioPtr nullPtr nullFunPtr passPtr
+ -> withCString passStr $
+ _read_bio_PrivateKey bioPtr nullPtr nullFunPtr
PwBS passStr
-> withBS passStr $ \(passPtr,_) ->
_read_bio_PrivateKey bioPtr nullPtr nullFunPtr passPtr
@@ -211,7 +211,7 @@ readPrivateKey' bio supply
PwTTY
-> _read_bio_PrivateKey bioPtr nullPtr nullFunPtr nullPtr
failIfNull_ pkeyPtr
- wrapPKeyPtr pkeyPtr >>= fromPKey >>= return . fromJust
+ fmap fromJust (wrapPKeyPtr pkeyPtr >>= fromPKey)
-- |@'readPrivateKey' pem supply@ reads a private key in PEM string.
readPrivateKey :: String -> PemPasswordSupply -> IO SomeKeyPair
@@ -252,11 +252,12 @@ readPublicKey' :: BIO -> IO SomePublicKey
readPublicKey' bio
= withBioPtr bio $ \ bioPtr ->
withCString "" $ \ passPtr ->
- _read_bio_PUBKEY bioPtr nullPtr nullFunPtr (castPtr passPtr)
- >>= failIfNull
- >>= wrapPKeyPtr
- >>= fromPKey
- >>= return . fromJust
+ fmap fromJust
+ ( _read_bio_PUBKEY bioPtr nullPtr nullFunPtr (castPtr passPtr)
+ >>= failIfNull
+ >>= wrapPKeyPtr
+ >>= fromPKey
+ )
-- |@'readPublicKey' pem@ reads a public key in PEM string.
readPublicKey :: String -> IO SomePublicKey
View
9 OpenSSL/PKCS7.hsc
@@ -115,7 +115,7 @@ foreign import ccall "PKCS7_decrypt"
wrapPkcs7Ptr :: Ptr PKCS7 -> IO Pkcs7
-wrapPkcs7Ptr p7Ptr = newForeignPtr _free p7Ptr >>= return . Pkcs7
+wrapPkcs7Ptr = fmap Pkcs7 . newForeignPtr _free
withPkcs7Ptr :: Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
@@ -125,8 +125,7 @@ withPkcs7Ptr (Pkcs7 pkcs7) = withForeignPtr pkcs7
isDetachedSignature :: Pkcs7 -> IO Bool
isDetachedSignature pkcs7
= withPkcs7Ptr pkcs7 $ \ pkcs7Ptr ->
- _is_detached pkcs7Ptr
- >>= return . (== 1)
+ fmap (== 1) (_is_detached pkcs7Ptr)
pkcs7Sign' :: KeyPair key => X509 -> key -> [X509] -> BIO -> [Pkcs7Flag] -> IO Pkcs7
@@ -213,7 +212,7 @@ pkcs7Verify' pkcs7 certs store inData flagList
outData <- if isDetached then
return Nothing
else
- newMem >>= return . Just
+ fmap Just newMem
withBioPtr' outData $ \ outDataPtr ->
_verify pkcs7Ptr certStack storePtr inDataPtr outDataPtr (flagListToInt flagList)
>>= interpret outData
@@ -416,6 +415,6 @@ readSmime' inBio
outBio <- if outBioPtr == nullPtr then
return Nothing
else
- wrapBioPtr outBioPtr >>= return . Just
+ fmap Just (wrapBioPtr outBioPtr)
return (pkcs7, outBio)
View
12 OpenSSL/RSA.hsc
@@ -59,7 +59,7 @@ class RSAKey k where
rsaSize rsa
= unsafePerformIO $
withRSAPtr rsa $ \ rsaPtr ->
- _size rsaPtr >>= return . fromIntegral
+ fmap fromIntegral (_size rsaPtr)
-- |@'rsaN' key@ returns the public modulus of the key.
rsaN :: k -> Integer
@@ -78,7 +78,7 @@ class RSAKey k where
instance RSAKey RSAPubKey where
withRSAPtr (RSAPubKey fp) = withForeignPtr fp
peekRSAPtr rsaPtr = _pubDup rsaPtr >>= absorbRSAPtr
- absorbRSAPtr rsaPtr = newForeignPtr _free rsaPtr >>= return . Just . RSAPubKey
+ absorbRSAPtr rsaPtr = fmap (Just . RSAPubKey) (newForeignPtr _free rsaPtr)
instance RSAKey RSAKeyPair where
@@ -92,7 +92,7 @@ instance RSAKey RSAKeyPair where
absorbRSAPtr rsaPtr
= do hasP <- hasRSAPrivateKey rsaPtr
if hasP then
- newForeignPtr _free rsaPtr >>= return . Just . RSAKeyPair
+ fmap (Just . RSAKeyPair) (newForeignPtr _free rsaPtr)
else
return Nothing
@@ -167,7 +167,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
- newForeignPtr _free ptr >>= return . RSAKeyPair
+ fmap RSAKeyPair (newForeignPtr _free ptr)
generateRSAKey nbits e (Just cb)
= do cbPtr <- mkGenKeyCallback
@@ -175,7 +175,7 @@ generateRSAKey nbits e (Just cb)
ptr <- _generate_key (fromIntegral nbits) (fromIntegral e) cbPtr nullPtr
freeHaskellFunPtr cbPtr
failIfNull_ ptr
- newForeignPtr _free ptr >>= return . RSAKeyPair
+ fmap RSAKeyPair (newForeignPtr _free ptr)
-- |A simplified alternative to 'generateRSAKey'
generateRSAKey' :: Int -- ^ The number of bits of the public modulus
@@ -206,7 +206,7 @@ peekMI peeker rsa
if bn == nullPtr then
return Nothing
else
- peekBN (wrapBN bn) >>= return . Just
+ fmap Just (peekBN (wrapBN bn))
-- |@'rsaD' privKey@ returns the private exponent of the key.
rsaD :: RSAKeyPair -> Integer
View
38 OpenSSL/Session.hsc
@@ -41,6 +41,7 @@ import Prelude hiding (read, ioError)
import Control.Concurrent (threadWaitWrite, threadWaitRead)
import Control.Concurrent.QSem
import Control.Exception (finally)
+import Control.Monad
import Foreign
import Foreign.C
import qualified Data.ByteString as B
@@ -101,9 +102,8 @@ contextLoadFile f context path =
withContext context $ \ctx ->
withCString path $ \cpath -> do
result <- f ctx cpath (#const SSL_FILETYPE_PEM)
- if result == 1
- then return ()
- else f ctx cpath (#const SSL_FILETYPE_ASN1) >>= failIf (/= 1) >> return ()
+ unless (result == 1)
+ $ f ctx cpath (#const SSL_FILETYPE_ASN1) >>= failIf_ (/= 1)
foreign import ccall unsafe "SSL_CTX_use_PrivateKey"
_ssl_ctx_use_privatekey :: Ptr SSLContext_ -> Ptr EVP_PKEY -> IO CInt
@@ -116,8 +116,7 @@ contextSetPrivateKey context key
= withContext context $ \ ctx ->
withPKeyPtr' key $ \ keyPtr ->
_ssl_ctx_use_privatekey ctx keyPtr
- >>= failIf (/= 1)
- >> return ()
+ >>= failIf_ (/= 1)
-- | Install a certificate (public key) into a context.
contextSetCertificate :: SSLContext -> X509 -> IO ()
@@ -125,8 +124,7 @@ contextSetCertificate context cert
= withContext context $ \ ctx ->
withX509Ptr cert $ \ certPtr ->
_ssl_ctx_use_certificate ctx certPtr
- >>= failIf (/= 1)
- >> return ()
+ >>= failIf_ (/= 1)
foreign import ccall unsafe "SSL_CTX_use_PrivateKey_file"
_ssl_ctx_use_privatekey_file :: Ptr SSLContext_ -> CString -> CInt -> IO CInt
@@ -158,7 +156,7 @@ contextSetCiphers :: SSLContext -> String -> IO ()
contextSetCiphers context list =
withContext context $ \ctx ->
withCString list $ \cpath ->
- _ssl_ctx_set_cipher_list ctx cpath >>= failIf (/= 1) >> return ()
+ _ssl_ctx_set_cipher_list ctx cpath >>= failIf_ (/= 1)
contextSetDefaultCiphers :: SSLContext -> IO ()
contextSetDefaultCiphers = flip contextSetCiphers "DEFAULT"
@@ -171,7 +169,7 @@ foreign import ccall unsafe "SSL_CTX_check_private_key"
contextCheckPrivateKey :: SSLContext -> IO Bool
contextCheckPrivateKey context =
withContext context $ \ctx ->
- _ssl_ctx_check_private_key ctx >>= return . (==) 1
+ fmap (== 1) (_ssl_ctx_check_private_key ctx)
-- | See <http://www.openssl.org/docs/ssl/SSL_CTX_set_verify.html>
data VerificationMode = VerifyNone
@@ -184,7 +182,7 @@ foreign import ccall unsafe "SSL_CTX_set_verify"
_ssl_set_verify_mode :: Ptr SSLContext_ -> CInt -> Ptr () -> IO ()
contextSetVerificationMode :: SSLContext -> VerificationMode -> IO ()
-contextSetVerificationMode context VerifyNone = do
+contextSetVerificationMode context VerifyNone =
withContext context $ \ctx ->
_ssl_set_verify_mode ctx (#const SSL_VERIFY_NONE) nullPtr >> return ()
@@ -201,7 +199,7 @@ foreign import ccall unsafe "SSL_CTX_load_verify_locations"
-- | Set the location of a PEM encoded list of CA certificates to be used when
-- verifying a server's certificate
contextSetCAFile :: SSLContext -> FilePath -> IO ()
-contextSetCAFile context path = do
+contextSetCAFile context path =
withContext context $ \ctx ->
withCString path $ \cpath ->
_ssl_load_verify_locations ctx cpath nullPtr >>= failIf_ (/= 1)
@@ -211,7 +209,7 @@ contextSetCAFile context path = do
-- <http://www.openssl.org/docs/ssl/SSL_CTX_load_verify_locations.html> for
-- details of the file naming scheme
contextSetCADirectory :: SSLContext -> FilePath -> IO ()
-contextSetCADirectory context path = do
+contextSetCADirectory context path =
withContext context $ \ctx ->
withCString path $ \cpath ->
_ssl_load_verify_locations ctx nullPtr cpath >>= failIf_ (/= 1)
@@ -312,11 +310,11 @@ sslDoHandshake action ssl@(SSL (_, _, fd, _)) = do
-- | Perform an SSL server handshake
accept :: SSL -> IO ()
-accept ssl = sslDoHandshake _ssl_accept ssl >>= failIf (/= 1) >> return ()
+accept ssl = sslDoHandshake _ssl_accept ssl >>= failIf_ (/= 1)
-- | Perform an SSL client handshake
connect :: SSL -> IO ()
-connect ssl = sslDoHandshake _ssl_connect ssl >>= failIf (/= 1) >> return ()
+connect ssl = sslDoHandshake _ssl_connect ssl >>= failIf_ (/= 1)
foreign import ccall "SSL_read" _ssl_read :: Ptr SSL_ -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "SSL_get_shutdown" _ssl_get_shutdown :: Ptr SSL_ -> IO CInt
@@ -386,7 +384,7 @@ write ssl@(SSL (_, _, fd, _)) bs = B.unsafeUseAsCStringLen bs $ f ssl where
-- | Lazily read all data until reaching EOF. If the connection dies
-- without a graceful SSL shutdown, an exception is raised.
lazyRead :: SSL -> IO L.ByteString
-lazyRead ssl = lazyRead' >>= return . L.fromChunks
+lazyRead ssl = fmap L.fromChunks lazyRead'
where
chunkSize = L.defaultChunkSize
@@ -424,10 +422,8 @@ shutdown ssl ty = do
n <- sslDoHandshake _ssl_shutdown ssl
case ty of
Unidirectional -> return ()
- Bidirectional -> do
- if n == 1
- then return ()
- else shutdown ssl ty
+ Bidirectional -> unless (n == 1)
+ $ shutdown ssl ty
foreign import ccall "SSL_get_peer_certificate" _ssl_get_peer_cert :: Ptr SSL_ -> IO (Ptr X509_)
@@ -440,7 +436,7 @@ getPeerCertificate ssl =
cert <- _ssl_get_peer_cert ssl
if cert == nullPtr
then return Nothing
- else wrapX509 cert >>= return . Just
+ else fmap Just (wrapX509 cert)
foreign import ccall "SSL_get_verify_result" _ssl_get_verify_result :: Ptr SSL_ -> IO CLong
@@ -453,7 +449,7 @@ foreign import ccall "SSL_get_verify_result" _ssl_get_verify_result :: Ptr SSL_
-- to a root CA. You also need to check that the certificate is correct (i.e.
-- has the correct hostname in it) with getPeerCertificate.
getVerifyResult :: SSL -> IO Bool
-getVerifyResult ssl = do
+getVerifyResult ssl =
withSSL ssl $ \ssl -> do
r <- _ssl_get_verify_result ssl
return $ r == (#const X509_V_OK)
View
6 OpenSSL/Stack.hsc
@@ -33,7 +33,7 @@ foreign import ccall unsafe "sk_value"
mapStack :: (Ptr a -> IO b) -> Ptr STACK -> IO [b]
mapStack m st
= do num <- skNum st
- mapM (\ i -> skValue st i >>= return . castPtr >>= m)
+ mapM (\ i -> fmap castPtr (skValue st i) >>= m)
$ take (fromIntegral num) [0..]
@@ -45,8 +45,8 @@ newStack values
withStack :: [Ptr a] -> (Ptr STACK -> IO b) -> IO b
-withStack values f
- = bracket (newStack values) skFree f
+withStack values
+ = bracket (newStack values) skFree
withForeignStack :: (fp -> Ptr obj)
View
2 OpenSSL/Utils.hs
@@ -71,7 +71,7 @@ toHex = reverse . map hexByte . unfoldr step where
-- | Convert a hex string to an integer
fromHex :: (Bits i) => String -> i
fromHex = foldl step 0 where
- step acc hexchar = (acc `shiftL` 4) .|. (byteHex hexchar)
+ step acc hexchar = (acc `shiftL` 4) .|. byteHex hexchar
byteHex '0' = 0
byteHex '1' = 1
View
14 OpenSSL/X509.hsc
@@ -156,7 +156,7 @@ newX509 = _new >>= failIfNull >>= wrapX509
wrapX509 :: Ptr X509_ -> IO X509
-wrapX509 x509Ptr = newForeignPtr _free x509Ptr >>= return . X509
+wrapX509 = fmap X509 . newForeignPtr _free
withX509Ptr :: X509 -> (Ptr X509_ -> IO a) -> IO a
@@ -179,7 +179,7 @@ compareX509 :: X509 -> X509 -> IO Ordering
compareX509 cert1 cert2
= withX509Ptr cert1 $ \ cert1Ptr ->
withX509Ptr cert2 $ \ cert2Ptr ->
- _cmp cert1Ptr cert2Ptr >>= return . interpret
+ fmap interpret (_cmp cert1Ptr cert2Ptr)
where
interpret :: CInt -> Ordering
interpret n
@@ -350,11 +350,11 @@ setNotAfter x509 utc
getPublicKey :: X509 -> IO SomePublicKey
getPublicKey x509
= withX509Ptr x509 $ \ x509Ptr ->
- _get_pubkey x509Ptr
- >>= failIfNull
- >>= wrapPKeyPtr
- >>= fromPKey
- >>= return . fromJust
+ fmap fromJust ( _get_pubkey x509Ptr
+ >>= failIfNull
+ >>= wrapPKeyPtr
+ >>= fromPKey
+ )
-- |@'setPublicKey' cert pubkey@ updates the public key of the subject
-- of certificate.
View
3 OpenSSL/X509/Name.hsc
@@ -42,8 +42,7 @@ foreign import ccall unsafe "X509_NAME_ENTRY_get_data"
allocaX509Name :: (Ptr X509_NAME -> IO a) -> IO a
-allocaX509Name m
- = bracket _new _free m
+allocaX509Name = bracket _new _free
withX509Name :: [(String, String)] -> (Ptr X509_NAME -> IO a) -> IO a
View
13 OpenSSL/X509/Request.hsc
@@ -100,7 +100,7 @@ newX509Req = _new >>= wrapX509Req
wrapX509Req :: Ptr X509_REQ -> IO X509Req
-wrapX509Req reqPtr = newForeignPtr _free reqPtr >>= return . X509Req
+wrapX509Req = fmap X509Req . newForeignPtr _free
withX509ReqPtr :: X509Req -> (Ptr X509_REQ -> IO a) -> IO a
@@ -194,11 +194,12 @@ setSubjectName req subject
getPublicKey :: X509Req -> IO SomePublicKey
getPublicKey req
= withX509ReqPtr req $ \ reqPtr ->
- _get_pubkey reqPtr
- >>= failIfNull
- >>= wrapPKeyPtr
- >>= fromPKey
- >>= return . fromJust
+ fmap fromJust
+ ( _get_pubkey reqPtr
+ >>= failIfNull
+ >>= wrapPKeyPtr
+ >>= fromPKey
+ )
-- |@'setPublicKey' req@ updates the public key of the subject of
-- certificate request.
View
13 OpenSSL/X509/Revocation.hsc
@@ -154,7 +154,7 @@ newCRL = _new >>= wrapCRL
wrapCRL :: Ptr X509_CRL -> IO CRL
-wrapCRL crlPtr = newForeignPtr _free crlPtr >>= return . CRL
+wrapCRL = fmap CRL . newForeignPtr _free
withCRLPtr :: CRL -> (Ptr X509_CRL -> IO a) -> IO a
@@ -278,8 +278,7 @@ setIssuerName crl issuer
getRevokedList :: CRL -> IO [RevokedCertificate]
getRevokedList crl
= withCRLPtr crl $ \ crlPtr ->
- do stRevoked <- _get_REVOKED crlPtr
- mapStack peekRevoked stRevoked
+ (_get_REVOKED crlPtr >>= mapStack peekRevoked)
where
peekRevoked :: Ptr X509_REVOKED -> IO RevokedCertificate
peekRevoked rev
@@ -294,11 +293,11 @@ newRevoked :: RevokedCertificate -> IO (Ptr X509_REVOKED)
newRevoked revoked
= do revPtr <- _new_revoked
- seriRet <- withASN1Integer (revSerialNumber revoked) $ \ serialPtr ->
- _set_serialNumber revPtr serialPtr
+ seriRet <- withASN1Integer (revSerialNumber revoked) $
+ _set_serialNumber revPtr
- dateRet <- withASN1Time (revRevocationDate revoked) $ \ datePtr ->
- _set_revocationDate revPtr datePtr
+ dateRet <- withASN1Time (revRevocationDate revoked) $
+ _set_revocationDate revPtr
if seriRet /= 1 || dateRet /= 1 then
freeRevoked revPtr >> raiseOpenSSLError
View
12 examples/GenRSAKey.hs
@@ -13,12 +13,12 @@ main = withOpenSSL $
printf "Generating RSA key-pair, nbits = %d, e = %d:\n" keyBits keyE
rsa <- generateRSAKey keyBits keyE $ Just $ \ phase _ ->
- do hPutChar stdout $ case phase of
- 0 -> '.'
- 1 -> '+'
- 2 -> '*'
- 3 -> '\n'
- n -> head $ show n
+ do putChar $ case phase of
+ 0 -> '.'
+ 1 -> '+'
+ 2 -> '*'
+ 3 -> '\n'
+ n -> head $ show n
hFlush stdout
printf "Done.\n"
View
2 tests/Base64.hs
@@ -65,7 +65,7 @@ lazyEncoding = all id $ map (\(a, v) -> encodeBase64LBS a == v) lazyEncodeTests
decoding = all id $ map (\(a, v) -> decodeBase64BS a == v) decodeTests
main = do
- mapM (print . encodeBase64LBS . fst) lazyEncodeTests
+ mapM_ (print . encodeBase64LBS . fst) lazyEncodeTests
if encoding && lazyEncoding && decoding
then putStrLn "PASS"
else putStrLn "FAIL"
View
6 tests/Cipher.hs
@@ -1,7 +1,7 @@
-- | Tests for the non-EVP ciphers
module Main where
-import Control.Monad (when)
+import Control.Monad (unless)
import qualified Data.ByteString as BS
import OpenSSL.Cipher
@@ -83,9 +83,9 @@ runCtrTest (CTRTest key iv plaintext ciphertext) = do
return (ct == ciphertext)
runCtrTests :: IO Bool
-runCtrTests = mapM runCtrTest ctrTests >>= return . all ((==) True)
+runCtrTests = fmap (all (== True)) (mapM runCtrTest ctrTests)
main = do
r <- runCtrTests
- when (r == False) $ fail "CTR tests failed"
+ unless r $ fail "CTR tests failed"
putStrLn "PASS"
View
4 tests/DSA.hs
@@ -1,7 +1,7 @@
module Main where
+import Control.Monad
import System.Time
-
import OpenSSL.DSA
import qualified Data.ByteString as BS
@@ -35,7 +35,7 @@ test_signVerifySpeed = do
return ()
starttime <- getClockTime
- sequence_ $ take 2000 $ repeat test
+ replicateM_ 2000 test
endtime <- getClockTime
print $ diffClockTimes endtime starttime

0 comments on commit be44eaa

Please sign in to comment.
Something went wrong with that request. Please try again.