summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--TLSA.hs70
1 files changed, 54 insertions, 16 deletions
diff --git a/TLSA.hs b/TLSA.hs
index 4c4a3d4..16cc568 100644
--- a/TLSA.hs
+++ b/TLSA.hs
@@ -30,11 +30,35 @@ fromWord8 = toEnum . fromEnum
30toWord8 :: Enum a => a -> Word8 30toWord8 :: Enum a => a -> Word8
31toWord8 = toEnum . fromEnum 31toWord8 = toEnum . fromEnum
32 32
33-- | The Certificate Usage Field as described in RFC 6698, section 2.1.1.
33data CertUsage 34data 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'.
53data Selector 78data 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
59instance Enum Selector where 84instance 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?
67data MatchingType 94data 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
74instance Enum MatchingType where 101instance 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.
85data TLSA = TLSA 118data 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.
93fromByteString :: BS.ByteString -> TLSA 127fromByteString :: BS.ByteString -> TLSA
94fromByteString bs = TLSA (fromWord8 cu) 128fromByteString 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.
107toByteString :: TLSA -> BS.ByteString 142toByteString :: TLSA -> BS.ByteString
108toByteString (TLSA cu sel mat associationData) = csm <> associationData 143toByteString (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
114match :: Certificate -> TLSA -> Bool 149-- | Returns 'True' if the given certificate matches the given 'TLSA' object.
115match 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.
152match :: TLSA -> Certificate -> Bool
153match 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