summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-19 00:30:10 -0400
committerjoe <joe@jerkface.net>2014-05-19 00:30:10 -0400
commit6099fd80c35ba405b1219f37896f7ce136966650 (patch)
tree953da38463e3522c93673cec4cd81711a2ef0409
parent73e9081cbd07359d85926d16d9ef1bf418e61f96 (diff)
new TLSA module to represent RDATA for TLSA dns records
-rw-r--r--TLSA.hs133
1 files changed, 133 insertions, 0 deletions
diff --git a/TLSA.hs b/TLSA.hs
new file mode 100644
index 0000000..4c4a3d4
--- /dev/null
+++ b/TLSA.hs
@@ -0,0 +1,133 @@
1{-# LANGUAGE OverloadedStrings #-}
2module TLSA
3 ( TLSA(..)
4 , CertUsage(..)
5 , Selector(..)
6 , MatchingType(..)
7 , fromByteString
8 , toByteString
9 , match
10 ) where
11
12import qualified Data.ByteString as BS
13import qualified Data.ByteString.Lazy as L
14import qualified Crypto.Hash.SHA256 as SHA256
15import qualified Crypto.Hash.SHA512 as SHA512
16import Data.X509 ( certPubKey, Certificate )
17import Data.ASN1.Types ( toASN1 )
18import Data.ASN1.Encoding ( encodeASN1 )
19import Data.ASN1.BinaryEncoding
20import Control.Applicative
21import Data.Word
22import Data.Maybe
23import Data.Monoid
24
25{- INLINE fromWord8 #-}
26fromWord8 :: Enum a => Word8 -> a
27fromWord8 = toEnum . fromEnum
28
29{- INLINE toWord8 -}
30toWord8 :: Enum a => a -> Word8
31toWord8 = toEnum . fromEnum
32
33data CertUsage
34 = CAConstraint
35 | ServiceCertificateConstraint
36 | TrustAnchorAssertion
37 | DomainIssued
38 | CertUsage Word8
39 deriving (Eq, Ord, Show, Read)
40
41instance Enum CertUsage where
42 fromEnum CAConstraint = 0
43 fromEnum ServiceCertificateConstraint = 1
44 fromEnum TrustAnchorAssertion = 2
45 fromEnum DomainIssued = 3
46 fromEnum (CertUsage n) = fromEnum n
47 toEnum 0 = CAConstraint
48 toEnum 1 = ServiceCertificateConstraint
49 toEnum 2 = TrustAnchorAssertion
50 toEnum 3 = DomainIssued
51 toEnum n = CertUsage (toEnum n)
52
53data Selector
54 = FullCertificate
55 | SubjectPublicKeyInfo
56 | Selector Word8 -- Selector 255 reserved for private use
57 deriving (Eq,Ord,Show)
58
59instance Enum Selector where
60 fromEnum FullCertificate = 0
61 fromEnum SubjectPublicKeyInfo = 1
62 fromEnum (Selector n) = fromEnum n
63 toEnum 0 = FullCertificate
64 toEnum 1 = SubjectPublicKeyInfo
65 toEnum n = Selector (toEnum n)
66
67data MatchingType
68 = Match_Exact
69 | Match_SHA256
70 | Match_SHA512
71 | Match Word8 -- Match 255 reserved for private use
72 deriving (Eq,Ord,Show)
73
74instance Enum MatchingType where
75 fromEnum Match_Exact = 0
76 fromEnum Match_SHA256 = 1
77 fromEnum Match_SHA512 = 2
78 fromEnum (Match n) = fromEnum n
79 toEnum 0 = Match_Exact
80 toEnum 1 = Match_SHA256
81 toEnum 2 = Match_SHA512
82 toEnum n = Match (toEnum n)
83
84
85data TLSA = TLSA
86 { tlsaCertUsage :: CertUsage
87 , tlsaSelector :: Selector
88 , tlsaMatchingType :: MatchingType
89 , tlsaAssociationData :: BS.ByteString
90 }
91 deriving (Eq, Ord, Show)
92
93fromByteString :: BS.ByteString -> TLSA
94fromByteString bs = TLSA (fromWord8 cu)
95 (fromWord8 sel)
96 (fromWord8 mat)
97 associationData
98 where
99 (csm,associationData) = BS.splitAt 3 bs
100 (cu,sel,mat) =
101 case BS.unpack csm of
102 [cu,sel,mat] -> (cu,sel,mat)
103 [cu,sel] -> (cu,sel,0)
104 [cu] -> (cu,0,0)
105 [] -> (0,0,0)
106
107toByteString :: TLSA -> BS.ByteString
108toByteString (TLSA cu sel mat associationData) = csm <> associationData
109 where
110 csm = BS.pack [ toWord8 cu
111 , toWord8 sel
112 , toWord8 mat ]
113
114match :: Certificate -> TLSA -> Bool
115match cert tlsa = fromMaybe False $
116 (== tlsaAssociationData tlsa) <$> (hash <*> material)
117
118 where
119 encode obj = encodeASN1 DER (toASN1 obj [])
120
121 material =
122 case tlsaSelector tlsa of
123 FullCertificate -> Just $ encode cert
124 SubjectPublicKeyInfo -> Just $ encode $ certPubKey cert
125 _ -> Nothing
126
127 hash =
128 case tlsaMatchingType tlsa of
129 Match_Exact -> Just L.toStrict
130 Match_SHA256 -> Just SHA256.hashlazy
131 Match_SHA512 -> Just SHA512.hashlazy
132 _ -> Nothing
133