summaryrefslogtreecommitdiff
path: root/TLSA.hs
diff options
context:
space:
mode:
Diffstat (limited to 'TLSA.hs')
-rw-r--r--TLSA.hs15
1 files changed, 8 insertions, 7 deletions
diff --git a/TLSA.hs b/TLSA.hs
index 7fb66dc..01c9a09 100644
--- a/TLSA.hs
+++ b/TLSA.hs
@@ -237,13 +237,13 @@ data IssuanceTest = IssuanceTest
237 -- supplied via a 'TLSA' record but not otherwise present in the chain. 237 -- supplied via a 'TLSA' record but not otherwise present in the chain.
238 } 238 }
239 239
240-- | Use the the given set of 'TLSA' records to validate, or paritally validate 240-- | Use the the given set of 'TLSA' records to validate or paritally validate
241-- a certificate, given a list of other probably relevent certificates. Results 241-- a certificate given a list of other probably relevent certificates. Results
242-- are interpreted as follows: 242-- are interpreted as follows:
243-- 243--
244-- [@ Nothing @] The certificate passed validation. 244-- [@ Nothing @] The certificate PASSED validation.
245-- 245--
246-- [@ Just \[\] @] Failed validation. 246-- [@ Just \[\] @] The certificate FAILED validation.
247-- 247--
248-- [@ Just xss @] A set of certificate issued-by chains. If you trust any 248-- [@ Just xss @] A set of certificate issued-by chains. If you trust any
249-- certificate in any of these chains, you may consider the 249-- certificate in any of these chains, you may consider the
@@ -252,11 +252,12 @@ data IssuanceTest = IssuanceTest
252validate :: IssuanceTest -> [TLSA] -> SignedCertificate -> [SignedCertificate] 252validate :: IssuanceTest -> [TLSA] -> SignedCertificate -> [SignedCertificate]
253 -> Maybe [[SignedCertificate]] 253 -> Maybe [[SignedCertificate]]
254validate (IssuanceTest isIssuedBy isSignedBy) rs cert chain 254validate (IssuanceTest isIssuedBy isSignedBy) rs cert chain
255 | not (null domainIssued) = Nothing 255 | domainIssued = Nothing
256 | any hasAnchor chains = Nothing 256 | any hasAnchor chains = Nothing
257 | null rs = Just $ (certv !) .: chains
257 | otherwise = Just $ (certv !) .: filter satisfiesConstraints chains 258 | otherwise = Just $ (certv !) .: filter satisfiesConstraints chains
258 where 259 where
259 domainIssued = filter (`match` cert) daneEEs 260 domainIssued = any (`match` cert) daneEEs
260 261
261 threshold = length chain 262 threshold = length chain
262 263