1{-# LANGUAGE BangPatterns #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# OPTIONS_GHC -fno-warn-orphans #-} 4module Certificate 5 ( arbitraryX509 6 , arbitraryX509WithKey 7 , arbitraryX509WithKeyAndUsage 8 , arbitraryDN 9 , arbitraryKeyUsage 10 , simpleCertificate 11 , simpleX509 12 ) where 13 14import Control.Applicative 15import Test.Tasty.QuickCheck 16import Data.ASN1.OID 17import Data.X509 18import Data.Hourglass 19import qualified Data.ByteString as B 20 21import PubKey 22 23arbitraryDN :: Gen DistinguishedName 24arbitraryDN = return $ DistinguishedName [] 25 26instance Arbitrary Date where 27 arbitrary = do 28 y <- choose (1971, 2035) 29 m <- elements [ January .. December] 30 d <- choose (1, 30) 31 return $ normalizeDate $ Date y m d 32 33normalizeDate :: Date -> Date 34normalizeDate d = timeConvert (timeConvert d :: Elapsed) 35 36instance Arbitrary TimeOfDay where 37 arbitrary = do 38 h <- choose (0, 23) 39 mi <- choose (0, 59) 40 se <- choose (0, 59) 41 nsec <- return 0 42 return $ TimeOfDay (Hours h) (Minutes mi) (Seconds se) nsec 43 44instance Arbitrary DateTime where 45 arbitrary = DateTime <$> arbitrary <*> arbitrary 46 47maxSerial :: Integer 48maxSerial = 16777216 49 50arbitraryCertificate :: [ExtKeyUsageFlag] -> PubKey -> Gen Certificate 51arbitraryCertificate usageFlags pubKey = do 52 serial <- choose (0,maxSerial) 53 subjectdn <- arbitraryDN 54 validity <- (,) <$> arbitrary <*> arbitrary 55 let sigalg = getSignatureALG pubKey 56 return $ Certificate 57 { certVersion = 3 58 , certSerial = serial 59 , certSignatureAlg = sigalg 60 , certIssuerDN = issuerdn 61 , certSubjectDN = subjectdn 62 , certValidity = validity 63 , certPubKey = pubKey 64 , certExtensions = Extensions $ Just 65 [ extensionEncode True $ ExtKeyUsage usageFlags 66 ] 67 } 68 where issuerdn = DistinguishedName [(getObjectID DnCommonName, "Root CA")] 69 70simpleCertificate :: PubKey -> Certificate 71simpleCertificate pubKey = 72 Certificate 73 { certVersion = 3 74 , certSerial = 0 75 , certSignatureAlg = getSignatureALG pubKey 76 , certIssuerDN = simpleDN 77 , certSubjectDN = simpleDN 78 , certValidity = (time1, time2) 79 , certPubKey = pubKey 80 , certExtensions = Extensions $ Just 81 [ extensionEncode True $ ExtKeyUsage [KeyUsage_digitalSignature,KeyUsage_keyEncipherment] 82 ] 83 } 84 where time1 = DateTime (Date 1999 January 1) (TimeOfDay 0 0 0 0) 85 time2 = DateTime (Date 2049 January 1) (TimeOfDay 0 0 0 0) 86 simpleDN = DistinguishedName [] 87 88simpleX509 :: PubKey -> SignedCertificate 89simpleX509 pubKey = 90 let cert = simpleCertificate pubKey 91 sig = replicate 40 1 92 sigalg = getSignatureALG pubKey 93 (signedExact, ()) = objectToSignedExact (\_ -> (B.pack sig,sigalg,())) cert 94 in signedExact 95 96arbitraryX509WithKey :: (PubKey, t) -> Gen SignedCertificate 97arbitraryX509WithKey = arbitraryX509WithKeyAndUsage knownKeyUsage 98 99arbitraryX509WithKeyAndUsage :: [ExtKeyUsageFlag] -> (PubKey, t) -> Gen SignedCertificate 100arbitraryX509WithKeyAndUsage usageFlags (pubKey, _) = do 101 cert <- arbitraryCertificate usageFlags pubKey 102 sig <- resize 40 $ listOf1 arbitrary 103 let sigalg = getSignatureALG pubKey 104 let (signedExact, ()) = objectToSignedExact (\(!(_)) -> (B.pack sig,sigalg,())) cert 105 return signedExact 106 107arbitraryX509 :: Gen SignedCertificate 108arbitraryX509 = do 109 let (pubKey, privKey) = getGlobalRSAPair 110 arbitraryX509WithKey (PubKeyRSA pubKey, PrivKeyRSA privKey) 111 112arbitraryKeyUsage :: Gen [ExtKeyUsageFlag] 113arbitraryKeyUsage = sublistOf knownKeyUsage 114 115knownKeyUsage :: [ExtKeyUsageFlag] 116knownKeyUsage = [ KeyUsage_digitalSignature 117 , KeyUsage_keyEncipherment 118 , KeyUsage_keyAgreement 119 ] 120 121getSignatureALG :: PubKey -> SignatureALG 122getSignatureALG (PubKeyRSA _) = SignatureALG HashSHA1 PubKeyALG_RSA 123getSignatureALG (PubKeyDSA _) = SignatureALG HashSHA1 PubKeyALG_DSA 124getSignatureALG (PubKeyEC _) = SignatureALG HashSHA256 PubKeyALG_EC 125getSignatureALG (PubKeyEd25519 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed25519 126getSignatureALG (PubKeyEd448 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed448 127getSignatureALG pubKey = error $ "getSignatureALG: unsupported public key: " ++ show pubKey 128