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