Negotiated FFDHE parameters

core/Network/TLS.hs

@@ -15,6 +15,7 @@ module Network.TLS
     , ServerParams(..)
     , DebugParams(..)
     , DHParams
+    , DHPublic
     , ClientHooks(..)
     , ServerHooks(..)
     , Supported(..)
@@ -23,6 +24,7 @@ module Network.TLS
     , Handshake
     , Logging(..)
     , Measurement(..)
+    , GroupUsage(..)
     , CertificateUsage(..)
     , CertificateRejectReason(..)
     , defaultParamsClient
@@ -137,7 +139,7 @@ import Network.TLS.Struct ( TLSError(..), TLSException(..)
                           , AlertDescription(..)
                           , ClientRandom(..), ServerRandom(..)
                           , Handshake)
-import Network.TLS.Crypto (KxError(..), DHParams, Group(..))
+import Network.TLS.Crypto (KxError(..), DHParams, DHPublic, Group(..))
 import Network.TLS.Cipher
 import Network.TLS.Hooks
 import Network.TLS.Measurement

core/Network/TLS/Crypto.hs

@@ -26,6 +26,7 @@ module Network.TLS.Crypto
     , PrivateKey
     , SignatureParams(..)
     , findDigitalSignatureAlg
+    , findFiniteFieldGroup
     , kxEncrypt
     , kxDecrypt
     , kxSign
@@ -38,6 +39,7 @@ import qualified Crypto.Hash as H
 import qualified Data.ByteString as B
 import qualified Data.ByteArray as B (convert)
 import Crypto.Random
+import qualified Crypto.PubKey.DH as DH
 import qualified Crypto.PubKey.DSA as DSA
 import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
 import qualified Crypto.PubKey.ECC.Prim as ECC
@@ -75,6 +77,15 @@ findDigitalSignatureAlg keyPair =
         --(PubKeyECDSA   _, PrivKeyECDSA    _)  -> Just ECDSA
         _                                     -> Nothing
 
+findFiniteFieldGroup :: DH.Params -> Maybe Group
+findFiniteFieldGroup params = lookup (pg params) table
+  where
+    pg (DH.Params p g _) = (p, g)
+
+    table = [ (pg prms, grp) | grp <- availableFFGroups
+                             , let Just prms = dhParamsForGroup grp
+            ]
+
 -- functions to use the hidden class.
 hashInit :: Hash -> HashContext
 hashInit MD5      = HashContext $ ContextSimple (H.hashInit :: H.Context H.MD5)

core/Network/TLS/Crypto/DH.hs

@@ -4,6 +4,7 @@ module Network.TLS.Crypto.DH
       DHParams
     , DHPublic
     , DHPrivate
+    , DHKey
 
     -- * DH methods
     , dhPublic
@@ -13,6 +14,7 @@ module Network.TLS.Crypto.DH
     , dhParamsGetG
     , dhGenerateKeyPair
     , dhGetShared
+    , dhValid
     , dhUnwrap
     , dhUnwrapPublic
     ) where
@@ -39,7 +41,7 @@ dhParams p g = DH.Params p g (numBits p)
 dhGenerateKeyPair :: MonadRandom r => DHParams -> r (DHPrivate, DHPublic)
 dhGenerateKeyPair params = do
     priv <- DH.generatePrivate params
-    let pub        = DH.generatePublic params priv
+    let pub        = DH.calculatePublic params priv
     return (priv, pub)
 
 dhGetShared :: DHParams -> DHPrivate -> DHPublic -> DHKey
@@ -50,6 +52,12 @@ dhGetShared params priv pub =
     -- for DH(E) premaster secret in SSL/TLS before version 1.3.
     stripLeadingZeros (DH.SharedKey sb) = DH.SharedKey (snd $ B.span (== 0) sb)
 
+-- Check that group element in not in the 2-element subgroup { 1, p - 1 }.
+-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1.
+-- This verification is enough when using a safe prime.
+dhValid :: DHParams -> Integer -> Bool
+dhValid (DH.Params p _ _) y = 1 < y && y < p - 1
+
 dhUnwrap :: DHParams -> DHPublic -> [Integer]
 dhUnwrap (DH.Params p g _) (DH.PublicNumber y) = [p,g,y]
 

core/Network/TLS/Crypto/IES.hs

@@ -16,13 +16,19 @@ module Network.TLS.Crypto.IES
     , groupGetShared
     , encodeGroupPublic
     , decodeGroupPublic
+    -- * Compatibility with 'Network.TLS.Crypto.DH'
+    , dhParamsForGroup
+    , dhGroupGenerateKeyPair
+    , dhGroupGetPubShared
     ) where
 
 import Control.Arrow
 import Crypto.ECC
 import Crypto.Error
-import Crypto.PubKey.DH
+import Crypto.Number.Generate
+import Crypto.PubKey.DH hiding (generateParams)
 import Crypto.PubKey.ECIES
+import qualified Data.ByteArray as B
 import Data.Proxy
 import Network.TLS.Crypto.Types
 import Network.TLS.Extra.FFDHE
@@ -71,6 +77,14 @@ x25519 = Proxy
 x448 :: Proxy Curve_X448
 x448 = Proxy
 
+dhParamsForGroup :: Group -> Maybe Params
+dhParamsForGroup FFDHE2048 = Just ffdhe2048
+dhParamsForGroup FFDHE3072 = Just ffdhe3072
+dhParamsForGroup FFDHE4096 = Just ffdhe4096
+dhParamsForGroup FFDHE6144 = Just ffdhe6144
+dhParamsForGroup FFDHE8192 = Just ffdhe8192
+dhParamsForGroup _         = Nothing
+
 groupGenerateKeyPair :: MonadRandom r => Group -> r (GroupPrivate, GroupPublic)
 groupGenerateKeyPair P256   =
     (GroupPri_P256,GroupPub_P256) `fs` curveGenerateKeyPair p256
@@ -82,11 +96,22 @@ groupGenerateKeyPair X25519 =
     (GroupPri_X255,GroupPub_X255) `fs` curveGenerateKeyPair x25519
 groupGenerateKeyPair X448 =
     (GroupPri_X448,GroupPub_X448) `fs` curveGenerateKeyPair x448
-groupGenerateKeyPair FFDHE2048 = gen ffdhe2048 GroupPri_FFDHE2048 GroupPub_FFDHE2048
-groupGenerateKeyPair FFDHE3072 = gen ffdhe3072 GroupPri_FFDHE3072 GroupPub_FFDHE3072
-groupGenerateKeyPair FFDHE4096 = gen ffdhe4096 GroupPri_FFDHE4096 GroupPub_FFDHE4096
-groupGenerateKeyPair FFDHE6144 = gen ffdhe6144 GroupPri_FFDHE6144 GroupPub_FFDHE6144
-groupGenerateKeyPair FFDHE8192 = gen ffdhe8192 GroupPri_FFDHE8192 GroupPub_FFDHE8192
+groupGenerateKeyPair FFDHE2048 = gen ffdhe2048 exp2048 GroupPri_FFDHE2048 GroupPub_FFDHE2048
+groupGenerateKeyPair FFDHE3072 = gen ffdhe3072 exp3072 GroupPri_FFDHE3072 GroupPub_FFDHE3072
+groupGenerateKeyPair FFDHE4096 = gen ffdhe4096 exp4096 GroupPri_FFDHE4096 GroupPub_FFDHE4096
+groupGenerateKeyPair FFDHE6144 = gen ffdhe6144 exp6144 GroupPri_FFDHE6144 GroupPub_FFDHE6144
+groupGenerateKeyPair FFDHE8192 = gen ffdhe8192 exp8192 GroupPri_FFDHE8192 GroupPub_FFDHE8192
+
+dhGroupGenerateKeyPair :: MonadRandom r => Group -> r (Params, PrivateNumber, PublicNumber)
+dhGroupGenerateKeyPair FFDHE2048 = addParams ffdhe2048 (gen' ffdhe2048 exp2048)
+dhGroupGenerateKeyPair FFDHE3072 = addParams ffdhe3072 (gen' ffdhe3072 exp3072)
+dhGroupGenerateKeyPair FFDHE4096 = addParams ffdhe4096 (gen' ffdhe4096 exp4096)
+dhGroupGenerateKeyPair FFDHE6144 = addParams ffdhe6144 (gen' ffdhe6144 exp6144)
+dhGroupGenerateKeyPair FFDHE8192 = addParams ffdhe8192 (gen' ffdhe8192 exp8192)
+dhGroupGenerateKeyPair grp       = error ("invalid FFDHE group: " ++ show grp)
+
+addParams :: Functor f => Params -> f (a, b) -> f (Params, a, b)
+addParams params = fmap $ \(a, b) -> (params, a, b)
 
 fs :: MonadRandom r
    => (Scalar a -> GroupPrivate, Point a -> GroupPublic)
@@ -100,13 +125,17 @@ fs :: MonadRandom r
 
 gen :: MonadRandom r
     => Params
+    -> Int
     -> (PrivateNumber -> GroupPrivate)
     -> (PublicNumber -> GroupPublic)
     -> r (GroupPrivate, GroupPublic)
-gen params priTag pubTag = do
-    pri <- generatePrivate params
-    let pub = calculatePublic params pri
-    return (priTag pri, pubTag pub)
+gen params expBits priTag pubTag = (priTag *** pubTag) <$> gen' params expBits
+
+gen' :: MonadRandom r
+     => Params
+     -> Int
+     -> r (PrivateNumber, PublicNumber)
+gen' params expBits = (id &&& calculatePublic params) <$> generatePriv expBits
 
 groupGetPubShared :: MonadRandom r => GroupPublic -> r (Maybe (GroupPublic, GroupKey))
 groupGetPubShared (GroupPub_P256 pub) =
@@ -119,38 +148,62 @@ groupGetPubShared (GroupPub_X255 pub) =
     fmap (first GroupPub_X255) . maybeCryptoError <$> deriveEncrypt x25519 pub
 groupGetPubShared (GroupPub_X448 pub) =
     fmap (first GroupPub_X448) . maybeCryptoError <$> deriveEncrypt x448 pub
-groupGetPubShared (GroupPub_FFDHE2048 pub) = getPubShared ffdhe2048 pub GroupPub_FFDHE2048
-groupGetPubShared (GroupPub_FFDHE3072 pub) = getPubShared ffdhe3072 pub GroupPub_FFDHE3072
-groupGetPubShared (GroupPub_FFDHE4096 pub) = getPubShared ffdhe4096 pub GroupPub_FFDHE4096
-groupGetPubShared (GroupPub_FFDHE6144 pub) = getPubShared ffdhe6144 pub GroupPub_FFDHE6144
-groupGetPubShared (GroupPub_FFDHE8192 pub) = getPubShared ffdhe8192 pub GroupPub_FFDHE8192
+groupGetPubShared (GroupPub_FFDHE2048 pub) = getPubShared ffdhe2048 exp2048 pub GroupPub_FFDHE2048
+groupGetPubShared (GroupPub_FFDHE3072 pub) = getPubShared ffdhe3072 exp3072 pub GroupPub_FFDHE3072
+groupGetPubShared (GroupPub_FFDHE4096 pub) = getPubShared ffdhe4096 exp4096 pub GroupPub_FFDHE4096
+groupGetPubShared (GroupPub_FFDHE6144 pub) = getPubShared ffdhe6144 exp6144 pub GroupPub_FFDHE6144
+groupGetPubShared (GroupPub_FFDHE8192 pub) = getPubShared ffdhe8192 exp8192 pub GroupPub_FFDHE8192
+
+dhGroupGetPubShared :: MonadRandom r => Group -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
+dhGroupGetPubShared FFDHE2048 pub = getPubShared' ffdhe2048 exp2048 pub
+dhGroupGetPubShared FFDHE3072 pub = getPubShared' ffdhe3072 exp3072 pub
+dhGroupGetPubShared FFDHE4096 pub = getPubShared' ffdhe4096 exp4096 pub
+dhGroupGetPubShared FFDHE6144 pub = getPubShared' ffdhe6144 exp6144 pub
+dhGroupGetPubShared FFDHE8192 pub = getPubShared' ffdhe8192 exp8192 pub
+dhGroupGetPubShared _         _   = return Nothing
 
 getPubShared :: MonadRandom r
              => Params
+             -> Int
              -> PublicNumber
              -> (PublicNumber -> GroupPublic)
              -> r (Maybe (GroupPublic, GroupKey))
-getPubShared params pub pubTag = do
-    mypri <- generatePrivate params
+getPubShared params expBits pub pubTag | not (valid params pub) = return Nothing
+                                       | otherwise = do
+    mypri <- generatePriv expBits
     let mypub = calculatePublic params mypri
     let SharedKey share = getShared params mypri pub
     return $ Just (pubTag mypub, SharedSecret share)
 
+getPubShared' :: MonadRandom r
+              => Params
+              -> Int
+              -> PublicNumber
+              -> r (Maybe (PublicNumber, SharedKey))
+getPubShared' params expBits pub
+    | not (valid params pub) = return Nothing
+    | otherwise = do
+        mypri <- generatePriv expBits
+        let share = stripLeadingZeros (getShared params mypri pub)
+        return $ Just (calculatePublic params mypri, SharedKey share)
+
 groupGetShared ::  GroupPublic -> GroupPrivate -> Maybe GroupKey
 groupGetShared (GroupPub_P256 pub) (GroupPri_P256 pri) = maybeCryptoError $ deriveDecrypt p256 pub pri
 groupGetShared (GroupPub_P384 pub) (GroupPri_P384 pri) = maybeCryptoError $ deriveDecrypt p384 pub pri
 groupGetShared (GroupPub_P521 pub) (GroupPri_P521 pri) = maybeCryptoError $ deriveDecrypt p521 pub pri
 groupGetShared (GroupPub_X255 pub) (GroupPri_X255 pri) = maybeCryptoError $ deriveDecrypt x25519 pub pri
 groupGetShared (GroupPub_X448 pub) (GroupPri_X448 pri) = maybeCryptoError $ deriveDecrypt x448 pub pri
-groupGetShared (GroupPub_FFDHE2048 pub) (GroupPri_FFDHE2048 pri) = Just $ calcShared ffdhe2048 pub pri
-groupGetShared (GroupPub_FFDHE3072 pub) (GroupPri_FFDHE3072 pri) = Just $ calcShared ffdhe3072 pub pri
-groupGetShared (GroupPub_FFDHE4096 pub) (GroupPri_FFDHE4096 pri) = Just $ calcShared ffdhe4096 pub pri
-groupGetShared (GroupPub_FFDHE6144 pub) (GroupPri_FFDHE6144 pri) = Just $ calcShared ffdhe6144 pub pri
-groupGetShared (GroupPub_FFDHE8192 pub) (GroupPri_FFDHE8192 pri) = Just $ calcShared ffdhe8192 pub pri
+groupGetShared (GroupPub_FFDHE2048 pub) (GroupPri_FFDHE2048 pri) = calcShared ffdhe2048 pub pri
+groupGetShared (GroupPub_FFDHE3072 pub) (GroupPri_FFDHE3072 pri) = calcShared ffdhe3072 pub pri
+groupGetShared (GroupPub_FFDHE4096 pub) (GroupPri_FFDHE4096 pri) = calcShared ffdhe4096 pub pri
+groupGetShared (GroupPub_FFDHE6144 pub) (GroupPri_FFDHE6144 pri) = calcShared ffdhe6144 pub pri
+groupGetShared (GroupPub_FFDHE8192 pub) (GroupPri_FFDHE8192 pri) = calcShared ffdhe8192 pub pri
 groupGetShared _ _ = Nothing
 
-calcShared :: Params -> PublicNumber -> PrivateNumber -> SharedSecret
-calcShared params pub pri = SharedSecret share
+calcShared :: Params -> PublicNumber -> PrivateNumber -> Maybe SharedSecret
+calcShared params pub pri
+    | valid params pub = Just $ SharedSecret share
+    | otherwise        = Nothing
   where
     SharedKey share = getShared params pri pub
 
@@ -180,3 +233,31 @@ decodeGroupPublic FFDHE3072 bs = Right . GroupPub_FFDHE3072 . PublicNumber $ os2
 decodeGroupPublic FFDHE4096 bs = Right . GroupPub_FFDHE4096 . PublicNumber $ os2ip bs
 decodeGroupPublic FFDHE6144 bs = Right . GroupPub_FFDHE6144 . PublicNumber $ os2ip bs
 decodeGroupPublic FFDHE8192 bs = Right . GroupPub_FFDHE8192 . PublicNumber $ os2ip bs
+
+-- Check that group element in not in the 2-element subgroup { 1, p - 1 }.
+-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1.
+valid :: Params -> PublicNumber -> Bool
+valid (Params p _ _) (PublicNumber y) = 1 < y && y < p - 1
+
+-- strips leading zeros from the result of getShared, as required
+-- for DH(E) premaster secret in SSL/TLS before version 1.3.
+stripLeadingZeros :: SharedKey -> B.ScrubbedBytes
+stripLeadingZeros (SharedKey sb) = snd $ B.span (== 0) sb
+
+-- Use short exponents as optimization, see RFC 7919 section 5.2.
+generatePriv :: MonadRandom r => Int -> r PrivateNumber
+generatePriv e = PrivateNumber <$> generateParams e (Just SetHighest) False
+
+-- Short exponent bit sizes from RFC 7919 appendix A, rounded to next
+-- multiple of 16 bits, i.e. going through a function like:
+-- let shortExp n = head [ e | i <- [1..], let e = n + i, e `mod` 16 == 0 ]
+exp2048 :: Int
+exp3072 :: Int
+exp4096 :: Int
+exp6144 :: Int
+exp8192 :: Int
+exp2048 = 240 -- shortExp 225
+exp3072 = 288 -- shortExp 275
+exp4096 = 336 -- shortExp 325
+exp6144 = 384 -- shortExp 375
+exp8192 = 416 -- shortExp 400

core/Network/TLS/Crypto/Types.hs

@@ -11,8 +11,14 @@ data Group = P256 | P384 | P521 | X25519 | X448
            | FFDHE2048 | FFDHE3072 | FFDHE4096 | FFDHE6144 | FFDHE8192
            deriving (Eq, Show)
 
+availableFFGroups :: [Group]
+availableFFGroups = [FFDHE2048,FFDHE3072,FFDHE4096,FFDHE6144,FFDHE8192]
+
+availableECGroups :: [Group]
+availableECGroups = [P256,P384,P521,X25519,X448]
+
 availableGroups :: [Group]
-availableGroups = [P256,P384,P521,X25519,X448]
+availableGroups = availableECGroups ++ availableFFGroups
 
 -- Digital signature algorithm, in close relation to public/private key types
 -- and cipher key exchange.

core/Network/TLS/Handshake/Client.hs

@@ -63,7 +63,7 @@ handshakeClient cparams ctx = do
         getExtensions = sequence [sniExtension
                                  ,secureReneg
                                  ,alpnExtension
-                                 ,curveExtension
+                                 ,groupExtension
                                  ,ecPointExtension
                                  --,sessionTicketExtension
                                  ,signatureAlgExtension
@@ -90,7 +90,7 @@ handshakeClient cparams ctx = do
                                  return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName sni]
                          else return Nothing
 
-        curveExtension = return $ Just $ toExtensionRaw $ NegotiatedGroups ((supportedGroups $ ctxSupported ctx) `intersect` availableGroups)
+        groupExtension = return $ Just $ toExtensionRaw $ NegotiatedGroups (supportedGroups $ ctxSupported ctx)
         ecPointExtension = return $ Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed]
                                 --[EcPointFormat_Uncompressed,EcPointFormat_AnsiX962_compressed_prime,EcPointFormat_AnsiX962_compressed_char2]
         --heartbeatExtension = return $ Just $ toExtensionRaw $ HeartBeat $ HeartBeat_PeerAllowedToSend
@@ -190,11 +190,30 @@ sendClientData cparams ctx = sendCertificate >> sendClientKeyXchg >> sendCertifi
           where getCKX_DHE = do
                     xver <- usingState_ ctx getVersion
                     serverParams <- usingHState ctx getServerDHParams
-                    (clientDHPriv, clientDHPub) <- generateDHE ctx (serverDHParamsToParams serverParams)
 
-                    let premaster = dhGetShared (serverDHParamsToParams serverParams)
-                                                clientDHPriv
-                                                (serverDHParamsToPublic serverParams)
+                    let params  = serverDHParamsToParams serverParams
+                        ffGroup = findFiniteFieldGroup params
+                        srvpub  = serverDHParamsToPublic serverParams
+
+                    (clientDHPub, premaster) <-
+                        case ffGroup of
+                             Nothing  -> do
+                                 groupUsage <- (onCustomFFDHEGroup $ clientHooks cparams) params srvpub `catchException`
+                                                   throwMiscErrorOnException "custom group callback failed"
+                                 case groupUsage of
+                                     GroupUsageInsecure           -> throwCore $ Error_Protocol ("FFDHE group is not secure enough", True, InsufficientSecurity)
+                                     GroupUsageUnsupported reason -> throwCore $ Error_Protocol ("unsupported FFDHE group: " ++ reason, True, HandshakeFailure)
+                                     GroupUsageInvalidPublic      -> throwCore $ Error_Protocol ("invalid server public key", True, HandshakeFailure)
+                                     GroupUsageValid              -> do
+                                         (clientDHPriv, clientDHPub) <- generateDHE ctx params
+                                         let premaster = dhGetShared params clientDHPriv srvpub
+                                         return (clientDHPub, premaster)
+                             Just grp -> do
+                                 dhePair <- generateFFDHEShared ctx grp srvpub
+                                 case dhePair of
+                                     Nothing   -> throwCore $ Error_Protocol ("invalid server public key", True, HandshakeFailure)
+                                     Just pair -> return pair
+
                     usingHState ctx $ setMasterSecretFromPre xver ClientRole premaster
 
                     return $ CKX_DH clientDHPub
@@ -373,13 +392,13 @@ processServerKeyExchange ctx (ServerKeyXchg origSkx) = do
                     -- we need to resolve the result. and recall processWithCipher ..
                 (c,_)           -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show c, True, HandshakeFailure)
         doDHESignature dhparams signature signatureType = do
-            -- TODO verify DHParams
+            -- FIXME verify if FF group is one of supported groups
             verified <- digitallySignDHParamsVerify ctx dhparams signatureType signature
             when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " signature for dhparams " ++ show dhparams, True, HandshakeFailure)
             usingHState ctx $ setServerDHParams dhparams
 
         doECDHESignature ecdhparams signature signatureType = do
-            -- TODO verify DHParams
+            -- FIXME verify if EC group is one of supported groups
             verified <- digitallySignECDHParamsVerify ctx ecdhparams signatureType signature
             when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " signature for ecdhparams", True, HandshakeFailure)
             usingHState ctx $ setServerECDHParams ecdhparams

core/Network/TLS/Handshake/Key.hs

@@ -15,6 +15,8 @@ module Network.TLS.Handshake.Key
     , generateDHE
     , generateECDHE
     , generateECDHEShared
+    , generateFFDHE
+    , generateFFDHEShared
     ) where
 
 import qualified Data.ByteString as B
@@ -68,3 +70,9 @@ generateECDHE ctx grp = usingState_ ctx $ withRNG $ groupGenerateKeyPair grp
 
 generateECDHEShared :: Context -> GroupPublic -> IO (Maybe (GroupPublic, GroupKey))
 generateECDHEShared ctx pub = usingState_ ctx $ withRNG $ groupGetPubShared pub
+
+generateFFDHE :: Context -> Group -> IO (DHParams, DHPrivate, DHPublic)
+generateFFDHE ctx grp = usingState_ ctx $ withRNG $ dhGroupGenerateKeyPair grp
+
+generateFFDHEShared :: Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey))
+generateFFDHEShared ctx grp pub = usingState_ ctx $ withRNG $ dhGroupGetPubShared grp pub