diff --git a/Network/TLS/Cipher.hs b/Network/TLS/Cipher.hs --- a/Network/TLS/Cipher.hs +++ b/Network/TLS/Cipher.hs @@ -15,6 +15,8 @@ -- * builtin ciphers for ease of use, might move later to a tls-ciphers library , cipher_null_null + , cipher_null_SHA1 + , cipher_null_MD5 , cipher_RC4_128_MD5 , cipher_RC4_128_SHA1 , cipher_AES128_SHA1 @@ -31,10 +33,9 @@ import qualified Crypto.Hash.MD5 as MD5 import qualified Data.Vector.Unboxed as Vector (fromList, toList) -import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B -import qualified Codec.Crypto.AES as AES +import qualified Crypto.Cipher.AES as AES import qualified Crypto.Cipher.RC4 as RC4 -- FIXME convert to newtype @@ -91,33 +92,21 @@ cipherExchangeNeedMoreData CipherKeyExchangeECDH_RSA = True cipherExchangeNeedMoreData CipherKeyExchangeECDHE_ECDSA = True -repack :: Int -> B.ByteString -> [B.ByteString] -repack bs x = - if B.length x > bs - then - let (c1, c2) = B.splitAt bs x in - B.pack (B.unpack c1) : repack 16 c2 - else - [ x ] - -lazyToStrict :: L.ByteString -> B.ByteString -lazyToStrict = B.concat . L.toChunks - aes128_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes128_cbc_encrypt key iv d = lazyToStrict $ AES.crypt AES.CBC key iv AES.Encrypt d16 - where d16 = L.fromChunks $ repack 16 d +aes128_cbc_encrypt key iv d = AES.encryptCBC pkey iv d + where (Right pkey) = AES.initKey128 key aes128_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes128_cbc_decrypt key iv d = lazyToStrict $ AES.crypt AES.CBC key iv AES.Decrypt d16 - where d16 = L.fromChunks $ repack 16 d +aes128_cbc_decrypt key iv d = AES.decryptCBC pkey iv d + where (Right pkey) = AES.initKey128 key aes256_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes256_cbc_encrypt key iv d = lazyToStrict $ AES.crypt AES.CBC key iv AES.Encrypt d16 - where d16 = L.fromChunks $ repack 16 d +aes256_cbc_encrypt key iv d = AES.encryptCBC pkey iv d + where (Right pkey) = AES.initKey256 key aes256_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes256_cbc_decrypt key iv d = lazyToStrict $ AES.crypt AES.CBC key iv AES.Decrypt d16 - where d16 = L.fromChunks $ repack 32 d +aes256_cbc_decrypt key iv d = AES.decryptCBC pkey iv d + where (Right pkey) = AES.initKey256 key toIV :: RC4.Ctx -> IV toIV (v, x, y) = B.pack (x : y : Vector.toList v) @@ -184,6 +173,36 @@ , cipherKeyBlockSize = 0 , cipherPaddingSize = 0 , cipherMACHash = (const B.empty) + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherNoneF + , cipherMinVer = Nothing + } + +cipher_null_MD5 :: Cipher +cipher_null_MD5 = Cipher + { cipherID = 0x1 + , cipherName = "RSA-null-MD5" + , cipherDigestSize = 16 + , cipherKeySize = 0 + , cipherIVSize = 0 + , cipherKeyBlockSize = 2 * (16 + 0 + 0) + , cipherPaddingSize = 0 + , cipherMACHash = MD5.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherNoneF + , cipherMinVer = Nothing + } + +cipher_null_SHA1 :: Cipher +cipher_null_SHA1 = Cipher + { cipherID = 0x2 + , cipherName = "RSA-null-SHA1" + , cipherDigestSize = 20 + , cipherKeySize = 0 + , cipherIVSize = 0 + , cipherKeyBlockSize = 2 * (20 + 0 + 0) + , cipherPaddingSize = 0 + , cipherMACHash = SHA1.hash , cipherKeyExchange = CipherKeyExchangeRSA , cipherF = CipherNoneF , cipherMinVer = Nothing diff --git a/Network/TLS/Client.hs b/Network/TLS/Client.hs --- a/Network/TLS/Client.hs +++ b/Network/TLS/Client.hs @@ -46,7 +46,7 @@ import Data.List (find) data TLSClientCallbacks = TLSClientCallbacks - { cbCertificates :: Maybe ([Certificate] -> IO Bool) -- ^ optional callback to verify certificates + { cbCertificates :: Maybe ([X509] -> IO Bool) -- ^ optional callback to verify certificates } instance Show TLSClientCallbacks where @@ -57,7 +57,7 @@ , cpAllowedVersions :: [Version] -- ^ allowed versions from the server , cpSession :: Maybe [Word8] -- ^ session for this connection , cpCiphers :: [Cipher] -- ^ all ciphers for this connection - , cpCertificate :: Maybe Certificate -- ^ an optional client certificate + , cpCertificate :: Maybe X509 -- ^ an optional client certificate , cpCallbacks :: TLSClientCallbacks -- ^ user callbacks } deriving (Show) diff --git a/Network/TLS/Packet.hs b/Network/TLS/Packet.hs --- a/Network/TLS/Packet.hs +++ b/Network/TLS/Packet.hs @@ -356,7 +356,7 @@ certxs <- getCerts (len - certlen - 3) return (cert : certxs) -putCert :: Certificate -> Put +putCert :: X509 -> Put putCert cert = putWord24 (fromIntegral $ B.length content) >> putBytes content where content = B.concat $ L.toChunks $ encodeCertificate cert diff --git a/Network/TLS/Receiving.hs b/Network/TLS/Receiving.hs --- a/Network/TLS/Receiving.hs +++ b/Network/TLS/Receiving.hs @@ -14,10 +14,10 @@ readPacket ) where +import Data.Maybe (isJust) import Control.Applicative ((<$>)) import Control.Monad.State import Control.Monad.Error -import Data.Maybe import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as L @@ -81,7 +81,7 @@ processPacket (Header ProtocolType_ChangeCipherSpec _ _) content = do e <- updateStatusCC False - when (isJust e) $ throwError (fromJust e) + when (isJust e) $ throwError (fromJust "" e) returnEither $ decodeChangeCipherSpec content switchRxEncryption @@ -99,7 +99,7 @@ processHandshake ver ty econtent = do -- SECURITY FIXME if RSA fail, we need to generate a random master secret and not fail. e <- updateStatusHs ty - when (isJust e) $ throwError (fromJust e) + when (isJust e) $ throwError (fromJust "" e) content <- case ty of HandshakeType_ClientKeyXchg -> do @@ -128,7 +128,7 @@ decryptRSA :: MonadTLSState m => ByteString -> m (Either KxError ByteString) decryptRSA econtent = do ver <- return . stVersion =<< getTLSState - rsapriv <- getTLSState >>= return . fromJust . hstRSAPrivateKey . fromJust . stHandshake + rsapriv <- getTLSState >>= return . fromJust "rsa private key" . hstRSAPrivateKey . fromJust "handshake" . stHandshake return $ kxDecrypt rsapriv (if ver < TLS10 then econtent else B.drop 2 econtent) setMasterSecretRandom :: ByteString -> TLSRead () @@ -141,7 +141,7 @@ processClientKeyXchg :: Version -> ByteString -> TLSRead () processClientKeyXchg ver content = do {- the TLS protocol expect the initial client version received in the ClientHello, not the negociated version -} - expectedVer <- getTLSState >>= return . hstClientVersion . fromJust . stHandshake + expectedVer <- getTLSState >>= return . hstClientVersion . fromJust "handshake" . stHandshake if expectedVer /= ver then setMasterSecretRandom content else setMasterSecret content @@ -194,31 +194,37 @@ decryptData (EncryptedData econtent) = do st <- getTLSState - assert "decrypt data" - [ ("cipher", isNothing $ stCipher st) - , ("crypt state", isNothing $ stRxCryptState st) ] - - let cipher = fromJust $ stCipher st - let cst = fromJust $ stRxCryptState st + let cipher = fromJust "cipher" $ stCipher st + let cst = fromJust "rx crypt state" $ stRxCryptState st let padding_size = fromIntegral $ cipherPaddingSize cipher let digestSize = fromIntegral $ cipherDigestSize cipher let writekey = cstKey cst case cipherF cipher of - CipherNoneF -> fail "none decrypt" + CipherNoneF -> do + let contentlen = B.length econtent - digestSize + case partition3 econtent (contentlen, digestSize, 0) of + Nothing -> + throwError $ Error_Misc "partition3 failed" + Just (content, mac, _) -> + return $ CipherData + { cipherDataContent = content + , cipherDataMAC = Just mac + , cipherDataPadding = Nothing + } CipherBlockF _ decryptF -> do {- update IV -} let (iv, econtent') = if hasExplicitBlockIV $ stVersion st then B.splitAt (fromIntegral $ cipherIVSize cipher) econtent else (cstIV cst, econtent) - let newiv = fromJust $ takelast padding_size econtent' + let newiv = fromJust "new iv" $ takelast padding_size econtent' putTLSState $ st { stRxCryptState = Just $ cst { cstIV = newiv } } let content' = decryptF writekey iv econtent' let paddinglength = fromIntegral (B.last content') + 1 let contentlen = B.length content' - paddinglength - digestSize - let (content, mac, padding) = fromJust $ partition3 content' (contentlen, digestSize, paddinglength) + let (content, mac, padding) = fromJust "p3" $ partition3 content' (contentlen, digestSize, paddinglength) return $ CipherData { cipherDataContent = content , cipherDataMAC = Just mac @@ -229,7 +235,7 @@ let (content', newiv) = decryptF (if iv /= B.empty then iv else initF writekey) econtent {- update Ctx -} let contentlen = B.length content' - digestSize - let (content, mac, _) = fromJust $ partition3 content' (contentlen, digestSize, 0) + let (content, mac, _) = fromJust "p3" $ partition3 content' (contentlen, digestSize, 0) putTLSState $ st { stRxCryptState = Just $ cst { cstIV = newiv } } return $ CipherData { cipherDataContent = content @@ -237,10 +243,11 @@ , cipherDataPadding = Nothing } -processCertificates :: [Certificate] -> TLSRead () +processCertificates :: [X509] -> TLSRead () processCertificates certs = do - case certPubKey $ head certs of - PubKey _ (PubKeyRSA (lm, m, e)) -> do + let (X509 mainCert _ _ _) = head certs + case certPubKey mainCert of + PubKeyRSA (lm, m, e) -> do let pk = PubRSA (RSA.PublicKey { RSA.public_sz = fromIntegral lm, RSA.public_n = m, RSA.public_e = e }) setPublicKey pk _ -> return () diff --git a/Network/TLS/SRandom.hs b/Network/TLS/SRandom.hs --- a/Network/TLS/SRandom.hs +++ b/Network/TLS/SRandom.hs @@ -9,7 +9,7 @@ import System.Crypto.Random (getEntropy) import Data.ByteString (ByteString) import qualified Data.ByteString as B -import qualified Codec.Crypto.AES as AES +import qualified Crypto.Cipher.AES as AES import Data.Bits (xor) import Data.Serialize @@ -22,7 +22,7 @@ data Word128 = Word128 !Word64 !Word64 -data SRandomGen = RNG !ByteString !Word128 !ByteString +data SRandomGen = RNG !ByteString !Word128 !AES.Key instance Show SRandomGen where show _ = "srandomgen[..]" @@ -36,10 +36,10 @@ add1 :: Word128 -> Word128 add1 (Word128 a b) = if b == 0xffffffffffffffff then Word128 (a+1) 0 else Word128 a (b+1) -makeParams :: ByteString -> (ByteString, ByteString, ByteString) +makeParams :: ByteString -> (AES.Key, ByteString, ByteString) makeParams b = (key, cnt, iv) where - key = B.take 32 left2 + (Right key) = AES.initKey256 $ B.take 32 left2 (cnt, left2) = B.splitAt 16 left1 (iv, left1) = B.splitAt 16 b @@ -60,7 +60,7 @@ nextChunk (RNG iv counter key) = (chunk, newrng) where newrng = RNG chunk (add1 counter) key - chunk = AES.crypt' AES.CBC key iv AES.Encrypt bytes + chunk = AES.encryptCBC key iv bytes bytes = iv `bxor` (put128 counter) makeSRandomGen :: IO (Either GenError SRandomGen) diff --git a/Network/TLS/Sending.hs b/Network/TLS/Sending.hs --- a/Network/TLS/Sending.hs +++ b/Network/TLS/Sending.hs @@ -15,7 +15,6 @@ ) where import Control.Monad.State -import Data.Maybe import Data.ByteString (ByteString) import qualified Data.ByteString as B @@ -107,7 +106,7 @@ encryptRSA content = do st <- getTLSState let g = stRandomGen st - let rsakey = fromJust $ hstRSAPublicKey $ fromJust $ stHandshake st + let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st case kxEncrypt g rsakey content of Left err -> fail ("rsa encrypt failed: " ++ show err) Right (econtent, g') -> do @@ -125,12 +124,8 @@ encryptData content = do st <- getTLSState - assert "encrypt data" - [ ("cipher", isNothing $ stCipher st) - , ("crypt state", isNothing $ stTxCryptState st) ] - - let cipher = fromJust $ stCipher st - let cst = fromJust $ stTxCryptState st + let cipher = fromJust "cipher" $ stCipher st + let cst = fromJust "tx crypt state" $ stTxCryptState st let padding_size = fromIntegral $ cipherPaddingSize cipher let msg_len = B.length content @@ -144,11 +139,11 @@ let writekey = cstKey cst econtent <- case cipherF cipher of - CipherNoneF -> fail "none encrypt" + CipherNoneF -> return content CipherBlockF encrypt _ -> do let iv = cstIV cst let e = encrypt writekey iv (B.concat [ content, padding ]) - let newiv = fromJust $ takelast (fromIntegral $ cipherIVSize cipher) e + let newiv = fromJust "new iv" $ takelast (fromIntegral $ cipherIVSize cipher) e putTLSState $ st { stTxCryptState = Just $ cst { cstIV = newiv } } return $ if hasExplicitBlockIV $ stVersion st then B.concat [iv,e] diff --git a/Network/TLS/Server.hs b/Network/TLS/Server.hs --- a/Network/TLS/Server.hs +++ b/Network/TLS/Server.hs @@ -32,7 +32,8 @@ import Control.Monad.State import Control.Applicative ((<$>)) import Data.Certificate.X509 -import qualified Data.Certificate.Key as CertificateKey +import qualified Data.Certificate.KeyRSA as KeyRSA +import qualified Data.Certificate.KeyDSA as KeyDSA import Network.TLS.Cipher import Network.TLS.Crypto import Network.TLS.Struct @@ -46,7 +47,7 @@ import System.IO (Handle, hFlush) import qualified Crypto.Cipher.RSA as RSA -type TLSServerCert = (B.ByteString, Certificate, CertificateKey.PrivateKey) +type TLSServerCert = (B.ByteString, X509, KeyRSA.Private) data TLSServerCallbacks = TLSServerCallbacks { cbCertificates :: Maybe ([Certificate] -> IO Bool) -- ^ optional callback to verify certificates @@ -55,7 +56,7 @@ instance Show TLSServerCallbacks where show _ = "[callbacks]" -instance Show CertificateKey.PrivateKey where +instance Show KeyRSA.Private where show _ = "[privatekey]" data TLSServerParams = TLSServerParams @@ -150,14 +151,14 @@ let needkeyxchg = cipherExchangeNeedMoreData $ cipherKeyExchange cipher let privkey = PrivRSA $ RSA.PrivateKey - { RSA.private_sz = fromIntegral $ CertificateKey.privKey_lenmodulus privkeycert - , RSA.private_n = CertificateKey.privKey_modulus privkeycert - , RSA.private_d = CertificateKey.privKey_private_exponant privkeycert - , RSA.private_p = CertificateKey.privKey_p1 privkeycert - , RSA.private_q = CertificateKey.privKey_p2 privkeycert - , RSA.private_dP = CertificateKey.privKey_exp1 privkeycert - , RSA.private_dQ = CertificateKey.privKey_exp2 privkeycert - , RSA.private_qinv = CertificateKey.privKey_coef privkeycert + { RSA.private_sz = fromIntegral $ KeyRSA.lenmodulus privkeycert + , RSA.private_n = KeyRSA.modulus privkeycert + , RSA.private_d = KeyRSA.private_exponant privkeycert + , RSA.private_p = KeyRSA.p1 privkeycert + , RSA.private_q = KeyRSA.p2 privkeycert + , RSA.private_dP = KeyRSA.exp1 privkeycert + , RSA.private_dQ = KeyRSA.exp2 privkeycert + , RSA.private_qinv = KeyRSA.coef privkeycert } setPrivateKey privkey diff --git a/Network/TLS/State.hs b/Network/TLS/State.hs --- a/Network/TLS/State.hs +++ b/Network/TLS/State.hs @@ -44,7 +44,7 @@ import Data.Word import Data.List (find) -import Data.Maybe (fromJust, isNothing) +import Data.Maybe (isNothing) import Network.TLS.Util import Network.TLS.Struct import Network.TLS.SRandom @@ -150,14 +150,10 @@ makeDigest :: (MonadTLSState m) => Bool -> Header -> Bytes -> m Bytes makeDigest w hdr content = do st <- getTLSState - assert "make digest" - [ ("cipher", isNothing $ stCipher st) - , ("crypt state", isNothing $ if w then stTxCryptState st else stRxCryptState st) - , ("mac state", isNothing $ if w then stTxMacState st else stRxMacState st) ] let ver = stVersion st - let cst = fromJust $ if w then stTxCryptState st else stRxCryptState st - let ms = fromJust $ if w then stTxMacState st else stRxMacState st - let cipher = fromJust $ stCipher st + let cst = fromJust "crypt state" $ if w then stTxCryptState st else stRxCryptState st + let ms = fromJust "mac state" $ if w then stTxMacState st else stRxMacState st + let cipher = fromJust "cipher" $ stCipher st let machash = cipherMACHash cipher let (macF, msg) = @@ -266,11 +262,9 @@ setMasterSecret premastersecret = do st <- getTLSState hasValidHandshake "master secret" - assert "set master secret" - [ ("server random", (isNothing $ hstServerRandom $ fromJust $ stHandshake st)) ] updateHandshake "master secret" (\hst -> - let ms = generateMasterSecret (stVersion st) premastersecret (hstClientRandom hst) (fromJust $ hstServerRandom hst) in + let ms = generateMasterSecret (stVersion st) premastersecret (hstClientRandom hst) (fromJust "server random" $ hstServerRandom hst) in hst { hstMasterSecret = Just ms } ) return () @@ -284,25 +278,20 @@ setKeyBlock = do st <- getTLSState - let hst = fromJust $ stHandshake st - assert "set key block" - [ ("cipher", (isNothing $ stCipher st)) - , ("server random", (isNothing $ hstServerRandom hst)) - , ("master secret", (isNothing $ hstMasterSecret hst)) - ] + let hst = fromJust "handshake" $ stHandshake st let cc = stClientContext st - let cipher = fromJust $ stCipher st + let cipher = fromJust "cipher" $ stCipher st let keyblockSize = fromIntegral $ cipherKeyBlockSize cipher - let digestSize = fromIntegral $ cipherDigestSize cipher - let keySize = fromIntegral $ cipherKeySize cipher - let ivSize = fromIntegral $ cipherIVSize cipher + let digestSize = fromIntegral $ cipherDigestSize cipher + let keySize = fromIntegral $ cipherKeySize cipher + let ivSize = fromIntegral $ cipherIVSize cipher let kb = generateKeyBlock (stVersion st) (hstClientRandom hst) - (fromJust $ hstServerRandom hst) - (fromJust $ hstMasterSecret hst) keyblockSize + (fromJust "server random" $ hstServerRandom hst) + (fromJust "master secret" $ hstMasterSecret hst) keyblockSize let (cMACSecret, sMACSecret, cWriteKey, sWriteKey, cWriteIV, sWriteIV) = - fromJust $ partition6 kb (digestSize, digestSize, keySize, keySize, ivSize, ivSize) + fromJust "p6" $ partition6 kb (digestSize, digestSize, keySize, keySize, ivSize, ivSize) let cstClient = TLSCryptState { cstKey = cWriteKey @@ -375,9 +364,9 @@ getHandshakeDigest :: MonadTLSState m => Bool -> m Bytes getHandshakeDigest client = do st <- getTLSState - let hst = fromJust $ stHandshake st - let (sha1ctx, md5ctx) = fromJust $ hstHandshakeDigest hst - let msecret = fromJust $ hstMasterSecret hst + let hst = fromJust "handshake" $ stHandshake st + let (sha1ctx, md5ctx) = fromJust "handshake digest" $ hstHandshakeDigest hst + let msecret = fromJust "master secret" $ hstMasterSecret hst return $ (if client then generateClientFinished else generateServerFinished) (stVersion st) msecret md5ctx sha1ctx endHandshake :: MonadTLSState m => m () diff --git a/Network/TLS/Struct.hs b/Network/TLS/Struct.hs --- a/Network/TLS/Struct.hs +++ b/Network/TLS/Struct.hs @@ -208,7 +208,7 @@ data Handshake = ClientHello !Version !ClientRandom !Session ![CipherID] ![CompressionID] (Maybe [Extension]) | ServerHello !Version !ServerRandom !Session !CipherID !CompressionID (Maybe [Extension]) - | Certificates [Certificate] + | Certificates [X509] | HelloRequest | ServerHelloDone | ClientKeyXchg Version ClientKeyData diff --git a/Network/TLS/Util.hs b/Network/TLS/Util.hs --- a/Network/TLS/Util.hs +++ b/Network/TLS/Util.hs @@ -3,10 +3,10 @@ , takelast , partition3 , partition6 + , fromJust ) where import Network.TLS.Struct (Bytes) -import Network.TLS.Wire import qualified Data.ByteString as B sub :: Bytes -> Int -> Int -> Maybe Bytes @@ -20,18 +20,24 @@ | otherwise = Nothing partition3 :: Bytes -> (Int,Int,Int) -> Maybe (Bytes, Bytes, Bytes) -partition3 bytes (d1,d2,d3) = either (const Nothing) Just $ (flip runGet) bytes $ do - p1 <- getBytes d1 - p2 <- getBytes d2 - p3 <- getBytes d3 - return (p1,p2,p3) +partition3 bytes (d1,d2,d3) = if B.length bytes /= s then Nothing else Just (p1,p2,p3) + where + s = sum [d1,d2,d3] + (p1, r1) = B.splitAt d1 bytes + (p2, r2) = B.splitAt d2 r1 + (p3, _) = B.splitAt d3 r2 partition6 :: Bytes -> (Int,Int,Int,Int,Int,Int) -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes, Bytes) -partition6 bytes (d1,d2,d3,d4,d5,d6) = either (const Nothing) Just $ (flip runGet) bytes $ do - p1 <- getBytes d1 - p2 <- getBytes d2 - p3 <- getBytes d3 - p4 <- getBytes d4 - p5 <- getBytes d5 - p6 <- getBytes d6 - return (p1,p2,p3,p4,p5,p6) +partition6 bytes (d1,d2,d3,d4,d5,d6) = if B.length bytes < s then Nothing else Just (p1,p2,p3,p4,p5,p6) + where + s = sum [d1,d2,d3,d4,d5,d6] + (p1, r1) = B.splitAt d1 bytes + (p2, r2) = B.splitAt d2 r1 + (p3, r3) = B.splitAt d3 r2 + (p4, r4) = B.splitAt d4 r3 + (p5, r5) = B.splitAt d5 r4 + (p6, _) = B.splitAt d6 r5 + +fromJust :: String -> Maybe a -> a +fromJust what Nothing = error ("fromJust " ++ what ++ ": Nothing") -- yuck +fromJust _ (Just x) = x diff --git a/Stunnel.hs b/Stunnel.hs --- a/Stunnel.hs +++ b/Stunnel.hs @@ -17,7 +17,7 @@ import Data.Certificate.PEM import Data.Certificate.X509 -import Data.Certificate.Key +import qualified Data.Certificate.KeyRSA as KeyRSA import Network.TLS.Cipher import Network.TLS.SRandom @@ -95,7 +95,7 @@ S.runTLSServer (tlsserver handle dsthandle) serverstate rng -readCertificate :: FilePath -> IO (B.ByteString, Certificate) +readCertificate :: FilePath -> IO (B.ByteString, X509) readCertificate filepath = do content <- B.readFile filepath let certdata = case parsePEMCert content of @@ -106,13 +106,13 @@ Right x -> x return (certdata, cert) -readPrivateKey :: FilePath -> IO (L.ByteString, PrivateKey) +readPrivateKey :: FilePath -> IO (L.ByteString, KeyRSA.Private) readPrivateKey filepath = do content <- B.readFile filepath let pkdata = case parsePEMKeyRSA content of Nothing -> error ("no valid RSA key section") Just x -> L.fromChunks [x] - let pk = case decodePrivateKey pkdata of + let pk = case KeyRSA.decodePrivate pkdata of Left err -> error ("cannot decode key: " ++ err) Right x -> x return (pkdata, pk) diff --git a/tls.cabal b/tls.cabal --- a/tls.cabal +++ b/tls.cabal @@ -1,5 +1,5 @@ Name: tls -Version: 0.3.2 +Version: 0.3.3 Description: native TLS protocol implementation, focusing on purity and more type-checking. . @@ -30,17 +30,16 @@ Default: False Library - Build-Depends: base >= 3 && < 7, - mtl, - cryptohash >= 0.6, - binary >= 0.5, - cereal >= 0.3, - bytestring, - vector, - AES, - crypto-api >= 0.2, - cryptocipher >= 0.2, - certificate >= 0.4 && < 0.5 + Build-Depends: base >= 3 && < 5 + , mtl + , cryptohash >= 0.6 + , binary >= 0.5 + , cereal >= 0.3 + , bytestring + , vector + , crypto-api >= 0.5 + , cryptocipher >= 0.2.5 + , certificate >= 0.7 && < 0.8 Exposed-modules: Network.TLS.Client Network.TLS.Server Network.TLS.Struct @@ -61,7 +60,8 @@ Executable stunnel Main-is: Stunnel.hs if flag(executable) - Build-Depends: network, cmdargs + Build-Depends: network + , cmdargs Buildable: True else Buildable: False @@ -71,7 +71,10 @@ Main-is: Tests.hs if flag(test) Buildable: True - Build-Depends: base >= 3 && < 7, HUnit, QuickCheck >= 2, bytestring + Build-Depends: base >= 3 && < 5 + , HUnit + , QuickCheck >= 2 + , bytestring else Buildable: False