tls 1.3.2 → 1.3.3
raw patch · 13 files changed
+223/−53 lines, 13 filesdep +hansdep ~cryptonitedep ~x509dep ~x509-validation
Dependencies added: hans
Dependency ranges changed: cryptonite, x509, x509-validation
Files
- CHANGELOG.md +16/−0
- Network/TLS.hs +3/−0
- Network/TLS/Backend.hs +35/−6
- Network/TLS/Context.hs +7/−0
- Network/TLS/Crypto.hs +62/−3
- Network/TLS/Extension.hs +1/−1
- Network/TLS/Extra/Cipher.hs +14/−2
- Network/TLS/Handshake/Client.hs +11/−13
- Network/TLS/Handshake/Signature.hs +13/−4
- Network/TLS/Packet.hs +40/−17
- Network/TLS/Parameters.hs +2/−2
- Network/TLS/Struct.hs +1/−0
- tls.cabal +18/−5
CHANGELOG.md view
@@ -1,3 +1,19 @@+## Version 1.3.3++- Add support for Hans (Haskell Network Stack) (Adam Wick)+- Add support for ECDSA signature+- Add support for ECDSA-ECDHE Cipher+- Improve parsing of ECC related structure++## Version 1.3.2++- Add cipher suites for forward secrecy on more clients (Aaron Friel)+- Maintain more handshake information to be queried by protocol (Adam Wick)+- handle SCSV on client and server side (Kazu Yamamoto)+- Cleanup renegotiation logic (Kazu Yamamoto)+- Various testing improvements with the openssl test parts+- Cleanup AEAD handling for future support of other ciphers+ ## Version 1.3.1 - Repair DHE RSA handling on the cipher by creating signature properly
Network/TLS.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS -- License : BSD-style@@ -48,7 +49,9 @@ -- * Creating a context , contextNew , contextNewOnHandle+#ifdef INCLUDE_NETWORK , contextNewOnSocket+#endif , contextFlush , contextClose , contextHookSetHandshakeRecv
Network/TLS/Backend.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Backend -- License : BSD-style@@ -20,13 +21,21 @@ , Backend(..) ) where -import Control.Monad-import Network.Socket (Socket, sClose)-import qualified Network.Socket.ByteString as Socket import Data.ByteString (ByteString) import qualified Data.ByteString as B import System.IO (Handle, hSetBuffering, BufferMode(..), hFlush, hClose) +#ifdef INCLUDE_NETWORK+import Control.Monad+import qualified Network.Socket as Network (Socket, sClose)+import qualified Network.Socket.ByteString as Network+#endif++#ifdef INCLUDE_HANS+import qualified Data.ByteString.Lazy as L+import qualified Hans.NetworkStack as Hans+#endif+ -- | Connection IO backend data Backend = Backend { backendFlush :: IO () -- ^ Flush the connection sending buffer, if any.@@ -43,16 +52,36 @@ initializeBackend _ = return () getBackend = id -instance HasBackend Socket where+#ifdef INCLUDE_NETWORK+instance HasBackend Network.Socket where initializeBackend _ = return ()- getBackend sock = Backend (return ()) (sClose sock) (Socket.sendAll sock) recvAll+ getBackend sock = Backend (return ()) (Network.sClose sock) (Network.sendAll sock) recvAll where recvAll n = B.concat `fmap` loop n where loop 0 = return [] loop left = do- r <- Socket.recv sock left+ r <- Network.recv sock left if B.null r then return [] else liftM (r:) (loop (left - B.length r))+#endif++#ifdef INCLUDE_HANS+instance HasBackend Hans.Socket where+ initializeBackend _ = return ()+ getBackend sock = Backend (return ()) (Hans.close sock) sendAll recvAll+ where sendAll x = do+ amt <- fromIntegral `fmap` Hans.sendBytes sock (L.fromStrict x)+ if (amt == 0) || (amt == B.length x)+ then return ()+ else sendAll (B.drop amt x)+ recvAll n = loop (fromIntegral n) L.empty+ loop 0 acc = return (L.toStrict acc)+ loop left acc = do+ r <- Hans.recvBytes sock left+ if L.null r+ then loop 0 acc+ else loop (left - L.length r) (acc `L.append` r)+#endif instance HasBackend Handle where initializeBackend handle = hSetBuffering handle NoBuffering
Network/TLS/Context.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Context -- License : BSD-style@@ -41,7 +42,9 @@ , contextNew -- * Deprecated new contexts methods , contextNewOnHandle+#ifdef INCLUDE_NETWORK , contextNewOnSocket+#endif -- * Context hooks , contextHookSetHandshakeRecv@@ -80,7 +83,9 @@ import Data.IORef -- deprecated imports+#ifdef INCLUDE_NETWORK import Network.Socket (Socket)+#endif import System.IO (Handle) class TLSParams a where@@ -194,6 +199,7 @@ contextNewOnHandle handle params = contextNew handle params {-# DEPRECATED contextNewOnHandle "use contextNew" #-} +#ifdef INCLUDE_NETWORK -- | create a new context on a socket. contextNewOnSocket :: (MonadIO m, TLSParams params) => Socket -- ^ Socket of the connection.@@ -201,6 +207,7 @@ -> m Context contextNewOnSocket sock params = contextNew sock params {-# DEPRECATED contextNewOnSocket "use contextNew" #-}+#endif contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO () contextHookSetHandshakeRecv context f =
Network/TLS/Crypto.hs view
@@ -36,16 +36,22 @@ import Data.ByteString (ByteString) import Crypto.Random import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Prim as ECC+import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA+import Crypto.Number.Serialize (os2ip)+import Crypto.Number.Basic (numBits) -import Data.X509 (PrivKey(..), PubKey(..))+import Data.X509 (PrivKey(..), PubKey(..), PubKeyEC(..), SerializedPoint(..)) import Network.TLS.Crypto.DH import Network.TLS.Crypto.ECDH import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding (DER(..), BER(..))+import Data.List (find) {-# DEPRECATED PublicKey "use PubKey" #-} type PublicKey = PubKey@@ -168,6 +174,59 @@ Just $ DSA.Signature { DSA.sign_r = r, DSA.sign_s = s } _ -> Nothing+kxVerify (PubKeyEC key) alg msg sigBS = maybe False id $ do+ -- get the curve name and the public key data+ (curveName, pubBS) <- case key of+ PubKeyEC_Named curveName' pub -> Just (curveName',pub)+ PubKeyEC_Prime {} ->+ case find matchPrimeCurve $ enumFrom $ toEnum 0 of+ Nothing -> Nothing+ Just curveName' -> Just (curveName', pubkeyEC_pub key)+ -- decode the signature+ signature <- case decodeASN1' BER sigBS of+ Left _ -> Nothing+ Right [Start Sequence,IntVal r,IntVal s,End Sequence] -> Just $ ECDSA.Signature r s+ Right _ -> Nothing++ -- decode the public key related to the curve+ pubkey <- unserializePoint (ECC.getCurveByName curveName) pubBS++ verifyF <- case alg of+ MD5 -> Just (ECDSA.verify H.MD5)+ SHA1 -> Just (ECDSA.verify H.SHA1)+ SHA224 -> Just (ECDSA.verify H.SHA224)+ SHA256 -> Just (ECDSA.verify H.SHA256)+ SHA384 -> Just (ECDSA.verify H.SHA384)+ SHA512 -> Just (ECDSA.verify H.SHA512)+ _ -> Nothing+ return $ verifyF pubkey signature msg+ where+ matchPrimeCurve c =+ case ECC.getCurveByName c of+ ECC.CurveFP (ECC.CurvePrime p cc) ->+ ECC.ecc_a cc == pubkeyEC_a key &&+ ECC.ecc_b cc == pubkeyEC_b key &&+ ECC.ecc_n cc == pubkeyEC_order key &&+ p == pubkeyEC_prime key+ _ -> False++ unserializePoint curve (SerializedPoint bs) =+ case B.uncons bs of+ Nothing -> Nothing+ Just (ptFormat, input) ->+ case ptFormat of+ 4 -> if B.length bs == 2 * bytes+ then Nothing+ else+ let (x, y) = B.splitAt bytes input+ p = ECC.Point (os2ip x) (os2ip y)+ in if ECC.isPointValid curve p+ then Just $ ECDSA.PublicKey curve p+ else Nothing+ -- 2 and 3 for compressed format.+ _ -> Nothing+ where bits = numBits . ECC.ecc_n . ECC.common_curve $ curve+ bytes = (bits + 7) `div` 8 kxVerify _ _ _ _ = False -- Sign the given message using the private key.@@ -183,8 +242,8 @@ sign <- DSA.sign pk H.SHA1 msg return (Right $ encodeASN1' DER $ dsaSequence sign) where dsaSequence sign = [Start Sequence,IntVal (DSA.sign_r sign),IntVal (DSA.sign_s sign),End Sequence]---kxSign g _ _ _ =--- (Left KxUnsupported, g)+--kxSign _ _ _ =+-- return (Left KxUnsupported) rsaSignHash :: MonadRandom m => Hash -> RSA.PrivateKey -> ByteString -> m (Either RSA.Error ByteString) rsaSignHash SHA1_MD5 pk msg = RSA.signSafer noHash pk msg
Network/TLS/Extension.hs view
@@ -54,8 +54,8 @@ import Network.TLS.Struct (ExtensionID, EnumSafe8(..), EnumSafe16(..), HashAndSignatureAlgorithm) import Network.TLS.Wire import Network.TLS.Packet (putSignatureHashAlgorithm, getSignatureHashAlgorithm)-import Network.BSD (HostName) +type HostName = String -- central list defined in <http://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.txt> extensionID_ServerName
Network/TLS/Extra/Cipher.hs view
@@ -37,6 +37,7 @@ , cipher_ECDHE_RSA_AES128GCM_SHA256 , cipher_ECDHE_RSA_AES128CBC_SHA256 , cipher_ECDHE_RSA_AES128CBC_SHA+ , cipher_ECDHE_ECDSA_AES128GCM_SHA256 ) where import qualified Data.ByteString as B@@ -117,7 +118,9 @@ -- this choice of ciphersuite should satisfy most normal need ciphersuite_all :: [Cipher] ciphersuite_all =- [ cipher_DHE_RSA_AES256_SHA256, cipher_DHE_RSA_AES128_SHA256+ [ cipher_ECDHE_RSA_AES128GCM_SHA256+ , cipher_ECDHE_ECDSA_AES128GCM_SHA256+ , cipher_DHE_RSA_AES256_SHA256, cipher_DHE_RSA_AES128_SHA256 , cipher_DHE_RSA_AES256_SHA1, cipher_DHE_RSA_AES128_SHA1 , cipher_DHE_DSS_AES256_SHA1, cipher_DHE_DSS_AES128_SHA1 , cipher_AES128_SHA256, cipher_AES256_SHA256@@ -133,7 +136,7 @@ -- | the strongest ciphers supported. ciphersuite_strong :: [Cipher]-ciphersuite_strong = [cipher_DHE_RSA_AES256_SHA256, cipher_AES256_SHA256, cipher_AES256_SHA1]+ciphersuite_strong = [cipher_ECDHE_RSA_AES128GCM_SHA256, cipher_ECDHE_ECDSA_AES128GCM_SHA256, cipher_DHE_RSA_AES256_SHA256, cipher_AES256_SHA256, cipher_AES256_SHA1] -- | DHE-RSA cipher suite ciphersuite_dhe_rsa :: [Cipher]@@ -411,6 +414,15 @@ , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 } +cipher_ECDHE_ECDSA_AES128GCM_SHA256 :: Cipher+cipher_ECDHE_ECDSA_AES128GCM_SHA256 = Cipher+ { cipherID = 0xc02b+ , cipherName = "ECDHE-ECDSA-AES128GCM-SHA256"+ , cipherBulk = bulk_aes128gcm+ , cipherHash = SHA256+ , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA+ , cipherMinVer = Just TLS12 -- RFC 5289+ } {- TLS 1.0 ciphers definition
Network/TLS/Handshake/Client.hs view
@@ -67,13 +67,11 @@ ,secureReneg ,npnExtention ,alpnExtension- {-- ,curveExtension,+ ,curveExtension ,ecPointExtension- ,sessionTicketExtension- ,heartbeatExtension- -}+ --,sessionTicketExtension ,signatureAlgExtension+ -- ,heartbeatExtension ] toExtensionRaw :: Extension e => e -> ExtensionRaw@@ -97,14 +95,11 @@ then return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName $ fst $ clientServerIdentification cparams] else return Nothing - {-- curveExtension = return $ Just $ toExtensionRaw $ EllipticCurvesSupported [NamedCurve_secp256k1,NamedCurve_secp256r1]- ecPointExtension = return $ Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed,EcPointFormat_AnsiX962_compressed_prime,EcPointFormat_AnsiX962_compressed_char2]-- sessionTicketExtension = return $ Just $ toExtensionRaw $ SessionTicket-- heartbeatExtension = return $ Just $ toExtensionRaw $ HeartBeat $ HeartBeat_PeerAllowedToSend- -}+ curveExtension = return $ Just $ toExtensionRaw $ EllipticCurvesSupported availableEllipticCurves+ ecPointExtension = return $ Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed]+ --[EcPointFormat_Uncompressed,EcPointFormat_AnsiX962_compressed_prime,EcPointFormat_AnsiX962_compressed_char2]+ --heartbeatExtension = return $ Just $ toExtensionRaw $ HeartBeat $ HeartBeat_PeerAllowedToSend+ --sessionTicketExtension = return $ Just $ toExtensionRaw $ SessionTicket signatureAlgExtension = return $ Just $ toExtensionRaw $ SignatureAlgorithms $ supportedHashSignatures $ clientSupported cparams @@ -205,6 +200,7 @@ CipherKeyExchange_DHE_RSA -> getCKX_DHE CipherKeyExchange_DHE_DSS -> getCKX_DHE CipherKeyExchange_ECDHE_RSA -> getCKX_ECDHE+ CipherKeyExchange_ECDHE_ECDSA -> getCKX_ECDHE _ -> throwCore $ Error_Protocol ("client key exchange unsupported type", True, HandshakeFailure) sendPacket ctx $ Handshake [ClientKeyXchg ckx] where getCKX_DHE = do@@ -380,6 +376,8 @@ doDHESignature dhparams signature SignatureDSS (CipherKeyExchange_ECDHE_RSA, SKX_ECDHE_RSA ecdhparams signature) -> do doECDHESignature ecdhparams signature SignatureRSA+ (CipherKeyExchange_ECDHE_ECDSA, SKX_ECDHE_ECDSA ecdhparams signature) -> do+ doECDHESignature ecdhparams signature SignatureECDSA (cke, SKX_Unparsed bytes) -> do ver <- usingState_ ctx getVersion case decodeReallyServerKeyXchgAlgorithmData ver cke bytes of
Network/TLS/Handshake/Signature.hs view
@@ -82,12 +82,20 @@ Just HashSHA256 -> SHA256 Just HashSHA1 -> SHA1 Nothing -> SHA1_MD5- _ -> error ("unimplemented signature hash type")+ Just hash -> error ("unimplemented RSA signature hash type: " ++ show hash) signatureHashData SignatureDSS mhash = case mhash of Nothing -> SHA1 Just HashSHA1 -> SHA1 Just _ -> error "invalid DSA hash choice, only SHA1 allowed"+signatureHashData SignatureECDSA mhash =+ case mhash of+ Just HashSHA512 -> SHA512+ Just HashSHA384 -> SHA384+ Just HashSHA256 -> SHA256+ Just HashSHA1 -> SHA1+ Nothing -> SHA1_MD5+ Just hash -> error ("unimplemented ECDSA signature hash type: " ++ show hash) signatureHashData sig _ = error ("unimplemented signature type: " ++ show sig) --signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm -> HashDescr -> Bytes -> IO DigitallySigned@@ -124,9 +132,10 @@ signatureVerifyWithHashDescr ctx sigAlgExpected (DigitallySigned _ bs) (hashDescr, toVerify) = do cc <- usingState_ ctx $ isClientContext case sigAlgExpected of- SignatureRSA -> verifyRSA ctx cc hashDescr toVerify bs- SignatureDSS -> verifyRSA ctx cc hashDescr toVerify bs- _ -> error "not implemented yet"+ SignatureRSA -> verifyRSA ctx cc hashDescr toVerify bs+ SignatureDSS -> verifyRSA ctx cc hashDescr toVerify bs+ SignatureECDSA -> verifyRSA ctx cc hashDescr toVerify bs+ _ -> error "signature verification not implemented yet" digitallySignParams :: Context -> Bytes -> SignatureAlgorithm -> IO DigitallySigned digitallySignParams ctx signatureData sigAlg = do
Network/TLS/Packet.hs view
@@ -291,17 +291,21 @@ parseCKE CipherKeyExchange_DHE_DSS = parseClientDHPublic parseCKE CipherKeyExchange_DH_Anon = parseClientDHPublic parseCKE CipherKeyExchange_ECDHE_RSA = parseClientECDHPublic+ parseCKE CipherKeyExchange_ECDHE_ECDSA = parseClientECDHPublic parseCKE _ = error "unsupported client key exchange type" parseClientDHPublic = CKX_DH . dhPublic <$> getInteger16 parseClientECDHPublic = do- len <- getWord8- _ <- getWord8 -- Magic number 4- let siz = fromIntegral len `div` 2- xb <- getBytes siz- yb <- getBytes siz- let x = os2ip xb- y = os2ip yb- return $ CKX_ECDH $ ecdhPublic x y siz+ len <- getWord8+ formatTy <- getWord8+ case formatTy of+ 4 -> do -- uncompressed+ let siz = fromIntegral len `div` 2+ xb <- getBytes siz+ yb <- getBytes siz+ let x = os2ip xb+ y = os2ip yb+ return $ CKX_ECDH $ ecdhPublic x y siz+ _ -> error ("unsupported EC format type: " ++ show formatTy) decodeServerKeyXchg_DH :: Get ServerDHParams decodeServerKeyXchg_DH = getServerDHParams@@ -332,6 +336,10 @@ dhparams <- getServerECDHParams signature <- getDigitallySigned ver return $ SKX_ECDHE_RSA dhparams signature+ CipherKeyExchange_ECDHE_ECDSA -> do+ dhparams <- getServerECDHParams+ signature <- getDigitallySigned ver+ return $ SKX_ECDHE_ECDSA dhparams signature _ -> do bs <- remaining >>= getBytes return $ SKX_Unknown bs@@ -395,6 +403,7 @@ SKX_DHE_RSA params sig -> putServerDHParams params >> putDigitallySigned sig SKX_DHE_DSS params sig -> putServerDHParams params >> putDigitallySigned sig SKX_ECDHE_RSA params sig -> putServerECDHParams params >> putDigitallySigned sig+ SKX_ECDHE_ECDSA params sig -> putServerECDHParams params >> putDigitallySigned sig SKX_Unparsed bytes -> putBytes bytes _ -> error ("encodeHandshakeContent: cannot handle: " ++ show skg) @@ -490,15 +499,29 @@ getServerECDHParams :: Get ServerECDHParams getServerECDHParams = do- _ <- getWord8 -- ECParameters ECCurveType: curve name type, should be 3- w16 <- getWord16 -- ECParameters NamedCurve- mxy <- getOpaque16 -- ECPoint- let xy = B.drop 1 mxy- siz = B.length xy `div` 2- (xb,yb) = B.splitAt siz xy- x = os2ip xb- y = os2ip yb- return $ ServerECDHParams (ecdhParams w16) (ecdhPublic x y siz)+ curveType <- getWord8+ case curveType of+ 1 -> do -- explicit prime+ _prime <- getOpaque8+ _a <- getOpaque8+ _b <- getOpaque8+ _base <- getOpaque8+ _order <- getOpaque8+ _cofactor <- getOpaque8+ error "cannot handle explicit prime ECDH Params"+ 2 -> -- explicit_char2+ error "cannot handle explicit char2 ECDH Params"+ 3 -> do -- ECParameters ECCurveType: curve name type+ w16 <- getWord16 -- ECParameters NamedCurve+ mxy <- getOpaque8 -- ECPoint+ let xy = B.drop 1 mxy+ siz = B.length xy `div` 2+ (xb,yb) = B.splitAt siz xy+ x = os2ip xb+ y = os2ip yb+ return $ ServerECDHParams (ecdhParams w16) (ecdhPublic x y siz)+ _ ->+ error "unknown type for ECDH Params" putServerECDHParams :: ServerECDHParams -> Put putServerECDHParams (ServerECDHParams ecdhparams ecdhpub) = do
Network/TLS/Parameters.hs view
@@ -22,8 +22,6 @@ , CertificateRejectReason(..) ) where -import Network.BSD (HostName)- import Network.TLS.Extension import Network.TLS.Struct import qualified Network.TLS.Struct as Struct@@ -37,6 +35,8 @@ import Data.Monoid import Data.Default.Class import qualified Data.ByteString as B++type HostName = String type CommonParams = (Supported, Shared)
Network/TLS/Struct.hs view
@@ -285,6 +285,7 @@ | SKX_DHE_DSS ServerDHParams DigitallySigned | SKX_DHE_RSA ServerDHParams DigitallySigned | SKX_ECDHE_RSA ServerECDHParams DigitallySigned+ | SKX_ECDHE_ECDSA ServerECDHParams DigitallySigned | SKX_RSA (Maybe ServerRSAParams) | SKX_DH_DSS (Maybe ServerRSAParams) | SKX_DH_RSA (Maybe ServerRSAParams)
tls.cabal view
@@ -1,5 +1,5 @@ Name: tls-Version: 1.3.2+Version: 1.3.3 Description: Native Haskell TLS and SSL protocol implementation for server and client. .@@ -31,24 +31,37 @@ Description: Accept SSLv2 compatible handshake Default: True +Flag network+ Description: Use the base network library+ Default: True++Flag hans+ Description: Use the Haskell Network Stack (HaNS)+ Default: False+ Library Build-Depends: base >= 3 && < 5 , mtl , transformers , cereal >= 0.4 , bytestring- , network , data-default-class -- crypto related , memory- , cryptonite >= 0.3+ , cryptonite >= 0.7 -- certificate related , asn1-types >= 0.2.0 , asn1-encoding- , x509 >= 1.6 && < 1.7.0+ , x509 >= 1.6.2 && < 1.7.0 , x509-store >= 1.6- , x509-validation >= 1.6 && < 1.7.0+ , x509-validation >= 1.6.3 && < 1.7.0 , async+ if flag(network)+ Build-Depends: network+ cpp-options: -DINCLUDE_NETWORK+ if flag(hans)+ Build-Depends: hans+ cpp-options: -DINCLUDE_HANS Exposed-modules: Network.TLS Network.TLS.Cipher Network.TLS.Compression