Skip to content

Commit

Permalink
enchanting tests for group
Browse files Browse the repository at this point in the history
  • Loading branch information
@kazu-yamamoto
kazu-yamamoto committed Dec 7, 2023
1 parent 50e0b4c commit 681e506
Show file tree
Hide file tree
Showing 3 changed files with 56 additions and 67 deletions.
26 changes: 13 additions & 13 deletions core/test/Arbitrary.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@ import Data.X509 (
)
import Network.TLS
import Network.TLS.Extra.Cipher
import Network.TLS.Extra.FFDHE
import Network.TLS.Internal
import Test.QuickCheck

Expand Down Expand Up @@ -167,10 +166,10 @@ arbitraryVersions :: Gen [Version]
arbitraryVersions = sublistOf knownVersions

-- for performance reason P521, FFDHE6144, FFDHE8192 are not tested
knownGroups, knownECGroups :: [Group]
knownGroups, knownECGroups, knownFFGroups :: [Group]
knownECGroups = [P256, P384, X25519, X448]
-- knownFFGroups = [FFDHE2048, FFDHE3072, FFDHE4096]
knownGroups = knownECGroups
knownFFGroups = [FFDHE2048, FFDHE3072, FFDHE4096]
knownGroups = knownECGroups ++ knownFFGroups

defaultECGroup :: Group
defaultECGroup = P256 -- same as defaultECCurve
Expand All @@ -184,6 +183,16 @@ instance Arbitrary Group where
instance {-# OVERLAPS #-} Arbitrary [Group] where
arbitrary = sublistOf knownGroups

newtype EC = EC [Group] deriving (Show)

instance Arbitrary EC where
arbitrary = EC <$> shuffle knownECGroups

newtype FFDHE = FFDHE [Group] deriving (Show)

instance Arbitrary FFDHE where
arbitrary = FFDHE <$> shuffle knownFFGroups

isCredentialDSA :: (CertificateChain, PrivKey) -> Bool
isCredentialDSA (_, PrivKeyDSA _) = True
isCredentialDSA _ = False
Expand Down Expand Up @@ -237,15 +246,6 @@ arbitraryCredentialsOfEachCurve' = do

----------------------------------------------------------------

dhParamsGroup :: DHParams -> Maybe Group
dhParamsGroup params
| params == ffdhe2048 = Just FFDHE2048
| params == ffdhe3072 = Just FFDHE3072
| otherwise = Nothing

isCustomDHParams :: DHParams -> Bool
isCustomDHParams params = params == dhParams512

leafPublicKey :: CertificateChain -> Maybe PubKey
leafPublicKey (CertificateChain []) = Nothing
leafPublicKey (CertificateChain (leaf : _)) = Just (certPubKey $ getCertificate leaf)
Expand Down
64 changes: 43 additions & 21 deletions core/test/HandshakeSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,9 @@ spec = do
prop "can handshake with TLS 1.3 RTT0" handshake13_rtt0
prop "can handshake with TLS 1.3 RTT0 -> PSK" handshake13_rtt0_fallback
prop "can handshake with TLS 1.3 RTT0 length" handshake13_rtt0_length
prop "can handshake with TLS 1.3 EE groups" handshake13_ee_groups
prop "can handshake with TLS 1.3 EE" handshake13_ee_groups
prop "can handshake with TLS 1.3 EC groups" handshake13_ec
prop "can handshake with TLS 1.3 FFDHE groups" handshake13_ffdhe
prop "can handshake with TLS 1.3 Post-handshake auth" post_handshake_auth

--------------------------------------------------------------
Expand Down Expand Up @@ -207,12 +209,9 @@ handshake_groups (GGP clientGroups serverGroups) = do
{ supportedGroups = serverGroups
}
}
isCustom = maybe True isCustomDHParams (serverDHEParams serverParam')
mCustomGroup = serverDHEParams serverParam' >>= dhParamsGroup
isClientCustom = maybe True (`notElem` clientGroups) mCustomGroup
commonGroups = clientGroups `intersect` serverGroups
shouldFail = null commonGroups && (tls13 || isClientCustom && denyCustom)
p minfo = isNothing (minfo >>= infoSupportedGroup) == (null commonGroups && isCustom)
shouldFail = null commonGroups
p minfo = isNothing (minfo >>= infoSupportedGroup) == (null commonGroups)
if shouldFail
then runTLSInitFailure (clientParam', serverParam')
else runTLSPipePredicate (clientParam', serverParam') p
Expand All @@ -222,44 +221,41 @@ handshake_groups (GGP clientGroups serverGroups) = do
newtype SG = SG [Group] deriving (Show)

instance Arbitrary SG where
arbitrary = SG <$> sublistOf sigGroups
arbitrary = SG <$> shuffle sigGroups
where
sigGroups = [P256]
sigGroups = [P256, P521]

handshake_ec :: SG -> IO ()
handshake_ec (SG sigGroups) = do
let versions = [TLS12, TLS13]
let versions = [TLS12]
ciphers =
[ cipher_ECDHE_ECDSA_AES256GCM_SHA384
, cipher_TLS13_AES128GCM_SHA256
]
ecdhGroups = [X25519, X448] -- always enabled, so no ECDHE failure
hashSignatures =
[ (HashSHA256, SignatureECDSA)
]
clientVersion <- generate $ elements versions
(clientParam, serverParam) <-
generate $
arbitraryPairParamsWithVersionsAndCiphers
([clientVersion], versions)
(versions, versions)
(ciphers, ciphers)
clientGroups <- generate $ sublistOf sigGroups
clientGroups <- generate $ shuffle sigGroups
clientHashSignatures <- generate $ sublistOf hashSignatures
serverHashSignatures <- generate $ sublistOf hashSignatures
credentials <- generate arbitraryCredentialsOfEachCurve
let clientParam' =
clientParam
{ clientSupported =
(clientSupported clientParam)
{ supportedGroups = clientGroups ++ ecdhGroups
{ supportedGroups = clientGroups
, supportedHashSignatures = clientHashSignatures
}
}
serverParam' =
serverParam
{ serverSupported =
(serverSupported serverParam)
{ supportedGroups = sigGroups ++ ecdhGroups
{ supportedGroups = sigGroups
, supportedHashSignatures = serverHashSignatures
}
, serverShared =
Expand All @@ -268,9 +264,8 @@ handshake_ec (SG sigGroups) = do
}
}
sigAlgs = map snd (clientHashSignatures `intersect` serverHashSignatures)
ecdsaDenied =
(clientVersion < TLS13 && null clientGroups)
|| (clientVersion >= TLS12 && SignatureECDSA `notElem` sigAlgs)
ecdsaDenied = SignatureECDSA `notElem` sigAlgs
print sigAlgs
if ecdsaDenied
then runTLSInitFailure (clientParam', serverParam')
else runTLSPipeSimple (clientParam', serverParam')
Expand Down Expand Up @@ -906,19 +901,46 @@ handshake13_rtt0_length (CSP13 (cli, srv)) = do

handshake13_ee_groups :: CSP13 -> IO ()
handshake13_ee_groups (CSP13 (cli, srv)) = do
let cliSupported = (clientSupported cli){supportedGroups = [P256, X25519]}
let -- The client prefers P256
cliSupported = (clientSupported cli){supportedGroups = [P256, X25519]}
-- The server prefers X25519
svrSupported = (serverSupported srv){supportedGroups = [X25519, P256]}
params =
( cli{clientSupported = cliSupported}
, srv{serverSupported = svrSupported}
)
(_, serverMessages) <- runTLSPipeCapture13 params
-- The server should tell X25519 in supported_groups in EE to clinet
let isSupportedGroups (ExtensionRaw eid _) = eid == EID_SupportedGroups
eeMessagesHaveExt =
[ any isSupportedGroups exts
| EncryptedExtensions13 exts <- serverMessages
]
eeMessagesHaveExt `shouldBe` [True] -- one EE message with extension
eeMessagesHaveExt `shouldBe` [True]

handshake13_ec :: CSP13 -> IO ()
handshake13_ec (CSP13 (cli, srv)) = do
EC cgrps <- generate arbitrary
EC sgrps <- generate arbitrary
let cliSupported = (clientSupported cli){supportedGroups = cgrps}
svrSupported = (serverSupported srv){supportedGroups = sgrps}
params =
( cli{clientSupported = cliSupported}
, srv{serverSupported = svrSupported}
)
runTLSPipeSimple13 params FullHandshake Nothing

handshake13_ffdhe :: CSP13 -> IO ()
handshake13_ffdhe (CSP13 (cli, srv)) = do
FFDHE cgrps <- generate arbitrary
FFDHE sgrps <- generate arbitrary
let cliSupported = (clientSupported cli){supportedGroups = cgrps}
svrSupported = (serverSupported srv){supportedGroups = sgrps}
params =
( cli{clientSupported = cliSupported}
, srv{serverSupported = svrSupported}
)
runTLSPipeSimple13 params FullHandshake Nothing

post_handshake_auth :: CSP13 -> IO ()
post_handshake_auth (CSP13 (clientParam, serverParam)) = do
Expand Down
33 changes: 0 additions & 33 deletions core/test/PubKey.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,16 +8,12 @@ module PubKey (
getGlobalRSAPair,
knownECCurves,
defaultECCurve,
dhParams512,
dhParams768,
dhParams1024,
dsaParams,
rsaParams,
) where

import Control.Concurrent.MVar
import Crypto.Error
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
Expand Down Expand Up @@ -74,35 +70,6 @@ rsaParams = (pub, priv)
d =
0x3edc3cae28e4717818b1385ba7088d0038c3e176a606d2a5dbfc38cc46fe500824e62ec312fde04a803f61afac13a5b95c5c9c26b346879b54429083df488b4f29bb7b9722d366d6f5d2b512150a2e950eacfe0fd9dd56b87b0322f74ae3c8d8674ace62bc723f7c05e9295561efd70d7a924c6abac2e482880fc0149d5ad481

dhParams512 :: DH.Params
dhParams512 =
DH.Params
{ DH.params_p =
0x00ccaa3884b50789ebea8d39bef8bbc66e20f2a78f537a76f26b4edde5de8b0ff15a8193abf0873cbdc701323a2bf6e860affa6e043fe8300d47e95baf9f6354cb
, DH.params_g = 0x2
, DH.params_bits = 512
}

-- from RFC 2409

dhParams768 :: DH.Params
dhParams768 =
DH.Params
{ DH.params_p =
0xffffffffffffffffc90fdaa22168c234c4c6628b80dc1cd129024e088a67cc74020bbea63b139b22514a08798e3404ddef9519b3cd3a431b302b0a6df25f14374fe1356d6d51c245e485b576625e7ec6f44c42e9a63a3620ffffffffffffffff
, DH.params_g = 0x2
, DH.params_bits = 768
}

dhParams1024 :: DH.Params
dhParams1024 =
DH.Params
{ DH.params_p =
0xffffffffffffffffc90fdaa22168c234c4c6628b80dc1cd129024e088a67cc74020bbea63b139b22514a08798e3404ddef9519b3cd3a431b302b0a6df25f14374fe1356d6d51c245e485b576625e7ec6f44c42e9a637ed6b0bff5cb6f406b7edee386bfb5a899fa5ae9f24117c4b1fe649286651ece65381ffffffffffffffff
, DH.params_g = 0x2
, DH.params_bits = 1024
}

dsaParams :: DSA.Params
dsaParams =
DSA.Params
Expand Down

0 comments on commit 681e506

Please sign in to comment.