diff options
-rw-r--r-- | TLSA.hs | 70 |
1 files changed, 54 insertions, 16 deletions
@@ -30,11 +30,35 @@ fromWord8 = toEnum . fromEnum | |||
30 | toWord8 :: Enum a => a -> Word8 | 30 | toWord8 :: Enum a => a -> Word8 |
31 | toWord8 = toEnum . fromEnum | 31 | toWord8 = toEnum . fromEnum |
32 | 32 | ||
33 | -- | The Certificate Usage Field as described in RFC 6698, section 2.1.1. | ||
33 | data CertUsage | 34 | data CertUsage |
35 | |||
36 | -- | This usage limits which CA can be used to issue certificates for a | ||
37 | -- given service on a host. PKIX-validated TLS connections for the domain | ||
38 | -- should be considered invalid if the certification path does not include | ||
39 | -- at least one certificate that 'match'es the 'TLSA' record. | ||
34 | = CAConstraint | 40 | = CAConstraint |
41 | |||
42 | -- | This usage limits which end entity certificate can be used by a given | ||
43 | -- service on a host. The TLS connection for the domain should be | ||
44 | -- considered invalid if the end entity certificate does not 'match' the | ||
45 | -- 'TLSA' record. | ||
35 | | ServiceCertificateConstraint | 46 | | ServiceCertificateConstraint |
47 | |||
48 | -- | This usage allows a domain name administrator to specify a new trust | ||
49 | -- anchor. This is useful if the domain issues its own certificates under | ||
50 | -- its own CA that is not expected to be in the end users' collection of | ||
51 | -- trust anchors. When conducting PKIX validation for the domain, any | ||
52 | -- certificate matching the 'TLSA' record can be treated as a trust anchor | ||
53 | -- that does not require further validation. | ||
36 | | TrustAnchorAssertion | 54 | | TrustAnchorAssertion |
55 | |||
56 | -- | This usage allows for a domain name administrator to issue | ||
57 | -- certificates for a domain without involving a third-party CA. The end | ||
58 | -- entity certificate MUST 'match' the 'TLSA' record. Unlike for a | ||
59 | -- 'ServiceCertificateConstraint', PKIX validation should not be performed. | ||
37 | | DomainIssued | 60 | | DomainIssued |
61 | |||
38 | | CertUsage Word8 | 62 | | CertUsage Word8 |
39 | deriving (Eq, Ord, Show, Read) | 63 | deriving (Eq, Ord, Show, Read) |
40 | 64 | ||
@@ -50,10 +74,11 @@ instance Enum CertUsage where | |||
50 | toEnum 3 = DomainIssued | 74 | toEnum 3 = DomainIssued |
51 | toEnum n = CertUsage (toEnum n) | 75 | toEnum n = CertUsage (toEnum n) |
52 | 76 | ||
77 | -- | Indicates what sort of object should be compared with 'associationData'. | ||
53 | data Selector | 78 | data Selector |
54 | = FullCertificate | 79 | = FullCertificate -- ^ x.509 certificate |
55 | | SubjectPublicKeyInfo | 80 | | SubjectPublicKeyInfo -- ^ PKCS #8 formatted public key |
56 | | Selector Word8 -- Selector 255 reserved for private use | 81 | | Selector Word8 -- ^ value 255 reserved for private use |
57 | deriving (Eq,Ord,Show) | 82 | deriving (Eq,Ord,Show) |
58 | 83 | ||
59 | instance Enum Selector where | 84 | instance Enum Selector where |
@@ -64,11 +89,13 @@ instance Enum Selector where | |||
64 | toEnum 1 = SubjectPublicKeyInfo | 89 | toEnum 1 = SubjectPublicKeyInfo |
65 | toEnum n = Selector (toEnum n) | 90 | toEnum n = Selector (toEnum n) |
66 | 91 | ||
92 | -- | Is 'associationData' the an object of the form specified by 'Selector' or | ||
93 | -- is it only a hash of it? | ||
67 | data MatchingType | 94 | data MatchingType |
68 | = Match_Exact | 95 | = Match_Exact |
69 | | Match_SHA256 | 96 | | Match_SHA256 |
70 | | Match_SHA512 | 97 | | Match_SHA512 |
71 | | Match Word8 -- Match 255 reserved for private use | 98 | | Match Word8 -- ^ value 255 is reserved for private use |
72 | deriving (Eq,Ord,Show) | 99 | deriving (Eq,Ord,Show) |
73 | 100 | ||
74 | instance Enum MatchingType where | 101 | instance Enum MatchingType where |
@@ -82,21 +109,28 @@ instance Enum MatchingType where | |||
82 | toEnum n = Match (toEnum n) | 109 | toEnum n = Match (toEnum n) |
83 | 110 | ||
84 | 111 | ||
112 | -- | The parsed RDATA field of a TLSA DNS resource record (type 52) as | ||
113 | -- described in RFC 6698. | ||
114 | -- | ||
115 | -- Use the 'match' function uses 'selector', 'matchingType' and | ||
116 | -- 'associationData' to implement a predicate on certificates obtained via the | ||
117 | -- TLS protocol. The 'certUsage' field indicates what that predicate means. | ||
85 | data TLSA = TLSA | 118 | data TLSA = TLSA |
86 | { tlsaCertUsage :: CertUsage | 119 | { certUsage :: CertUsage |
87 | , tlsaSelector :: Selector | 120 | , selector :: Selector |
88 | , tlsaMatchingType :: MatchingType | 121 | , matchingType :: MatchingType |
89 | , tlsaAssociationData :: BS.ByteString | 122 | , associationData :: BS.ByteString |
90 | } | 123 | } |
91 | deriving (Eq, Ord, Show) | 124 | deriving (Eq, Ord, Show) |
92 | 125 | ||
126 | -- | Parse RDATA for a TLSA resource record. | ||
93 | fromByteString :: BS.ByteString -> TLSA | 127 | fromByteString :: BS.ByteString -> TLSA |
94 | fromByteString bs = TLSA (fromWord8 cu) | 128 | fromByteString bs = TLSA (fromWord8 cu) |
95 | (fromWord8 sel) | 129 | (fromWord8 sel) |
96 | (fromWord8 mat) | 130 | (fromWord8 mat) |
97 | associationData | 131 | dta |
98 | where | 132 | where |
99 | (csm,associationData) = BS.splitAt 3 bs | 133 | (csm,dta) = BS.splitAt 3 bs |
100 | (cu,sel,mat) = | 134 | (cu,sel,mat) = |
101 | case BS.unpack csm of | 135 | case BS.unpack csm of |
102 | [cu,sel,mat] -> (cu,sel,mat) | 136 | [cu,sel,mat] -> (cu,sel,mat) |
@@ -104,28 +138,32 @@ fromByteString bs = TLSA (fromWord8 cu) | |||
104 | [cu] -> (cu,0,0) | 138 | [cu] -> (cu,0,0) |
105 | [] -> (0,0,0) | 139 | [] -> (0,0,0) |
106 | 140 | ||
141 | -- | Encode a valid RDATA field for a TLSA DNS record. | ||
107 | toByteString :: TLSA -> BS.ByteString | 142 | toByteString :: TLSA -> BS.ByteString |
108 | toByteString (TLSA cu sel mat associationData) = csm <> associationData | 143 | toByteString (TLSA cu sel mat dta) = csm <> dta |
109 | where | 144 | where |
110 | csm = BS.pack [ toWord8 cu | 145 | csm = BS.pack [ toWord8 cu |
111 | , toWord8 sel | 146 | , toWord8 sel |
112 | , toWord8 mat ] | 147 | , toWord8 mat ] |
113 | 148 | ||
114 | match :: Certificate -> TLSA -> Bool | 149 | -- | Returns 'True' if the given certificate matches the given 'TLSA' object. |
115 | match cert tlsa = fromMaybe False $ | 150 | -- The algorithm for matching depends on the values of 'selector' and |
116 | (== tlsaAssociationData tlsa) <$> (hash <*> material) | 151 | -- 'matchingType' as described in RFC 6698. |
152 | match :: TLSA -> Certificate -> Bool | ||
153 | match tlsa cert = fromMaybe False $ | ||
154 | (== associationData tlsa) <$> (hash <*> material) | ||
117 | 155 | ||
118 | where | 156 | where |
119 | encode obj = encodeASN1 DER (toASN1 obj []) | 157 | encode obj = encodeASN1 DER (toASN1 obj []) |
120 | 158 | ||
121 | material = | 159 | material = |
122 | case tlsaSelector tlsa of | 160 | case selector tlsa of |
123 | FullCertificate -> Just $ encode cert | 161 | FullCertificate -> Just $ encode cert |
124 | SubjectPublicKeyInfo -> Just $ encode $ certPubKey cert | 162 | SubjectPublicKeyInfo -> Just $ encode $ certPubKey cert |
125 | _ -> Nothing | 163 | _ -> Nothing |
126 | 164 | ||
127 | hash = | 165 | hash = |
128 | case tlsaMatchingType tlsa of | 166 | case matchingType tlsa of |
129 | Match_Exact -> Just L.toStrict | 167 | Match_Exact -> Just L.toStrict |
130 | Match_SHA256 -> Just SHA256.hashlazy | 168 | Match_SHA256 -> Just SHA256.hashlazy |
131 | Match_SHA512 -> Just SHA512.hashlazy | 169 | Match_SHA512 -> Just SHA512.hashlazy |