certificate 1.0.1 → 1.1.0

raw patch · 5 files changed

+101/−54 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Certificate.hs +14/−2
• Data/Certificate/X509.hs +1/−4
• Data/Certificate/X509/Cert.hs +6/−4
• Data/Certificate/X509/Ext.hs +79/−43
• certificate.cabal +1/−1

@@ -36,8 +36,20 @@  showDN dn = mapM_ (\(oid, (_,t)) -> putStrLn ("  " ++ show oid ++ ": " ++ t)) dn -showExts es = mapM_ (putStrLn . ("  " ++) . showExt) es-	where showExt e = maybe ("unknown: " ++ show e) show $ X509.extDecode e+showExts es = do+	mapM_ showExt es+	putStrLn "known extensions decoded: "+	showKnownExtension (X509.extensionGet es :: Maybe X509.ExtBasicConstraints)+	showKnownExtension (X509.extensionGet es :: Maybe X509.ExtKeyUsage)+	showKnownExtension (X509.extensionGet es :: Maybe X509.ExtSubjectKeyId)+	showKnownExtension (X509.extensionGet es :: Maybe X509.ExtSubjectAltName)+	showKnownExtension (X509.extensionGet es :: Maybe X509.ExtAuthorityKeyId)+	where+		showExt (oid,critical,asn1) = do+			putStrLn ("  OID:  " ++ show oid ++ " critical: " ++ show critical)+			putStrLn ("        " ++ show asn1)+		showKnownExtension Nothing  = return ()+		showKnownExtension (Just e) = putStrLn ("  " ++ show e)  showCert :: X509.X509 -> IO () showCert (X509.X509 cert _ _ sigalg sigbits) = do

@@ -20,10 +20,7 @@ 	, ASN1StringType(..) 	, ASN1String 	, Certificate(..)-	, CertificateExt-	, Ext(..)-	, ExtKeyUsageFlag(..)-	, extDecode+	, module Data.Certificate.X509.Ext  	-- * helper for signing/veryfing certificate 	, getSigningData

@@ -7,7 +7,6 @@ 	, PubKey(..) 	, ASN1StringType(..) 	, ASN1String-	, CertificateExt 	, Certificate(..)  	-- various OID@@ -23,6 +22,9 @@ 	-- * certificate to/from asn1 	, parseCertificate 	, encodeCertificateHeader++	-- * extensions+	, module Data.Certificate.X509.Ext 	) where  import Data.Word@@ -99,7 +101,7 @@ 	, certSubjectDN    :: [ (OID, ASN1String) ]  -- ^ Certificate Subject DN 	, certValidity     :: (Time, Time)           -- ^ Certificate Validity period 	, certPubKey       :: PubKey                 -- ^ Certificate Public key-	, certExtensions   :: Maybe [CertificateExt] -- ^ Certificate Extensions+	, certExtensions   :: Maybe [ExtensionRaw]   -- ^ Certificate Extensions 	} deriving (Show,Eq)  oidCommonName, oidCountry, oidOrganization, oidOrganizationUnit :: OID@@ -267,7 +269,7 @@ 		BitString bits -> return $ bitArrayGetData bits 		_              -> throwError "expecting bitstring" -parseCertExtensions :: ParseASN1 (Maybe [CertificateExt])+parseCertExtensions :: ParseASN1 (Maybe [ExtensionRaw]) parseCertExtensions = onNextContainerMaybe (Container Context 3) (sortByOID . mapMaybe extractExtension <$> onNextContainer Sequence getSequences) 	where 		sortByOID = sortBy (\(a,_,_) (b,_,_) -> a `compare` b)@@ -349,7 +351,7 @@ 	where 		pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k -encodeExts :: Maybe [CertificateExt] -> [ASN1]+encodeExts :: Maybe [ExtensionRaw] -> [ASN1] encodeExts Nothing  = [] encodeExts (Just l) = asn1Container (Container Context 3) $ concatMap encodeExt l 	where encodeExt (oid, critical, asn1) = case encodeASN1Stream asn1 of

@@ -8,19 +8,27 @@ -- extension processing module. -- module Data.Certificate.X509.Ext-	( CertificateExt-	, Ext(..)+	( ExtensionRaw+	, Extension(..)+	-- * Common extension usually found in x509v3+	, ExtBasicConstraints(..)+	, ExtKeyUsage(..) 	, ExtKeyUsageFlag(..)-	, extDecode+	, ExtSubjectKeyId(..)+	, ExtSubjectAltName(..)+	, ExtAuthorityKeyId(..)+	-- * Accessor turning extension into a specific one+	, extensionGet 	) where  import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L import Data.ASN1.DER import Data.ASN1.BitArray import Data.Certificate.X509.Internal -type CertificateExt = (OID, Bool, [ASN1])+type ExtensionRaw = (OID, Bool, [ASN1])  -- | key usage flag that is found in the key usage extension field. data ExtKeyUsageFlag =@@ -35,51 +43,79 @@ 	| KeyUsage_decipherOnly     -- (8) 	deriving (Show,Eq,Ord,Enum) +{- -- RFC 5280-oidSubjectKeyId, oidKeyUsage, oidBasicConstraints, oidDistributionPoints,-                 oidPolicies, oidPoliciesMapping, oidAuthorityKeyId :: OID-oidSubjectKeyId       = [2,5,29,14]-oidKeyUsage           = [2,5,29,15]-oidBasicConstraints   = [2,5,29,19]+oidDistributionPoints, oidPolicies, oidPoliciesMapping :: OID oidDistributionPoints = [2,5,29,31] oidPolicies           = [2,5,29,32] oidPoliciesMapping    = [2,5,29,33]-oidAuthorityKeyId     = [2,5,29,35]+-} --- | known X509v3 extensions-data Ext =-	  ExtBasicConstraints Bool-	| ExtKeyUsage [ExtKeyUsageFlag]-	| ExtSubjectKeyId L.ByteString-	| ExtAuthorityKeyId B.ByteString+class Extension a where+	extOID    :: a -> OID+	extEncode :: a -> [ASN1]+	extDecode :: [ASN1] -> Either String a++extensionGet :: Extension a => [ExtensionRaw] -> Maybe a+extensionGet []                = Nothing+extensionGet ((oid,_,asn1):xs) = case extDecode asn1 of+	Right b+		| oid == extOID b -> Just b+		| otherwise       -> extensionGet xs+	Left _                    -> extensionGet xs++data ExtBasicConstraints = ExtBasicConstraints Bool 	deriving (Show,Eq) --- | try decoding a certificateExt tuple into a known extension.-extDecode :: CertificateExt -> Maybe Ext-extDecode (oid, _, asn1)-	| oid == oidBasicConstraints = decodeBasicConstraints asn1-	| oid == oidSubjectKeyId     = decodeSubjectKeyId asn1-	| oid == oidAuthorityKeyId   = decodeAuthorityKeyId asn1-	| oid == oidKeyUsage         = decodeKeyUsage asn1-	| otherwise                  = Nothing-	where-		-- basic constraints-		decodeBasicConstraints [Start Sequence,Boolean b,End Sequence] =-			Just (ExtBasicConstraints b)-		decodeBasicConstraints _ = Nothing-		-- subject key id-		decodeSubjectKeyId [OctetString o] =-			Just (ExtSubjectKeyId o)-		decodeSubjectKeyId _ = Nothing-		-- key usage-		decodeKeyUsage [BitString bits] = Just $ ExtKeyUsage $ bitsToFlags bits-		decodeKeyUsage _ = Nothing+instance Extension ExtBasicConstraints where+	extOID = const [2,5,29,19]+	extEncode (ExtBasicConstraints b) = [Start Sequence,Boolean b,End Sequence]+	extDecode [Start Sequence,Boolean b,End Sequence] = Right (ExtBasicConstraints b)+	extDecode [Start Sequence,End Sequence] = Right (ExtBasicConstraints False)+	extDecode _ = Left "unknown sequence" -		decodeAuthorityKeyId [Start Sequence,Other Context 0 keyid,End Sequence] = Just $ ExtAuthorityKeyId keyid-		decodeAuthorityKeyId _ = Nothing+data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag]+	deriving (Show,Eq) -		bitsToFlags bits =-			let nb = bitArrayLength bits in-			concat $ flip map [0..(nb-1)] $ \i -> do-				let isSet = bitArrayGetBit bits i-				if isSet then [toEnum $ fromIntegral i] else []+instance Extension ExtKeyUsage where+	extOID = const [2,5,29,15]+	extEncode (ExtKeyUsage _) = undefined+	extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits+	extDecode _ = Left "unknown sequence"++data ExtSubjectKeyId = ExtSubjectKeyId L.ByteString+	deriving (Show,Eq)++instance Extension ExtSubjectKeyId where+	extOID = const [2,5,29,14]+	extEncode (ExtSubjectKeyId _) = undefined+	extDecode [OctetString o] = Right $ ExtSubjectKeyId o+	extDecode _ = Left "unknown sequence"++data ExtSubjectAltName = ExtSubjectAltName [String]+	deriving (Show,Eq)++instance Extension ExtSubjectAltName where+	extOID = const [2,5,29,17]+	extEncode (ExtSubjectAltName _) = undefined+	extDecode l = runParseASN1 parse l where+		parse = do+			c <- getNextContainer Sequence+			return $ ExtSubjectAltName $ map toStringy c+		toStringy (Other Context 2 b) = BC.unpack b+		toStringy b                   = error ("not coping with anything else " ++ show b)++data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString+	deriving (Show,Eq)++instance Extension ExtAuthorityKeyId where+	extOID _ = [2,5,29,35]+	extEncode (ExtAuthorityKeyId _) = undefined+	extDecode [Start Sequence,Other Context 0 keyid,End Sequence] =+		Right $ ExtAuthorityKeyId keyid+	extDecode _ = Left "unknown sequence"++bitsToFlags :: Enum a => BitArray -> [a]+bitsToFlags bits = concat $ flip map [0..(bitArrayLength bits-1)] $ \i -> do+	let isSet = bitArrayGetBit bits i+	if isSet then [toEnum $ fromIntegral i] else []

@@ -1,5 +1,5 @@ Name:                certificate-Version:             1.0.1+Version:             1.1.0 Description:     Certificates and Key reader/writer     .