diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,11 +1,57 @@ 2014-07-13 PHO - * OpenSSL/EVP/Cipher.hsc: Expose cipherInit, Patch by rons. + * OpenSSL/EVP/Base64.hsc (encodeBase64, decodeBase64): Mark as + deprecated. - * HsOpenSSL.cabal (Exposed-Modules): Expose OpenSSL.EVP.Internal, - Patch by rnos. + * OpenSSL/EVP/Cipher.hsc (cipherInit): Removed. Use + OpenSSL.EVP.Internal.cipherInitBS instead. This is a + backward-incompatible change. - * HsOpenSSL.cabal (Version): Bump version to 0.10.5 + * OpenSSL/EVP/Cipher.hsc (cipher): Mark as deprecated. + + * OpenSSL/EVP/Digest.hsc (digest): Mark as deprecated. + + * OpenSSL/EVP/Digest.hsc (digestBS): Changed the return type from + String to strict ByteString. This is a backward-incompatible + change. + + * OpenSSL/EVP/Digest.hsc (digestBS'): Removed. Use digestBS + instead. This is a backward-incompatible change. + + * OpenSSL/EVP/Digest.hsc (digestLBS): Change the return type from + String to strict ByteString. This is a backward-incompatible + change. + + * OpenSSL/EVP/Open.hsc (open): Mark as deprecated. + + * OpenSSL/EVP/Open.hsc (openBS, openLBS): Take key and IV as a + strict ByteString intead of String. This is a + backward-incompatible change. + + * OpenSSL/EVP/Seal.hsc (seal): Mark as deprecated. + + * OpenSSL/EVP/Seal.hsc (sealBS, sealLBS): Return key and IV as a + strict ByteString intead of String. This is a + backward-incompatible change. + + * OpenSSL/EVP/Sign.hsc (sign): Mark as deprecated. + + * OpenSSL/EVP/Verify.hsc (verify): Mark as deprecated. + + * OpenSSL/EVP/Verify.hsc (verifyBS, verifyLBS): Take signature as + a strict ByteString instead of String. This is a + backward-incompatible change. + + * HsOpenSSL.cabal (Version): Bump version to 0.11 + +2014-07-13 PHO + + * OpenSSL/EVP/Cipher.hsc: Expose cipherInit, Patch by rons. + + * HsOpenSSL.cabal (Exposed-Modules): Expose OpenSSL.EVP.Internal, + Patch by rnos. + + * HsOpenSSL.cabal (Version): Bump version to 0.10.5 2013-12-25 PHO diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -12,7 +12,7 @@ , which is a pure Haskell implementation of SSL. . -Version: 0.10.5 +Version: 0.11 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen diff --git a/OpenSSL/EVP/Base64.hsc b/OpenSSL/EVP/Base64.hsc --- a/OpenSSL/EVP/Base64.hsc +++ b/OpenSSL/EVP/Base64.hsc @@ -66,6 +66,7 @@ -- Base64. The string doesn't have to be finite. Note that the string -- must not contain any letters which aren't in the range of U+0000 - -- U+00FF. +{-# DEPRECATED encodeBase64 "Use encodeBase64BS or encodeBase64LBS instead." #-} encodeBase64 :: String -> String encodeBase64 = L8.unpack . encodeBase64LBS . L8.pack @@ -117,6 +118,7 @@ -- |@'decodeBase64' str@ lazilly decodes a stream of data from -- Base64. The string doesn't have to be finite. +{-# DEPRECATED decodeBase64 "Use decodeBase64BS or decodeBase64LBS instead." #-} decodeBase64 :: String -> String decodeBase64 = L8.unpack . decodeBase64LBS . L8.pack diff --git a/OpenSSL/EVP/Cipher.hsc b/OpenSSL/EVP/Cipher.hsc --- a/OpenSSL/EVP/Cipher.hsc +++ b/OpenSSL/EVP/Cipher.hsc @@ -11,20 +11,18 @@ , CryptoMode(..) - , cipherInit , cipher , cipherBS , cipherLBS , cipherStrictLBS ) where -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 +import Data.Monoid import Foreign import Foreign.C import OpenSSL.Objects -import OpenSSL.Utils import OpenSSL.EVP.Internal foreign import ccall unsafe "EVP_get_cipherbyname" @@ -49,26 +47,6 @@ {- encrypt/decrypt ----------------------------------------------------------- -} --- |@CryptoMode@ represents instruction to 'cipher' and such like. -data CryptoMode = Encrypt | Decrypt - -cryptoModeToInt :: CryptoMode -> CInt -cryptoModeToInt Encrypt = 1 -cryptoModeToInt Decrypt = 0 - -foreign import ccall unsafe "EVP_CipherInit" - _CipherInit :: Ptr EVP_CIPHER_CTX -> Ptr EVP_CIPHER -> CString -> CString -> CInt -> IO CInt - -cipherInit :: Cipher -> String -> String -> CryptoMode -> IO CipherCtx -cipherInit (Cipher c) key iv mode - = do ctx <- newCipherCtx - withCipherCtxPtr ctx $ \ ctxPtr -> - withCString key $ \ keyPtr -> - withCString iv $ \ ivPtr -> - _CipherInit ctxPtr c keyPtr ivPtr (cryptoModeToInt mode) - >>= failIf_ (/= 1) - return ctx - -- | Encrypt a lazy bytestring in a strict manner. Does not leak the keys. cipherStrictLBS :: Cipher -- ^ Cipher -> B8.ByteString -- ^ Key @@ -76,15 +54,11 @@ -> CryptoMode -- ^ Encrypt\/Decrypt -> L8.ByteString -- ^ Input -> IO L8.ByteString -cipherStrictLBS (Cipher c) key iv mode input = - withNewCipherCtxPtr $ \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 - rf <- cipherFinalBS cc - return $ L8.fromChunks (rr++[rf]) +cipherStrictLBS c key iv mode input = + do ctx <- cipherInitBS c key iv mode + xs <- cipherUpdateBS ctx `mapM` L8.toChunks input + x <- cipherFinalBS ctx + return $ L8.fromChunks (xs `mappend` [x]) -- |@'cipher'@ lazilly encrypts or decrypts a stream of data. The -- input string doesn't necessarily have to be finite. @@ -97,29 +71,30 @@ -- which aren't in the range of U+0000 - -- U+00FF. -> IO String -- ^ the result string +{-# DEPRECATED cipher "Use cipherBS, cipherLBS or cipherStrictLBS." #-} cipher c key iv mode input - = fmap L8.unpack $ cipherLBS c key iv mode $ L8.pack input + = fmap L8.unpack $ cipherLBS c (B8.pack key) (B8.pack iv) mode (L8.pack input) -- |@'cipherBS'@ strictly encrypts or decrypts a chunk of data. -cipherBS :: Cipher -- ^ algorithm to use - -> String -- ^ symmetric key - -> String -- ^ IV - -> CryptoMode -- ^ operation +cipherBS :: Cipher -- ^ algorithm to use + -> B8.ByteString -- ^ symmetric key + -> B8.ByteString -- ^ IV + -> CryptoMode -- ^ operation -> B8.ByteString -- ^ input string to encrypt\/decrypt -> IO B8.ByteString -- ^ the result string cipherBS c key iv mode input - = do ctx <- cipherInit c key iv mode + = do ctx <- cipherInitBS c key iv mode cipherStrictly ctx input -- |@'cipherLBS'@ lazilly encrypts or decrypts a stream of data. The -- input string doesn't necessarily have to be finite. -cipherLBS :: Cipher -- ^ algorithm to use - -> String -- ^ symmetric key - -> String -- ^ IV - -> CryptoMode -- ^ operation +cipherLBS :: Cipher -- ^ algorithm to use + -> B8.ByteString -- ^ symmetric key + -> B8.ByteString -- ^ IV + -> CryptoMode -- ^ operation -> L8.ByteString -- ^ input string to encrypt\/decrypt -> IO L8.ByteString -- ^ the result string cipherLBS c key iv mode input - = do ctx <- cipherInit c key iv mode + = do ctx <- cipherInitBS c key iv mode cipherLazily ctx input diff --git a/OpenSSL/EVP/Digest.hsc b/OpenSSL/EVP/Digest.hsc --- a/OpenSSL/EVP/Digest.hsc +++ b/OpenSSL/EVP/Digest.hsc @@ -11,7 +11,6 @@ , digest , digestBS - , digestBS' , digestLBS , hmacBS @@ -56,23 +55,19 @@ -- not contain any letters which aren't in the range of U+0000 - -- U+00FF. digest :: Digest -> String -> String +{-# DEPRECATED digest "Use digestBS or digestLBS instead." #-} digest md input - = digestLBS md $ L8.pack input + = B8.unpack $ digestLBS md $ L8.pack input -- |@'digestBS'@ digests a chunk of data. -digestBS :: Digest -> B8.ByteString -> String +digestBS :: Digest -> B8.ByteString -> B8.ByteString digestBS md input - = unsafePerformIO $ digestStrictly md input >>= digestFinal - --- |Same as 'digestBS' but returns 'B8.ByteString' instead. -digestBS' :: Digest -> B8.ByteString -> B8.ByteString -digestBS' md input = unsafePerformIO $ digestStrictly md input >>= digestFinalBS -- |@'digestLBS'@ digests a stream of data. -digestLBS :: Digest -> L8.ByteString -> String +digestLBS :: Digest -> L8.ByteString -> B8.ByteString digestLBS md input - = unsafePerformIO $ digestLazily md input >>= digestFinal + = unsafePerformIO $ digestLazily md input >>= digestFinalBS {- HMAC ---------------------------------------------------------------------- -} diff --git a/OpenSSL/EVP/Internal.hsc b/OpenSSL/EVP/Internal.hsc --- a/OpenSSL/EVP/Internal.hsc +++ b/OpenSSL/EVP/Internal.hsc @@ -11,6 +11,8 @@ withCipherCtxPtr, withNewCipherCtxPtr, + CryptoMode(..), + cipherInitBS, cipherUpdateBS, cipherFinalBS, cipherStrictly, @@ -57,7 +59,7 @@ import Foreign.C.Types (CInt, CUInt, CSize) #endif import Foreign.Ptr (Ptr, castPtr, FunPtr) -import Foreign.C.String (peekCStringLen) +import Foreign.C.String (CString, peekCStringLen) import Foreign.ForeignPtr #if MIN_VERSION_base(4,4,0) import Foreign.ForeignPtr.Unsafe as Unsafe @@ -120,6 +122,35 @@ bracket_ (_cipher_ctx_init ptr) (_cipher_ctx_cleanup' ptr) (f ptr) {- encrypt/decrypt ----------------------------------------------------------- -} + +-- |@CryptoMode@ represents instruction to 'cipher' and such like. +data CryptoMode = Encrypt | Decrypt + +fromCryptoMode :: Num a => CryptoMode -> a +fromCryptoMode Encrypt = 1 +fromCryptoMode Decrypt = 0 + +foreign import ccall unsafe "EVP_CipherInit" + _CipherInit :: Ptr EVP_CIPHER_CTX + -> Ptr EVP_CIPHER + -> CString + -> CString + -> CInt + -> IO CInt + +cipherInitBS :: Cipher + -> B8.ByteString -- ^ key + -> B8.ByteString -- ^ IV + -> CryptoMode + -> IO CipherCtx +cipherInitBS (Cipher c) key iv mode + = do ctx <- newCipherCtx + withCipherCtxPtr ctx $ \ ctxPtr -> + B8.unsafeUseAsCString key $ \ keyPtr -> + B8.unsafeUseAsCString iv $ \ ivPtr -> + _CipherInit ctxPtr c keyPtr ivPtr (fromCryptoMode mode) + >>= failIf_ (/= 1) + return ctx foreign import ccall unsafe "EVP_CipherUpdate" _CipherUpdate :: Ptr EVP_CIPHER_CTX -> Ptr CChar -> Ptr CInt diff --git a/OpenSSL/EVP/Open.hsc b/OpenSSL/EVP/Open.hsc --- a/OpenSSL/EVP/Open.hsc +++ b/OpenSSL/EVP/Open.hsc @@ -12,6 +12,7 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.ByteString.Unsafe as B8 import Foreign hiding (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO) import Foreign.C @@ -31,12 +32,17 @@ -> IO CInt -openInit :: KeyPair key => Cipher -> String -> String -> key -> IO CipherCtx +openInit :: KeyPair key => + Cipher + -> B8.ByteString + -> B8.ByteString + -> key + -> IO CipherCtx openInit cipher encKey iv pkey = do ctx <- newCipherCtx withCipherCtxPtr ctx $ \ ctxPtr -> - withCStringLen encKey $ \ (encKeyPtr, encKeyLen) -> - withCString iv $ \ ivPtr -> + B8.unsafeUseAsCStringLen encKey $ \ (encKeyPtr, encKeyLen) -> + B8.unsafeUseAsCString iv $ \ ivPtr -> withPKeyPtr' pkey $ \ pkeyPtr -> _OpenInit ctxPtr cipher encKeyPtr (fromIntegral encKeyLen) ivPtr pkeyPtr >>= failIf_ (== 0) @@ -51,15 +57,16 @@ -> key -- ^ private key to decrypt the symmetric key -> String -- ^ input string to decrypt -> String -- ^ decrypted string +{-# DEPRECATED open "Use openBS or openLBS instead." #-} open cipher encKey iv pkey input - = L8.unpack $ openLBS cipher encKey iv pkey $ L8.pack input + = L8.unpack $ openLBS cipher (B8.pack encKey) (B8.pack iv) pkey (L8.pack input) -- |@'openBS'@ decrypts a chunk of data. openBS :: KeyPair key => - Cipher -- ^ symmetric cipher algorithm to use - -> String -- ^ encrypted symmetric key to decrypt the input string - -> String -- ^ IV - -> key -- ^ private key to decrypt the symmetric key + Cipher -- ^ symmetric cipher algorithm to use + -> B8.ByteString -- ^ encrypted symmetric key to decrypt the input string + -> B8.ByteString -- ^ IV + -> key -- ^ private key to decrypt the symmetric key -> B8.ByteString -- ^ input string to decrypt -> B8.ByteString -- ^ decrypted string openBS cipher encKey iv pkey input @@ -70,10 +77,10 @@ -- |@'openLBS'@ lazilly decrypts a stream of data. The input string -- doesn't necessarily have to be finite. openLBS :: KeyPair key => - Cipher -- ^ symmetric cipher algorithm to use - -> String -- ^ encrypted symmetric key to decrypt the input string - -> String -- ^ IV - -> key -- ^ private key to decrypt the symmetric key + Cipher -- ^ symmetric cipher algorithm to use + -> B8.ByteString -- ^ encrypted symmetric key to decrypt the input string + -> B8.ByteString -- ^ IV + -> key -- ^ private key to decrypt the symmetric key -> L8.ByteString -- ^ input string to decrypt -> L8.ByteString -- ^ decrypted string openLBS cipher encKey iv pkey input diff --git a/OpenSSL/EVP/Seal.hsc b/OpenSSL/EVP/Seal.hsc --- a/OpenSSL/EVP/Seal.hsc +++ b/OpenSSL/EVP/Seal.hsc @@ -31,7 +31,9 @@ -> IO CInt -sealInit :: Cipher -> [SomePublicKey] -> IO (CipherCtx, [String], String) +sealInit :: Cipher + -> [SomePublicKey] + -> IO (CipherCtx, [B8.ByteString], B8.ByteString) sealInit _ [] = fail "sealInit: at least one public key is required" @@ -74,8 +76,8 @@ cleanup >> raiseOpenSSLError else do encKeysLen <- peekArray nKeys encKeyBufsLenPtr - encKeys <- mapM peekCStringCLen $ zip encKeyBufs encKeysLen - iv <- peekCString ivPtr + encKeys <- mapM B8.packCStringLen $ zip encKeyBufs (fromIntegral `fmap` encKeysLen) + iv <- B8.packCStringLen (ivPtr, cipherIvLength cipher) cleanup return (ctx, encKeys, iv) where @@ -96,21 +98,29 @@ -- corresponding private keys can decrypt -- the message. -> String -- ^ input string to encrypt - -> IO (String, [String], String) -- ^ (encrypted string, list of - -- encrypted asymmetric keys, - -- IV) + -> IO ( String + , [String] + , String + ) -- ^ (encrypted string, list of encrypted asymmetric + -- keys, IV) +{-# DEPRECATED seal "Use sealBS or sealLBS instead." #-} seal cipher pubKeys input = do (output, encKeys, iv) <- sealLBS cipher pubKeys $ L8.pack input - return (L8.unpack output, encKeys, iv) + return ( L8.unpack output + , B8.unpack `fmap` encKeys + , B8.unpack iv + ) -- |@'sealBS'@ strictly encrypts a chunk of data. sealBS :: Cipher -- ^ symmetric cipher algorithm to use -> [SomePublicKey] -- ^ list of public keys to encrypt a -- symmetric key -> B8.ByteString -- ^ input string to encrypt - -> IO (B8.ByteString, [String], String) -- ^ (encrypted string, - -- list of encrypted - -- asymmetric keys, IV) + -> IO ( B8.ByteString + , [B8.ByteString] + , B8.ByteString + ) -- ^ (encrypted string, list of encrypted asymmetric + -- keys, IV) sealBS cipher pubKeys input = do (ctx, encKeys, iv) <- sealInit cipher pubKeys output <- cipherStrictly ctx input @@ -122,11 +132,11 @@ -> [SomePublicKey] -- ^ list of public keys to encrypt a -- symmetric key -> L8.ByteString -- ^ input string to encrypt - -> IO (L8.ByteString, [String], String) -- ^ (encrypted - -- string, list of - -- encrypted - -- asymmetric keys, - -- IV) + -> IO ( L8.ByteString + , [B8.ByteString] + , B8.ByteString + ) -- ^ (encrypted string, list of encrypted asymmetric + -- keys, IV) sealLBS cipher pubKeys input = do (ctx, encKeys, iv) <- sealInit cipher pubKeys output <- cipherLazily ctx input diff --git a/OpenSSL/EVP/Sign.hsc b/OpenSSL/EVP/Sign.hsc --- a/OpenSSL/EVP/Sign.hsc +++ b/OpenSSL/EVP/Sign.hsc @@ -43,13 +43,14 @@ -> key -- ^ private key to sign the message digest -> String -- ^ input string -> IO String -- ^ the result signature +{-# DEPRECATED sign "Use signBS or signLBS instead." #-} sign md pkey input = fmap L8.unpack $ signLBS md pkey $ L8.pack input -- |@'signBS'@ generates a signature from a chunk of data. signBS :: KeyPair key => - Digest -- ^ message digest algorithm to use - -> key -- ^ private key to sign the message digest + Digest -- ^ message digest algorithm to use + -> key -- ^ private key to sign the message digest -> B8.ByteString -- ^ input string -> IO B8.ByteString -- ^ the result signature signBS md pkey input diff --git a/OpenSSL/EVP/Verify.hsc b/OpenSSL/EVP/Verify.hsc --- a/OpenSSL/EVP/Verify.hsc +++ b/OpenSSL/EVP/Verify.hsc @@ -13,6 +13,7 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.ByteString.Unsafe as B8 import Data.Typeable import Foreign import Foreign.C @@ -31,10 +32,14 @@ _VerifyFinal :: Ptr EVP_MD_CTX -> Ptr CChar -> CUInt -> Ptr EVP_PKEY -> IO CInt -verifyFinalBS :: PublicKey k => DigestCtx -> String -> k -> IO VerifyStatus +verifyFinalBS :: PublicKey k => + DigestCtx + -> B8.ByteString + -> k + -> IO VerifyStatus verifyFinalBS ctx sig k = withDigestCtxPtr ctx $ \ ctxPtr -> - withCStringLen sig $ \ (buf, len) -> + B8.unsafeUseAsCStringLen sig $ \ (buf, len) -> withPKeyPtr' k $ \ pkeyPtr -> _VerifyFinal ctxPtr buf (fromIntegral len) pkeyPtr >>= interpret where @@ -52,13 +57,14 @@ -> key -- ^ public key to verify the signature -> String -- ^ input string to verify -> IO VerifyStatus -- ^ the result of verification +{-# DEPRECATED verify "Use verifyBS or verifyLBS instead." #-} verify md sig pkey input - = verifyLBS md sig pkey (L8.pack input) + = verifyLBS md (B8.pack sig) pkey (L8.pack input) -- |@'verifyBS'@ verifies a signature and a chunk of data. verifyBS :: PublicKey key => Digest -- ^ message digest algorithm to use - -> String -- ^ message signature + -> B8.ByteString -- ^ message signature -> key -- ^ public key to verify the signature -> B8.ByteString -- ^ input string to verify -> IO VerifyStatus -- ^ the result of verification @@ -69,7 +75,7 @@ -- |@'verifyLBS'@ verifies a signature of a stream of data. verifyLBS :: PublicKey key => Digest -- ^ message digest algorithm to use - -> String -- ^ message signature + -> B8.ByteString -- ^ message signature -> key -- ^ public key to verify the signature -> L8.ByteString -- ^ input string to verify -> IO VerifyStatus -- ^ the result of verification diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs --- a/examples/HelloWorld.hs +++ b/examples/HelloWorld.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} import Control.Monad +import qualified Data.ByteString.Char8 as B8 import Data.List import Data.Maybe +import Data.Monoid import OpenSSL import OpenSSL.EVP.Cipher import OpenSSL.EVP.Open @@ -19,24 +22,24 @@ rsa <- generateRSAKey 512 65537 Nothing let plainText = "Hello, world!" - putStrLn ("plain text to encrypt: " ++ plainText) + B8.putStrLn ("plain text to encrypt: " `mappend` plainText) putStrLn "" putStrLn "encrypting..." - (encrypted, [encKey], iv) <- seal des [fromPublicKey rsa] plainText + (encrypted, [encKey], iv) <- sealBS des [fromPublicKey rsa] plainText - putStrLn ("encrypted symmetric key: " ++ binToHex encKey) - putStrLn ("IV: " ++ binToHex iv) - putStrLn ("encrypted message: " ++ binToHex encrypted) + B8.putStrLn ("encrypted symmetric key: " `mappend` binToHex encKey) + B8.putStrLn ("IV: " `mappend` binToHex iv) + B8.putStrLn ("encrypted message: " `mappend` binToHex encrypted) putStrLn "" putStrLn "decrypting..." - let decrypted = open des encKey iv rsa encrypted + let decrypted = openBS des encKey iv rsa encrypted - putStrLn ("decrypted message: " ++ decrypted) + B8.putStrLn ("decrypted message: " `mappend` decrypted) -binToHex :: String -> String -binToHex bin = concat $ intersperse ":" $ map (printf "%02x" . fromEnum) bin +binToHex :: B8.ByteString -> B8.ByteString +binToHex = B8.pack . intercalate ":" . map (printf "%02x" . fromEnum) . B8.unpack diff --git a/examples/Makefile b/examples/Makefile --- a/examples/Makefile +++ b/examples/Makefile @@ -1,4 +1,4 @@ -GHCFLAGS = -O2 -fglasgow-exts +GHCFLAGS = -O2 build: ghc $(GHCFLAGS) --make GenRSAKey