1-- | 2-- Module : Data.X509.Ext 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- extension processing module. 9-- 10{-# LANGUAGE FlexibleContexts #-} 11{-# LANGUAGE ScopedTypeVariables #-} 12module Data.X509.Ext 13 ( Extension(..) 14 -- * Common extension usually found in x509v3 15 , ExtBasicConstraints(..) 16 , ExtKeyUsage(..) 17 , ExtKeyUsageFlag(..) 18 , ExtExtendedKeyUsage(..) 19 , ExtKeyUsagePurpose(..) 20 , ExtSubjectKeyId(..) 21 , ExtSubjectAltName(..) 22 , ExtAuthorityKeyId(..) 23 , ExtCrlDistributionPoints(..) 24 , ExtNetscapeComment(..) 25 , AltName(..) 26 , DistributionPoint(..) 27 , ReasonFlag(..) 28 -- * Accessor turning extension into a specific one 29 , extensionGet 30 , extensionGetE 31 , extensionDecode 32 , extensionEncode 33 ) where 34 35import qualified Data.ByteString as B 36import qualified Data.ByteString.Char8 as BC 37import Data.ASN1.Types 38import Data.ASN1.Parse 39import Data.ASN1.Encoding 40import Data.ASN1.BinaryEncoding 41import Data.ASN1.BitArray 42import Data.Proxy 43import Data.List (find) 44import Data.X509.ExtensionRaw 45import Data.X509.DistinguishedName 46import Control.Applicative 47import Control.Monad 48 49-- | key usage flag that is found in the key usage extension field. 50data ExtKeyUsageFlag = 51 KeyUsage_digitalSignature -- (0) 52 | KeyUsage_nonRepudiation -- (1) recent X.509 ver have renamed this bit to contentCommitment 53 | KeyUsage_keyEncipherment -- (2) 54 | KeyUsage_dataEncipherment -- (3) 55 | KeyUsage_keyAgreement -- (4) 56 | KeyUsage_keyCertSign -- (5) 57 | KeyUsage_cRLSign -- (6) 58 | KeyUsage_encipherOnly -- (7) 59 | KeyUsage_decipherOnly -- (8) 60 deriving (Show,Eq,Ord,Enum) 61 62{- 63-- RFC 5280 64oidDistributionPoints, oidPolicies, oidPoliciesMapping :: OID 65oidPolicies = [2,5,29,32] 66oidPoliciesMapping = [2,5,29,33] 67-} 68 69-- | Extension class. 70-- 71-- each extension have a unique OID associated, and a way 72-- to encode and decode an ASN1 stream. 73-- 74-- Errata: turns out, the content is not necessarily ASN1, 75-- it could be data that is only parsable by the extension 76-- e.g. raw ascii string. Add method to parse and encode with 77-- ByteString 78class Extension a where 79 extOID :: a -> OID 80 extHasNestedASN1 :: Proxy a -> Bool 81 extEncode :: a -> [ASN1] 82 extDecode :: [ASN1] -> Either String a 83 84 extDecodeBs :: B.ByteString -> Either String a 85 extDecodeBs = (either (Left . show) Right . decodeASN1' BER) >=> extDecode 86 87 extEncodeBs :: a -> B.ByteString 88 extEncodeBs = encodeASN1' DER . extEncode 89 90 91-- | Get a specific extension from a lists of raw extensions 92extensionGet :: Extension a => Extensions -> Maybe a 93extensionGet (Extensions Nothing) = Nothing 94extensionGet (Extensions (Just l)) = findExt l 95 where findExt [] = Nothing 96 findExt (x:xs) = case extensionDecode x of 97 Just (Right e) -> Just e 98 _ -> findExt xs 99 100-- | Get a specific extension from a lists of raw extensions 101extensionGetE :: Extension a => Extensions -> Maybe (Either String a) 102extensionGetE (Extensions Nothing) = Nothing 103extensionGetE (Extensions (Just l)) = findExt l 104 where findExt [] = Nothing 105 findExt (x:xs) = case extensionDecode x of 106 Just r -> Just r 107 _ -> findExt xs 108 109-- | Try to decode an ExtensionRaw. 110-- 111-- If this function return: 112-- * Nothing, the OID doesn't match 113-- * Just Left, the OID matched, but the extension couldn't be decoded 114-- * Just Right, the OID matched, and the extension has been succesfully decoded 115extensionDecode :: forall a . Extension a => ExtensionRaw -> Maybe (Either String a) 116extensionDecode er@(ExtensionRaw oid _ content) 117 | extOID (undefined :: a) /= oid = Nothing 118 | extHasNestedASN1 (Proxy :: Proxy a) = Just (tryExtRawASN1 er >>= extDecode) 119 | otherwise = Just (extDecodeBs content) 120 121-- | Encode an Extension to extensionRaw 122extensionEncode :: forall a . Extension a => Bool -> a -> ExtensionRaw 123extensionEncode critical ext 124 | extHasNestedASN1 (Proxy :: Proxy a) = ExtensionRaw (extOID ext) critical (encodeASN1' DER $ extEncode ext) 125 | otherwise = ExtensionRaw (extOID ext) critical (extEncodeBs ext) 126 127-- | Basic Constraints 128data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer) 129 deriving (Show,Eq) 130 131instance Extension ExtBasicConstraints where 132 extOID = const [2,5,29,19] 133 extHasNestedASN1 = const True 134 extEncode (ExtBasicConstraints b Nothing) = [Start Sequence,Boolean b,End Sequence] 135 extEncode (ExtBasicConstraints b (Just i)) = [Start Sequence,Boolean b,IntVal i,End Sequence] 136 137 extDecode [Start Sequence,Boolean b,IntVal v,End Sequence] 138 | v >= 0 = Right (ExtBasicConstraints b (Just v)) 139 | otherwise = Left "invalid pathlen" 140 extDecode [Start Sequence,Boolean b,End Sequence] = Right (ExtBasicConstraints b Nothing) 141 extDecode [Start Sequence,End Sequence] = Right (ExtBasicConstraints False Nothing) 142 extDecode _ = Left "unknown sequence" 143 144-- | Describe key usage 145data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag] 146 deriving (Show,Eq) 147 148instance Extension ExtKeyUsage where 149 extOID = const [2,5,29,15] 150 extHasNestedASN1 = const True 151 extEncode (ExtKeyUsage flags) = [BitString $ flagsToBits flags] 152 extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits 153 extDecode _ = Left "unknown sequence" 154 155-- | Key usage purposes for the ExtendedKeyUsage extension 156data ExtKeyUsagePurpose = 157 KeyUsagePurpose_ServerAuth 158 | KeyUsagePurpose_ClientAuth 159 | KeyUsagePurpose_CodeSigning 160 | KeyUsagePurpose_EmailProtection 161 | KeyUsagePurpose_TimeStamping 162 | KeyUsagePurpose_OCSPSigning 163 | KeyUsagePurpose_Unknown OID 164 deriving (Show,Eq,Ord) 165 166extKeyUsagePurposedOID :: [(OID, ExtKeyUsagePurpose)] 167extKeyUsagePurposedOID = 168 [(keyUsagePurposePrefix 1, KeyUsagePurpose_ServerAuth) 169 ,(keyUsagePurposePrefix 2, KeyUsagePurpose_ClientAuth) 170 ,(keyUsagePurposePrefix 3, KeyUsagePurpose_CodeSigning) 171 ,(keyUsagePurposePrefix 4, KeyUsagePurpose_EmailProtection) 172 ,(keyUsagePurposePrefix 8, KeyUsagePurpose_TimeStamping) 173 ,(keyUsagePurposePrefix 9, KeyUsagePurpose_OCSPSigning)] 174 where keyUsagePurposePrefix r = [1,3,6,1,5,5,7,3,r] 175 176-- | Extended key usage extension 177data ExtExtendedKeyUsage = ExtExtendedKeyUsage [ExtKeyUsagePurpose] 178 deriving (Show,Eq) 179 180instance Extension ExtExtendedKeyUsage where 181 extOID = const [2,5,29,37] 182 extHasNestedASN1 = const True 183 extEncode (ExtExtendedKeyUsage purposes) = 184 [Start Sequence] ++ map (OID . lookupRev) purposes ++ [End Sequence] 185 where lookupRev (KeyUsagePurpose_Unknown oid) = oid 186 lookupRev kup = maybe (error "unknown key usage purpose") fst $ find ((==) kup . snd) extKeyUsagePurposedOID 187 extDecode l = ExtExtendedKeyUsage `fmap` (flip runParseASN1 l $ onNextContainer Sequence $ getMany $ do 188 n <- getNext 189 case n of 190 OID o -> return $ maybe (KeyUsagePurpose_Unknown o) id $ lookup o extKeyUsagePurposedOID 191 _ -> error "invalid content in extended key usage") 192 193-- | Provide a way to identify a public key by a short hash. 194data ExtSubjectKeyId = ExtSubjectKeyId B.ByteString 195 deriving (Show,Eq) 196 197instance Extension ExtSubjectKeyId where 198 extOID = const [2,5,29,14] 199 extHasNestedASN1 = const True 200 extEncode (ExtSubjectKeyId o) = [OctetString o] 201 extDecode [OctetString o] = Right $ ExtSubjectKeyId o 202 extDecode _ = Left "unknown sequence" 203 204-- | Different naming scheme use by the extension. 205-- 206-- Not all name types are available, missing: 207-- otherName 208-- x400Address 209-- directoryName 210-- ediPartyName 211-- registeredID 212-- 213data AltName = 214 AltNameRFC822 String 215 | AltNameDNS String 216 | AltNameURI String 217 | AltNameIP B.ByteString 218 | AltNameXMPP String 219 | AltNameDNSSRV String 220 deriving (Show,Eq,Ord) 221 222-- | Provide a way to supply alternate name that can be 223-- used for matching host name. 224data ExtSubjectAltName = ExtSubjectAltName [AltName] 225 deriving (Show,Eq,Ord) 226 227instance Extension ExtSubjectAltName where 228 extOID = const [2,5,29,17] 229 extHasNestedASN1 = const True 230 extEncode (ExtSubjectAltName names) = encodeGeneralNames names 231 extDecode l = runParseASN1 (ExtSubjectAltName <$> parseGeneralNames) l 232 233-- | Provide a mean to identify the public key corresponding to the private key 234-- used to signed a certificate. 235data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString 236 deriving (Show,Eq) 237 238instance Extension ExtAuthorityKeyId where 239 extOID _ = [2,5,29,35] 240 extHasNestedASN1 = const True 241 extEncode (ExtAuthorityKeyId keyid) = 242 [Start Sequence,Other Context 0 keyid,End Sequence] 243 extDecode [Start Sequence,Other Context 0 keyid,End Sequence] = 244 Right $ ExtAuthorityKeyId keyid 245 extDecode _ = Left "unknown sequence" 246 247-- | Identify how CRL information is obtained 248data ExtCrlDistributionPoints = ExtCrlDistributionPoints [DistributionPoint] 249 deriving (Show,Eq) 250 251-- | Reason flag for the CRL 252data ReasonFlag = 253 Reason_Unused 254 | Reason_KeyCompromise 255 | Reason_CACompromise 256 | Reason_AffiliationChanged 257 | Reason_Superseded 258 | Reason_CessationOfOperation 259 | Reason_CertificateHold 260 | Reason_PrivilegeWithdrawn 261 | Reason_AACompromise 262 deriving (Show,Eq,Ord,Enum) 263 264-- | Distribution point as either some GeneralNames or a DN 265data DistributionPoint = 266 DistributionPointFullName [AltName] 267 | DistributionNameRelative DistinguishedName 268 deriving (Show,Eq) 269 270instance Extension ExtCrlDistributionPoints where 271 extOID _ = [2,5,29,31] 272 extHasNestedASN1 = const True 273 extEncode = error "extEncode ExtCrlDistributionPoints unimplemented" 274 extDecode = error "extDecode ExtCrlDistributionPoints unimplemented" 275 --extEncode (ExtCrlDistributionPoints ) 276 277parseGeneralNames :: ParseASN1 [AltName] 278parseGeneralNames = onNextContainer Sequence $ getMany getAddr 279 where 280 getAddr = do 281 m <- onNextContainerMaybe (Container Context 0) getComposedAddr 282 case m of 283 Nothing -> getSimpleAddr 284 Just r -> return r 285 getComposedAddr = do 286 n <- getNext 287 case n of 288 OID [1,3,6,1,5,5,7,8,5] -> do -- xmpp addr 289 c <- getNextContainerMaybe (Container Context 0) 290 case c of 291 Just [ASN1String cs] -> 292 case asn1CharacterToString cs of 293 Nothing -> throwParseError ("GeneralNames: invalid string for XMPP Addr") 294 Just s -> return $ AltNameXMPP s 295 _ -> throwParseError ("GeneralNames: expecting string for XMPP Addr got: " ++ show c) 296 OID [1,3,6,1,5,5,7,8,7] -> do -- DNSSRV addr 297 c <- getNextContainerMaybe (Container Context 0) 298 case c of 299 Just [ASN1String cs] -> 300 case asn1CharacterToString cs of 301 Nothing -> throwParseError ("GeneralNames: invalid string for DNSSrv Addr") 302 Just s -> return $ AltNameDNSSRV s 303 _ -> throwParseError ("GeneralNames: expecting string for DNSSRV Addr got: " ++ show c) 304 OID unknown -> throwParseError ("GeneralNames: unknown OID " ++ show unknown) 305 _ -> throwParseError ("GeneralNames: expecting OID but got " ++ show n) 306 307 getSimpleAddr = do 308 n <- getNext 309 case n of 310 (Other Context 1 b) -> return $ AltNameRFC822 $ BC.unpack b 311 (Other Context 2 b) -> return $ AltNameDNS $ BC.unpack b 312 (Other Context 6 b) -> return $ AltNameURI $ BC.unpack b 313 (Other Context 7 b) -> return $ AltNameIP b 314 _ -> throwParseError ("GeneralNames: not coping with unknown stream " ++ show n) 315 316encodeGeneralNames :: [AltName] -> [ASN1] 317encodeGeneralNames names = 318 [Start Sequence] 319 ++ concatMap encodeAltName names 320 ++ [End Sequence] 321 where encodeAltName (AltNameRFC822 n) = [Other Context 1 $ BC.pack n] 322 encodeAltName (AltNameDNS n) = [Other Context 2 $ BC.pack n] 323 encodeAltName (AltNameURI n) = [Other Context 6 $ BC.pack n] 324 encodeAltName (AltNameIP n) = [Other Context 7 $ n] 325 encodeAltName (AltNameXMPP n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5] 326 ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0) 327 ,End (Container Context 0)] 328 encodeAltName (AltNameDNSSRV n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5] 329 ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0) 330 ,End (Container Context 0)] 331 332bitsToFlags :: Enum a => BitArray -> [a] 333bitsToFlags bits = concat $ flip map [0..(bitArrayLength bits-1)] $ \i -> do 334 let isSet = bitArrayGetBit bits i 335 if isSet then [toEnum $ fromIntegral i] else [] 336 337flagsToBits :: Enum a => [a] -> BitArray 338flagsToBits flags = foldl bitArraySetBit bitArrayEmpty $ map (fromIntegral . fromEnum) flags 339 where bitArrayEmpty = toBitArray (B.pack [0,0]) 7 340 341data ExtNetscapeComment = ExtNetscapeComment B.ByteString 342 deriving (Show,Eq) 343 344instance Extension ExtNetscapeComment where 345 extOID _ = [2,16,840,1,113730,1,13] 346 extHasNestedASN1 = const False 347 extEncode = error "Extension: Netscape Comment do not contain nested ASN1" 348 extDecode = error "Extension: Netscape Comment do not contain nested ASN1" 349 extEncodeBs (ExtNetscapeComment b) = b 350 extDecodeBs = Right . ExtNetscapeComment 351