certificate 0.2.1 → 0.3

raw patch · 4 files changed

+167/−64 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Certificate.hs +2/−2
• Data/Certificate/PEM.hs +45/−22
• Data/Certificate/X509.hs +119/−39
• certificate.cabal +1/−1

@@ -11,10 +11,10 @@ import Data.ASN1.DER  readcert :: FilePath -> IO (Either String Certificate)-readcert file = B.readFile file >>= return . either Left (decodeCertificate . L.fromChunks . (:[])) . parsePEMCert+readcert file = B.readFile file >>= return . maybe (Left "no valid certificate found") (decodeCertificate . L.fromChunks . (:[])) . parsePEMCert  readprivate :: FilePath -> IO (Either String PrivateKey)-readprivate file = B.readFile file >>= return . either Left (decodePrivateKey . L.fromChunks . (:[])) . parsePEMKey+readprivate file = B.readFile file >>= return . maybe (Left "no valid private RSA key found") (decodePrivateKey . L.fromChunks . (:[])) . parsePEMKeyRSA  showCert :: Certificate -> String showCert cert =

@@ -9,35 +9,58 @@ -- -- Read PEM files ---module Data.Certificate.PEM (-	parsePEM,-	parsePEMCert,-	parsePEMKey+module Data.Certificate.PEM+	( parsePEMCert+	, parsePEMCertReq+	, parsePEMKey+	, parsePEMKeyRSA+	, parsePEMKeyDSA+	, parsePEMs 	) where  import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.ByteString.Base64-import Data.Either+import Data.List -mapTill :: (a -> Bool) -> (a -> b) -> [a] -> [b]-mapTill _    _ []     = []-mapTill endp f (x:xs) = if endp x then [] else f x : mapTill endp f xs+type PEM = (String, ByteString) -{- | parse a PEM content that is delimited by the begin string and the end string,-   and returns the base64-decoded bytestring on success or a string on error. -}-parsePEM :: ByteString -> ByteString -> ByteString -> Either String ByteString-parsePEM begin end content =-	concatErrOrContent $ mapTill ((==) end) (decode) $ tail $ dropWhile ((/=) begin) ls-	where-		ls     = BC.split '\n' content-		concatErrOrContent x =-			let (l, r) = partitionEithers x in-			if l == [] then Right $ B.concat r else Left $ head l+takeTillEnd :: [ByteString] -> ([ByteString], [ByteString])+takeTillEnd ls = break (BC.isPrefixOf "-----END ") ls -parsePEMCert :: ByteString -> Either String ByteString-parsePEMCert = parsePEM "-----BEGIN CERTIFICATE-----" "-----END CERTIFICATE-----"+findSectionName :: ByteString -> String+findSectionName s = BC.unpack $ B.take (B.length x - 5) x+	where x = B.drop 11 s -parsePEMKey :: ByteString -> Either String ByteString-parsePEMKey = parsePEM "-----BEGIN RSA PRIVATE KEY-----" "-----END RSA PRIVATE KEY-----"+parsePEMSections :: [ByteString] -> [PEM]+parsePEMSections []     = []+parsePEMSections (x:xs)+	| "-----BEGIN " `B.isPrefixOf` x =+		let (content, rest) = takeTillEnd xs in+		case decode $ B.concat content of+			Left _  -> parsePEMSections rest+			Right y -> (findSectionName x, y) : parsePEMSections rest+	| otherwise                      = parsePEMSections xs++parsePEMs :: ByteString -> [PEM]+parsePEMs content = parsePEMSections $ BC.lines content++findPEM :: String -> [PEM] -> Maybe ByteString+findPEM name = maybe Nothing (Just . snd) . find ((==) name . fst)++parsePEMCert :: ByteString -> Maybe ByteString+parsePEMCert = findPEM "CERTIFICATE" . parsePEMs++parsePEMCertReq :: ByteString -> Maybe ByteString+parsePEMCertReq = findPEM "CERTIFICATE REQUEST" . parsePEMs++parsePEMKeyRSA :: ByteString -> Maybe ByteString+parsePEMKeyRSA = findPEM "RSA PRIVATE KEY" . parsePEMs++parsePEMKeyDSA :: ByteString -> Maybe ByteString+parsePEMKeyDSA = findPEM "DSA PRIVATE KEY" . parsePEMs++{-# DEPRECATED parsePEMKey "use parsePEMKeyRSA now" #-}+parsePEMKey :: ByteString -> Maybe ByteString+parsePEMKey = parsePEMKeyRSA

@@ -73,9 +73,9 @@ 	deriving (Show, Eq)  data PubKeyDesc =-	  PubKeyRSA (Int, Integer, Integer)                   -- ^ RSA format with (len modulus, modulus, e)-	| PubKeyDSA (L.ByteString, Integer, Integer, Integer) -- ^ DSA format with (pub, p, q, g)-	| PubKeyUnknown [Word8]                               -- ^ unrecognized format+	  PubKeyRSA (Int, Integer, Integer)              -- ^ RSA format with (len modulus, modulus, e)+	| PubKeyDSA (Integer, Integer, Integer, Integer) -- ^ DSA format with (pub, p, q, g)+	| PubKeyUnknown [Word8]                          -- ^ unrecognized format 	deriving (Show,Eq)  data PubKey = PubKey SignatureALG PubKeyDesc -- OID RSA|DSA|rawdata@@ -92,6 +92,26 @@ -- FIXME use a proper standard type for representing time. type Time = (Int, Int, Int, Int, Int, Int, Bool) +data CertKeyUsage =+	  CertKeyUsageDigitalSignature+	| CertKeyUsageNonRepudiation+	| CertKeyUsageKeyEncipherment+	| CertKeyUsageDataEncipherment+	| CertKeyUsageKeyAgreement+	| CertKeyUsageKeyCertSign+	| CertKeyUsageCRLSign+	| CertKeyUsageEncipherOnly+	| CertKeyUsageDecipherOnly+	deriving (Show, Eq)++data CertificateExts = CertificateExts+	{ certExtKeyUsage             :: Maybe (Bool, [CertKeyUsage])+	, certExtBasicConstraints     :: Maybe (Bool, Bool)+	, certExtSubjectKeyIdentifier :: Maybe (Bool, [Word8])+	, certExtPolicies             :: Maybe (Bool)+	, certExtOthers               :: [ (OID, Bool, ASN1) ]+	} deriving (Show,Eq)+ data Certificate = Certificate 	{ certVersion      :: Int                           -- ^ Certificate Version 	, certSerial       :: Integer                       -- ^ Certificate Serial number@@ -100,7 +120,7 @@ 	, certSubjectDN    :: CertificateDN                 -- ^ Certificate Subject DN 	, certValidity     :: (Time, Time)                  -- ^ Certificate Validity period 	, certPubKey       :: PubKey                        -- ^ Certificate Public key-	, certExtensions   :: Maybe [ASN1]                  -- ^ Certificate Extensions (format will change)+	, certExtensions   :: Maybe CertificateExts         -- ^ Certificate Extensions 	, certSignature    :: Maybe (SignatureALG, [Word8]) -- ^ Certificate Signature Algorithm and Signature 	, certOthers       :: [ASN1]                        -- ^ any others fields not parsed 	} deriving (Show,Eq)@@ -188,29 +208,32 @@ 	n <- getNext 	case n of 		Sequence [ OID oid, Null ] -> return $ oidSig oid-		_                          -> throwError "algorithm ID bad format"+		Sequence [ OID oid ]       -> return $ oidSig oid+		_                          -> throwError ("algorithm ID bad format " ++ show n) -stringOfASN1PrintString :: ASN1 -> String-stringOfASN1PrintString (PrintableString x) = map (toEnum.fromEnum) $ L.unpack x-stringOfASN1PrintString (UTF8String x)      = map (toEnum.fromEnum) $ L.unpack x-stringOfASN1PrintString x                   = error ("not a print string " ++ show x)+stringOfASN1String :: ASN1 -> String+stringOfASN1String (PrintableString x) = map (toEnum.fromEnum) $ L.unpack x+stringOfASN1String (UTF8String x)      = map (toEnum.fromEnum) $ L.unpack x+stringOfASN1String (T61String x)       = map (toEnum.fromEnum) $ L.unpack x+stringOfASN1String (UniversalString x) = map (toEnum.fromEnum) $ L.unpack x+stringOfASN1String (BMPString x)       = map (toEnum.fromEnum) $ L.unpack x+stringOfASN1String x                   = error ("not a print string " ++ show x)  parseCertHeaderDNHelper :: [ASN1] -> State CertificateDN () parseCertHeaderDNHelper l = do-	forM_ l $ (\e -> do-		case e of-			Set [ Sequence [ OID [2,5,4,3], val ] ] ->-				modify (\s -> s { cdnCommonName = Just $ stringOfASN1PrintString val })-			Set [ Sequence [ OID [2,5,4,6], val ] ] ->-				modify (\s -> s { cdnCountry = Just $ stringOfASN1PrintString val })-			Set [ Sequence [ OID [2,5,4,10], val ] ] ->-				modify (\s -> s { cdnOrganization = Just $ stringOfASN1PrintString val })-			Set [ Sequence [ OID [2,5,4,11], val ] ] ->-				modify (\s -> s { cdnOrganizationUnit = Just $ stringOfASN1PrintString val })-			Set [ Sequence [ OID oid, val ] ] ->-				modify (\s -> s { cdnOthers = (oid, show val) : cdnOthers s })-			_      ->-				return ()+	forM_ l $ (\e -> case e of+		Set [ Sequence [ OID [2,5,4,3], val ] ] ->+			modify (\s -> s { cdnCommonName = Just $ stringOfASN1String val })+		Set [ Sequence [ OID [2,5,4,6], val ] ] ->+			modify (\s -> s { cdnCountry = Just $ stringOfASN1String val })+		Set [ Sequence [ OID [2,5,4,10], val ] ] ->+			modify (\s -> s { cdnOrganization = Just $ stringOfASN1String val })+		Set [ Sequence [ OID [2,5,4,11], val ] ] ->+			modify (\s -> s { cdnOrganizationUnit = Just $ stringOfASN1String val })+		Set [ Sequence [ OID oid, val ] ] ->+			modify (\s -> s { cdnOthers = (oid, show val) : cdnOthers s })+		_      ->+			return () 		)  parseCertHeaderDN :: ParseCert CertificateDN@@ -218,15 +241,14 @@ 	n <- getNext 	case n of 		Sequence l -> do-			let defdn = CertificateDN {-				cdnCommonName       = Nothing,-				cdnCountry          = Nothing,-				cdnOrganization     = Nothing,-				cdnOrganizationUnit = Nothing,-				cdnOthers           = []+			let defdn = CertificateDN+				{ cdnCommonName       = Nothing+				, cdnCountry          = Nothing+				, cdnOrganization     = Nothing+				, cdnOrganizationUnit = Nothing+				, cdnOthers           = [] 				}-			let dn = execState (parseCertHeaderDNHelper l) defdn -			return dn+			return $ execState (parseCertHeaderDNHelper l) defdn  		_          -> throwError "Distinguished name bad format"  parseCertHeaderValidity :: ParseCert (Time, Time)@@ -249,21 +271,77 @@ 				SignatureALG_rsa                   -> parse_RSA bits 				_                                  -> PubKeyUnknown $ L.unpack bits 			return $ PubKey sig desc-		Sequence [ Sequence [ OID pkalg, Sequence [ IntVal dsaP, IntVal dsaQ, IntVal dsaG ]], BitString _ dsapub ] ->+		Sequence [ Sequence [ OID pkalg, Sequence [ IntVal dsaP, IntVal dsaQ, IntVal dsaG ]], BitString _ dsapubenc ] -> 			let sig = oidSig pkalg in-			return $ PubKey sig (PubKeyDSA (dsapub, dsaP, dsaQ, dsaG))+			case decodeASN1 dsapubenc of+				Right (IntVal dsapub) -> return $ PubKey sig (PubKeyDSA (dsapub, dsaP, dsaQ, dsaG))+				_                     -> throwError "unrecognized DSA pub format" 		_ -> 			throwError ("subject public key bad format : " ++ show n) -parseCertExtensions :: ParseCert (Maybe [ASN1])+-- RFC 5280+parseCertExtensionHelper :: [ASN1] -> State CertificateExts ()+parseCertExtensionHelper l = do+	forM_ (mapMaybe extractStruct l) $ \e -> case e of+		([2,5,29,14], critical, Right (OctetString x)) ->+			modify (\s -> s { certExtSubjectKeyIdentifier = Just (critical, L.unpack x) })+		{-+		([2,5,29,15], critical, Right (BitString _ _)) ->+			all the flags:+			digitalSignature        (0),+			nonRepudiation          (1), -- recent editions of X.509 have renamed this bit to contentCommitment+			keyEncipherment         (2),+			dataEncipherment        (3),+			keyAgreement            (4),+			keyCertSign             (5),+			cRLSign                 (6),+			encipherOnly            (7),+			decipherOnly            (8) }++			return ()+		-}+		([2,5,29,19], critical, Right (Sequence [Boolean True])) ->+			modify (\s -> s { certExtBasicConstraints = Just (critical, True) })+		{-+		([2,5,29,31], critical, obj) -> -- distributions points+			return ()+		([2,5,29,32], critical, obj) -> -- policies+			return ()+		([2,5,29,33], critical, obj) -> -- policies mapping+			return ()+		([2,5,29,35], critical, obj) -> -- authority key identifer+			return ()+		-}+		(oid, critical, Right obj)    ->+			modify (\s -> s { certExtOthers = (oid, critical, obj) : certExtOthers s })+		(_, True, Left _)             -> fail "critical extension not understood"+		(_, False, Left _)            -> return ()+	where+		extractStruct (Sequence [ OID oid, Boolean True, OctetString obj ]) = Just (oid, True, decodeASN1 obj)+		extractStruct (Sequence [ OID oid, OctetString obj ])               = Just (oid, False, decodeASN1 obj)+		extractStruct _                                                     = Nothing++parseCertExtensions :: ParseCert (Maybe CertificateExts) parseCertExtensions = do 	h <- hasNext 	if h 		then do 			n <- lookNext 			case n of-				Other Context 3 (Right l) -> getNext >> return (Just l)-				_                         -> return Nothing+				Other Context 3 (Right [Sequence l]) -> do+					_ <- getNext+					let def = CertificateExts+						{ certExtKeyUsage             = Nothing+						, certExtBasicConstraints     = Nothing+						, certExtSubjectKeyIdentifier = Nothing+						, certExtPolicies             = Nothing+						, certExtOthers               = []+						}+					return $ Just $ execState (parseCertExtensionHelper l) def+				Other Context 3 _                    ->+					throwError "certificate header bad format"+				_                                    ->+					return Nothing 		else return Nothing  {- | parse header structure of a x509 certificate. it contains@@ -339,8 +417,10 @@ encodePK (PubKey sig (PubKeyRSA (_, modulus, e))) = Sequence [ Sequence [ OID $ sigOID sig, Null ], BitString 0 bits ] 	where bits = encodeASN1 $ Sequence [ IntVal modulus, IntVal e ] -encodePK (PubKey sig (PubKeyDSA (bits, p, q, g))) = Sequence [ Sequence [ OID $ sigOID sig, dsaseq ], BitString 0 bits ]-	where dsaseq = Sequence [ IntVal p, IntVal q, IntVal g ]+encodePK (PubKey sig (PubKeyDSA (pub, p, q, g)))  = Sequence [ Sequence [ OID $ sigOID sig, dsaseq ], BitString 0 bits ]+	where+		dsaseq = Sequence [ IntVal p, IntVal q, IntVal g ]+		bits   = encodeASN1 $ IntVal pub  encodePK (PubKey sig (PubKeyUnknown l))           = Sequence [ Sequence [ OID $ sigOID sig, Null ], BitString 0 (L.pack l) ] @@ -348,7 +428,7 @@ encodeCertificateHeader cert = 	[ eVer, eSerial, eAlgId, eIssuer, eValidity, eSubject, epkinfo ] ++ others 	where-		eVer      = Other Application 0 (Right [ IntVal (fromIntegral $ certVersion cert) ])+		eVer      = Other Context 0 (Right [ IntVal (fromIntegral $ certVersion cert) ]) 		eSerial   = IntVal $ certSerial cert 		eAlgId    = Sequence [ OID (sigOID $ certSignatureAlg cert), Null ] 		eIssuer   = encodeDN $ certIssuerDN cert

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