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 , toPubKeyEC 13 , toPrivKeyEC 14 ) where 15 16import Control.Applicative 17import Test.Tasty.QuickCheck 18import Data.ASN1.OID 19import Data.X509 20import Data.Hourglass 21import Crypto.Number.Serialize (i2ospOf_) 22import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 23import qualified Crypto.PubKey.ECC.Types as ECC 24import qualified Data.ByteString as B 25 26import PubKey 27 28arbitraryDN :: Gen DistinguishedName 29arbitraryDN = return $ DistinguishedName [] 30 31instance Arbitrary Date where 32 arbitrary = do 33 y <- choose (1971, 2035) 34 m <- elements [ January .. December] 35 d <- choose (1, 30) 36 return $ normalizeDate $ Date y m d 37 38normalizeDate :: Date -> Date 39normalizeDate d = timeConvert (timeConvert d :: Elapsed) 40 41instance Arbitrary TimeOfDay where 42 arbitrary = do 43 h <- choose (0, 23) 44 mi <- choose (0, 59) 45 se <- choose (0, 59) 46 nsec <- return 0 47 return $ TimeOfDay (Hours h) (Minutes mi) (Seconds se) nsec 48 49instance Arbitrary DateTime where 50 arbitrary = DateTime <$> arbitrary <*> arbitrary 51 52maxSerial :: Integer 53maxSerial = 16777216 54 55arbitraryCertificate :: [ExtKeyUsageFlag] -> PubKey -> Gen Certificate 56arbitraryCertificate usageFlags pubKey = do 57 serial <- choose (0,maxSerial) 58 subjectdn <- arbitraryDN 59 validity <- (,) <$> arbitrary <*> arbitrary 60 let sigalg = getSignatureALG pubKey 61 return $ Certificate 62 { certVersion = 3 63 , certSerial = serial 64 , certSignatureAlg = sigalg 65 , certIssuerDN = issuerdn 66 , certSubjectDN = subjectdn 67 , certValidity = validity 68 , certPubKey = pubKey 69 , certExtensions = Extensions $ Just 70 [ extensionEncode True $ ExtKeyUsage usageFlags 71 ] 72 } 73 where issuerdn = DistinguishedName [(getObjectID DnCommonName, "Root CA")] 74 75simpleCertificate :: PubKey -> Certificate 76simpleCertificate pubKey = 77 Certificate 78 { certVersion = 3 79 , certSerial = 0 80 , certSignatureAlg = getSignatureALG pubKey 81 , certIssuerDN = simpleDN 82 , certSubjectDN = simpleDN 83 , certValidity = (time1, time2) 84 , certPubKey = pubKey 85 , certExtensions = Extensions $ Just 86 [ extensionEncode True $ ExtKeyUsage [KeyUsage_digitalSignature,KeyUsage_keyEncipherment] 87 ] 88 } 89 where time1 = DateTime (Date 1999 January 1) (TimeOfDay 0 0 0 0) 90 time2 = DateTime (Date 2049 January 1) (TimeOfDay 0 0 0 0) 91 simpleDN = DistinguishedName [] 92 93simpleX509 :: PubKey -> SignedCertificate 94simpleX509 pubKey = 95 let cert = simpleCertificate pubKey 96 sig = replicate 40 1 97 sigalg = getSignatureALG pubKey 98 (signedExact, ()) = objectToSignedExact (\_ -> (B.pack sig,sigalg,())) cert 99 in signedExact 100 101arbitraryX509WithKey :: (PubKey, t) -> Gen SignedCertificate 102arbitraryX509WithKey = arbitraryX509WithKeyAndUsage knownKeyUsage 103 104arbitraryX509WithKeyAndUsage :: [ExtKeyUsageFlag] -> (PubKey, t) -> Gen SignedCertificate 105arbitraryX509WithKeyAndUsage usageFlags (pubKey, _) = do 106 cert <- arbitraryCertificate usageFlags pubKey 107 sig <- resize 40 $ listOf1 arbitrary 108 let sigalg = getSignatureALG pubKey 109 let (signedExact, ()) = objectToSignedExact (\(!(_)) -> (B.pack sig,sigalg,())) cert 110 return signedExact 111 112arbitraryX509 :: Gen SignedCertificate 113arbitraryX509 = do 114 let (pubKey, privKey) = getGlobalRSAPair 115 arbitraryX509WithKey (PubKeyRSA pubKey, PrivKeyRSA privKey) 116 117arbitraryKeyUsage :: Gen [ExtKeyUsageFlag] 118arbitraryKeyUsage = sublistOf knownKeyUsage 119 120knownKeyUsage :: [ExtKeyUsageFlag] 121knownKeyUsage = [ KeyUsage_digitalSignature 122 , KeyUsage_keyEncipherment 123 , KeyUsage_keyAgreement 124 ] 125 126getSignatureALG :: PubKey -> SignatureALG 127getSignatureALG (PubKeyRSA _) = SignatureALG HashSHA1 PubKeyALG_RSA 128getSignatureALG (PubKeyDSA _) = SignatureALG HashSHA1 PubKeyALG_DSA 129getSignatureALG (PubKeyEC _) = SignatureALG HashSHA256 PubKeyALG_EC 130getSignatureALG (PubKeyEd25519 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed25519 131getSignatureALG (PubKeyEd448 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed448 132getSignatureALG pubKey = error $ "getSignatureALG: unsupported public key: " ++ show pubKey 133 134toPubKeyEC :: ECC.CurveName -> ECDSA.PublicKey -> PubKey 135toPubKeyEC curveName key = 136 let ECC.Point x y = ECDSA.public_q key 137 pub = SerializedPoint bs 138 bs = B.cons 4 (i2ospOf_ bytes x `B.append` i2ospOf_ bytes y) 139 bits = ECC.curveSizeBits (ECC.getCurveByName curveName) 140 bytes = (bits + 7) `div` 8 141 in PubKeyEC (PubKeyEC_Named curveName pub) 142 143toPrivKeyEC :: ECC.CurveName -> ECDSA.PrivateKey -> PrivKey 144toPrivKeyEC curveName key = 145 let priv = ECDSA.private_d key 146 in PrivKeyEC (PrivKeyEC_Named curveName priv) 147