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