1module PubKey 2 ( arbitraryRSAPair 3 , arbitraryDSAPair 4 , arbitraryECDSAPair 5 , arbitraryEd25519Pair 6 , arbitraryEd448Pair 7 , globalRSAPair 8 , getGlobalRSAPair 9 , knownECCurves 10 , defaultECCurve 11 , dhParams512 12 , dhParams768 13 , dhParams1024 14 , dsaParams 15 , rsaParams 16 ) where 17 18import Test.Tasty.QuickCheck 19 20import qualified Data.ByteString as B 21import qualified Crypto.PubKey.DH as DH 22import Crypto.Error 23import Crypto.Random 24import qualified Crypto.PubKey.RSA as RSA 25import qualified Crypto.PubKey.DSA as DSA 26import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 27import qualified Crypto.PubKey.ECC.Prim as ECC 28import qualified Crypto.PubKey.ECC.Types as ECC 29import qualified Crypto.PubKey.Ed25519 as Ed25519 30import qualified Crypto.PubKey.Ed448 as Ed448 31 32import Control.Concurrent.MVar 33import System.IO.Unsafe 34 35arbitraryRSAPair :: Gen (RSA.PublicKey, RSA.PrivateKey) 36arbitraryRSAPair = (rngToRSA . drgNewTest) `fmap` arbitrary 37 where 38 rngToRSA :: ChaChaDRG -> (RSA.PublicKey, RSA.PrivateKey) 39 rngToRSA rng = fst $ withDRG rng arbitraryRSAPairWithRNG 40 41arbitraryRSAPairWithRNG :: MonadRandom m => m (RSA.PublicKey, RSA.PrivateKey) 42arbitraryRSAPairWithRNG = RSA.generate 256 0x10001 43 44{-# NOINLINE globalRSAPair #-} 45globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey) 46globalRSAPair = unsafePerformIO $ do 47 drg <- drgNew 48 newMVar (fst $ withDRG drg arbitraryRSAPairWithRNG) 49 50{-# NOINLINE getGlobalRSAPair #-} 51getGlobalRSAPair :: (RSA.PublicKey, RSA.PrivateKey) 52getGlobalRSAPair = unsafePerformIO (readMVar globalRSAPair) 53 54rsaParams :: (RSA.PublicKey, RSA.PrivateKey) 55rsaParams = (pub, priv) 56 where priv = RSA.PrivateKey { RSA.private_pub = pub 57 , RSA.private_d = d 58 , RSA.private_p = 0 59 , RSA.private_q = 0 60 , RSA.private_dP = 0 61 , RSA.private_dQ = 0 62 , RSA.private_qinv = 0 63 } 64 pub = RSA.PublicKey { RSA.public_size = (1024 `div` 8), RSA.public_n = n, RSA.public_e = e } 65 n = 0x00c086b4c6db28ae578d73766d6fdd04b913808a85bf9ad7bcfc9a6ff04d13d2ff75f761ce7db9ee8996e29dc433d19a2d3f748e8d368ba099781d58276e1863a324ae3fb1a061874cd9f3510e54e49727c68de0616964335371cfb63f15ebff8ce8df09c74fb8625f8f58548b90f079a3405f522e738e664d0c645b015664f7c7 66 e = 0x10001 67 d = 0x3edc3cae28e4717818b1385ba7088d0038c3e176a606d2a5dbfc38cc46fe500824e62ec312fde04a803f61afac13a5b95c5c9c26b346879b54429083df488b4f29bb7b9722d366d6f5d2b512150a2e950eacfe0fd9dd56b87b0322f74ae3c8d8674ace62bc723f7c05e9295561efd70d7a924c6abac2e482880fc0149d5ad481 68 69dhParams512 :: DH.Params 70dhParams512 = DH.Params 71 { DH.params_p = 0x00ccaa3884b50789ebea8d39bef8bbc66e20f2a78f537a76f26b4edde5de8b0ff15a8193abf0873cbdc701323a2bf6e860affa6e043fe8300d47e95baf9f6354cb 72 , DH.params_g = 0x2 73 , DH.params_bits = 512 74 } 75 76-- from RFC 2409 77 78dhParams768 :: DH.Params 79dhParams768 = DH.Params 80 { DH.params_p = 0xffffffffffffffffc90fdaa22168c234c4c6628b80dc1cd129024e088a67cc74020bbea63b139b22514a08798e3404ddef9519b3cd3a431b302b0a6df25f14374fe1356d6d51c245e485b576625e7ec6f44c42e9a63a3620ffffffffffffffff 81 , DH.params_g = 0x2 82 , DH.params_bits = 768 83 } 84 85dhParams1024 :: DH.Params 86dhParams1024 = DH.Params 87 { DH.params_p = 0xffffffffffffffffc90fdaa22168c234c4c6628b80dc1cd129024e088a67cc74020bbea63b139b22514a08798e3404ddef9519b3cd3a431b302b0a6df25f14374fe1356d6d51c245e485b576625e7ec6f44c42e9a637ed6b0bff5cb6f406b7edee386bfb5a899fa5ae9f24117c4b1fe649286651ece65381ffffffffffffffff 88 , DH.params_g = 0x2 89 , DH.params_bits = 1024 90 } 91 92dsaParams :: DSA.Params 93dsaParams = DSA.Params 94 { DSA.params_p = 0x009f356bbc4750645555b02aa3918e85d5e35bdccd56154bfaa3e1801d5fe0faf65355215148ea866d5732fd27eb2f4d222c975767d2eb573513e460eceae327c8ac5da1f4ce765c49a39cae4c904b4e5cc64554d97148f20a2655027a0cf8f70b2550cc1f0c9861ce3a316520ab0588407ea3189d20c78bd52df97e56cbe0bbeb 95 , DSA.params_q = 0x00f33a57b47de86ff836f9fe0bb060c54ab293133b 96 , DSA.params_g = 0x3bb973c4f6eee92d1530f250487735595d778c2e5c8147d67a46ebcba4e6444350d49da8e7da667f9b1dbb22d2108870b9fcfabc353cdfac5218d829f22f69130317cc3b0d724881e34c34b8a2571d411da6458ef4c718df9e826f73e16a035b1dcbc1c62cac7a6604adb3e7930be8257944c6dfdddd655004b98253185775ff 97 } 98 99arbitraryDSAPair :: Gen (DSA.PublicKey, DSA.PrivateKey) 100arbitraryDSAPair = do 101 priv <- choose (1, DSA.params_q dsaParams) 102 let pub = DSA.calculatePublic dsaParams priv 103 return (DSA.PublicKey dsaParams pub, DSA.PrivateKey dsaParams priv) 104 105-- for performance reason P521 is not tested 106knownECCurves :: [ECC.CurveName] 107knownECCurves = [ ECC.SEC_p256r1 108 , ECC.SEC_p384r1 109 ] 110 111defaultECCurve :: ECC.CurveName 112defaultECCurve = ECC.SEC_p256r1 113 114arbitraryECDSAPair :: ECC.CurveName -> Gen (ECDSA.PublicKey, ECDSA.PrivateKey) 115arbitraryECDSAPair curveName = do 116 d <- choose (1, n - 1) 117 let p = ECC.pointBaseMul curve d 118 return (ECDSA.PublicKey curve p, ECDSA.PrivateKey curve d) 119 where 120 curve = ECC.getCurveByName curveName 121 n = ECC.ecc_n . ECC.common_curve $ curve 122 123arbitraryEd25519Pair :: Gen (Ed25519.PublicKey, Ed25519.SecretKey) 124arbitraryEd25519Pair = do 125 bytes <- vectorOf 32 arbitrary 126 let CryptoPassed priv = Ed25519.secretKey (B.pack bytes) 127 return (Ed25519.toPublic priv, priv) 128 129arbitraryEd448Pair :: Gen (Ed448.PublicKey, Ed448.SecretKey) 130arbitraryEd448Pair = do 131 bytes <- vectorOf 57 arbitrary 132 let CryptoPassed priv = Ed448.secretKey (B.pack bytes) 133 return (Ed448.toPublic priv, priv) 134