certificate 0.4.0 → 0.6.0

raw patch · 9 files changed

+765/−582 lines, 9 filesdep −binarydep ~asn1-datadep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: binary

Dependency ranges changed: asn1-data, base

API changes (from Hackage documentation)

Files

• Certificate.hs +99/−73
• Data/Certificate/Key.hs +0/−73
• Data/Certificate/KeyDSA.hs +63/−0
• Data/Certificate/KeyRSA.hs +77/−0
• Data/Certificate/PEM.hs +1/−0
• Data/Certificate/X509.hs +51/−432
• Data/Certificate/X509Cert.hs +376/−0
• Data/Certificate/X509Internal.hs +92/−0
• certificate.cabal +6/−4

@@ -6,7 +6,8 @@ import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Certificate.X509-import Data.Certificate.Key+import Data.Certificate.KeyRSA as KeyRSA+import Data.Certificate.KeyDSA as KeyDSA import Data.Certificate.PEM import System.Console.CmdArgs import Control.Monad@@ -14,12 +15,9 @@ import Data.Maybe import System.Exit -import Data.ASN1.DER+import Data.ASN1.DER (decodeASN1Stream, ASN1(..), ASN1ConstructionType(..)) import Numeric -readprivate :: FilePath -> IO (Either String PrivateKey)-readprivate file = B.readFile file >>= return . maybe (Left "no valid private RSA key found") (decodePrivateKey . L.fromChunks . (:[])) . parsePEMKeyRSA- hexdump :: L.ByteString -> String hexdump bs = concatMap hex $ L.unpack bs 	where hex n@@ -30,8 +28,8 @@  showExts e = putStrLn $ show e -showCert :: Certificate -> IO ()-showCert cert = do+showCert :: X509 -> IO ()+showCert (X509 cert _ sigalg sigbits) = do 	putStrLn ("version: " ++ show (certVersion cert)) 	putStrLn ("serial:  " ++ show (certSerial cert)) 	putStrLn ("sigalg:  " ++ show (certSignatureAlg cert))@@ -43,61 +41,79 @@ 	putStrLn ("pk:     " ++ show (certPubKey cert)) 	putStrLn "exts:" 	showExts $ certExtensions cert-	putStrLn ("sig:    " ++ show (certSignature cert))-	putStrLn ("other:  " ++ show (certOthers cert))+	putStrLn ("sigAlg: " ++ show sigalg)+	putStrLn ("sig:    " ++ show sigbits)  -showKey :: PrivateKey -> String-showKey key = unlines-	[ "version:          " ++ (show $ privKey_version key)-	, "len-modulus:      " ++ (show $ privKey_lenmodulus key)-	, "modulus:          " ++ (show $ privKey_modulus key)-	, "public exponant:  " ++ (show $ privKey_public_exponant key)-	, "private exponant: " ++ (show $ privKey_private_exponant key)-	, "p1:               " ++ (show $ privKey_p1 key)-	, "p2:               " ++ (show $ privKey_p2 key)-	, "exp1:             " ++ (show $ privKey_exp1 key)-	, "exp2:             " ++ (show $ privKey_exp2 key)-	, "coefficient:      " ++ (show $ privKey_coef key)+showRSAKey :: KeyRSA.Private -> String+showRSAKey key = unlines+	[ "version:          " ++ (show $ KeyRSA.version key)+	, "len-modulus:      " ++ (show $ KeyRSA.lenmodulus key)+	, "modulus:          " ++ (show $ KeyRSA.modulus key)+	, "public exponant:  " ++ (show $ KeyRSA.public_exponant key)+	, "private exponant: " ++ (show $ KeyRSA.private_exponant key)+	, "p1:               " ++ (show $ KeyRSA.p1 key)+	, "p2:               " ++ (show $ KeyRSA.p2 key)+	, "exp1:             " ++ (show $ KeyRSA.exp1 key)+	, "exp2:             " ++ (show $ KeyRSA.exp2 key)+	, "coefficient:      " ++ (show $ KeyRSA.coef key) 	] -showASN1 :: ASN1 -> IO ()+showDSAKey :: KeyDSA.Private -> String+showDSAKey key = unlines+	[ "version: " ++ (show $ KeyDSA.version key)+	, "priv     " ++ (show $ KeyDSA.priv key)+	, "pub:     " ++ (show $ KeyDSA.pub key)+	, "p:       " ++ (show $ KeyDSA.p key)+	, "q:       " ++ (show $ KeyDSA.q key)+	, "g:       " ++ (show $ KeyDSA.g key)+	]++showASN1 :: [ASN1] -> IO () showASN1 = prettyPrint 0 where-	prettyPrint l a = indent l >> p l a >> putStrLn ""-	indent l        = putStr (replicate l ' ')-	p _ (EOC)                  = putStr ""-	p _ (Boolean b)            = putStr ("bool: " ++ show b)-	p _ (IntVal i)             = putStr ("int: " ++ showHex i "")-	p _ (BitString i bs)       = putStr ("bitstring: " ++ hexdump bs)-	p _ (OctetString bs)       = putStr ("octetstring: " ++ hexdump bs)-	p _ (Null)                 = putStr "null"-	p _ (OID is)               = putStr ("OID: " ++ show is) -	p _ (Real d)               = putStr "real"-	p _ (Enumerated)           = putStr "enum"-	p _ (UTF8String t)         = putStr ("utf8string:" ++ T.unpack t)-	p l (Sequence o)           = putStrLn "sequence" >> mapM_ (prettyPrint (l+1)) o >> indent l >> putStr "end-sequence"-	p l (Set o)                = putStrLn "set" >> mapM_ (prettyPrint (l+1)) o >> indent l >> putStr "end-set"-	p _ (NumericString bs)     = putStr "numericstring:"-	p _ (PrintableString t)    = putStr ("printablestring: " ++ T.unpack t)-	p _ (T61String bs)         = putStr "t61string:"-	p _ (VideoTexString bs)    = putStr "videotexstring:"-	p _ (IA5String bs)         = putStr "ia5string:"-	p _ (UTCTime time)         = putStr ("utctime: " ++ show time)-	p _ (GeneralizedTime time) = putStr ("generalizedtime: " ++ show time)-	p _ (GraphicString bs)     = putStr "graphicstring:"-	p _ (VisibleString bs)     = putStr "visiblestring:"-	p _ (GeneralString bs)     = putStr "generalstring:"-	p _ (UniversalString t)    = putStr ("universalstring:" ++ T.unpack t)-	p _ (CharacterString bs)   = putStr "characterstring:"-	p _ (BMPString t)          = putStr ("bmpstring: " ++ T.unpack t)-	p l (Other tc tn x)        = putStr "other:"+	indent n = putStr (replicate n ' ') -mainX509 :: CertMainOpts -> IO ()-mainX509 opts = do+	prettyPrint n []                 = return ()+	prettyPrint n (x@(Start _) : xs) = indent n >> p x >> putStrLn "" >> prettyPrint (n+1) xs+	prettyPrint n (x@(End _) : xs)   = indent (n-1) >> p x >> putStrLn "" >> prettyPrint (n-1) xs+	prettyPrint n (x : xs)           = indent n >> p x >> putStrLn "" >> prettyPrint n xs++	p (Boolean b)            = putStr ("bool: " ++ show b)+	p (IntVal i)             = putStr ("int: " ++ showHex i "")+	p (BitString i bs)       = putStr ("bitstring: " ++ hexdump bs)+	p (OctetString bs)       = putStr ("octetstring: " ++ hexdump bs)+	p (Null)                 = putStr "null"+	p (OID is)               = putStr ("OID: " ++ show is)+	p (Real d)               = putStr "real"+	p (Enumerated)           = putStr "enum"+	p (UTF8String t)         = putStr ("utf8string:" ++ T.unpack t)+	p (Start Sequence)       = putStr "sequence"+	p (End Sequence)         = putStr "end-sequence"+	p (Start Set)            = putStr "set"+	p (End Set)              = putStr "end-set"+	p (Start _)              = putStr "container"+	p (End _)                = putStr "end-container"+	p (NumericString bs)     = putStr "numericstring:"+	p (PrintableString t)    = putStr ("printablestring: " ++ T.unpack t)+	p (T61String bs)         = putStr "t61string:"+	p (VideoTexString bs)    = putStr "videotexstring:"+	p (IA5String bs)         = putStr "ia5string:"+	p (UTCTime time)         = putStr ("utctime: " ++ show time)+	p (GeneralizedTime time) = putStr ("generalizedtime: " ++ show time)+	p (GraphicString bs)     = putStr "graphicstring:"+	p (VisibleString bs)     = putStr "visiblestring:"+	p (GeneralString bs)     = putStr "generalstring:"+	p (UniversalString t)    = putStr ("universalstring:" ++ T.unpack t)+	p (CharacterString bs)   = putStr "characterstring:"+	p (BMPString t)          = putStr ("bmpstring: " ++ T.unpack t)+	p (Other tc tn x)        = putStr "other"++doMain :: CertMainOpts -> IO ()+doMain opts@(X509Opt _ _ _ _) = do 	cert <- maybe (error "cannot read PEM certificate") (id) . parsePEMCert <$> B.readFile (head $ files opts)  	when (raw opts) $ putStrLn $ hexdump $ L.fromChunks [cert]-	when (asn1 opts) $ case decodeASN1 $ L.fromChunks [cert] of+	when (asn1 opts) $ case decodeASN1Stream $ L.fromChunks [cert] of 		Left err   -> error ("decoding ASN1 failed: " ++ show err) 		Right asn1 -> showASN1 asn1 	when (text opts || not (or [asn1 opts,raw opts])) $ case decodeCertificate $ L.fromChunks [cert] of@@ -105,30 +121,42 @@ 		Right c    -> showCert c 	exitSuccess 	-mainKey :: CertMainOpts -> IO ()-mainKey opts = do-	c <- readprivate $ head $ files opts-	case c of-		Left err   -> error err-		Right cert -> putStrLn $ showKey cert+doMain (Key files) = do+	content <- B.readFile $ head files+	let pems = parsePEMs content+	let rsadata = findPEM "RSA PRIVATE KEY" pems+	let dsadata = findPEM "DSA PRIVATE KEY" pems+	case (rsadata, dsadata) of+		(Just x, _) -> do+			let rsaKey = KeyRSA.decodePrivate $ L.fromChunks [x]+			case rsaKey of+				Left err   -> error err+				Right k -> putStrLn $ showRSAKey k+		(_, Just x) -> do+			let rsaKey = KeyDSA.decodePrivate $ L.fromChunks [x]+			case rsaKey of+				Left err   -> error err+				Right k -> putStrLn $ showDSAKey k+		_ -> do+			putStrLn "no recognized private key found"  data CertMainOpts =-	  X509+	  X509Opt 		{ files :: [FilePath]-		, asn1 :: Bool-		, text :: Bool-		, raw :: Bool+		, asn1  :: Bool+		, text  :: Bool+		, raw   :: Bool 		} 	| Key 		{ files :: [FilePath] 		} 	deriving (Show,Data,Typeable) -x509Opts = X509+x509Opts = X509Opt 	{ files = def &= args &= typFile-	, asn1 = def-	, text = def-	, raw = def+	, asn1  = def+	, text  = def+	, raw   = def 	} &= help "x509 certificate related commands"  keyOpts = Key@@ -136,10 +164,8 @@ 	} &= help "keys related commands"  mode = cmdArgsMode $ modes [x509Opts,keyOpts]-	&= help "create, manipulate certificate (x509,etc) and keys" &= program "certificate" &= summary "certificate v0.1"+	&= help "create, manipulate certificate (x509,etc) and keys"+	&= program "certificate"+	&= summary "certificate v0.1" -main = do-	x <- cmdArgsRun mode-	case x of-		X509 _ _ _ _ -> mainX509 x-		Key  _ -> mainKey x+main = cmdArgsRun mode >>= doMain

@@ -1,73 +0,0 @@--- |--- Module      : Data.Certificate.Key--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : unknown------ Read/Write Private Key-----module Data.Certificate.Key (-	PrivateKey(..),-	decodePrivateKey,-	encodePrivateKey-	) where--import Data.ASN1.DER hiding (decodeASN1)-import Data.ASN1.BER (decodeASN1)-import qualified Data.ByteString.Lazy as L--data PrivateKey = PrivateKey-	{ privKey_version :: Int-	, privKey_lenmodulus :: Int-	, privKey_modulus :: Integer-	, privKey_public_exponant :: Integer-	, privKey_private_exponant :: Integer-	, privKey_p1 :: Integer-	, privKey_p2 :: Integer-	, privKey_exp1 :: Integer-	, privKey_exp2 :: Integer-	, privKey_coef :: Integer-	}--parsePrivateKey :: ASN1 -> Either String PrivateKey-parsePrivateKey x =-	case x of-		Sequence [ IntVal ver, IntVal modulus, IntVal pub_exp-		         , IntVal priv_exp, IntVal p1, IntVal p2-		         , IntVal exp1, IntVal exp2, IntVal coef ] ->-			Right $ PrivateKey-				{ privKey_version = fromIntegral ver-				, privKey_lenmodulus = calculate_modulus modulus 1-				, privKey_modulus = modulus-				, privKey_public_exponant = pub_exp-				, privKey_private_exponant = priv_exp-				, privKey_p1 = p1-				, privKey_p2 = p2-				, privKey_exp1 = exp1-				, privKey_exp2 = exp2-				, privKey_coef = coef }-		_ ->-			Left "unexpected format"-	where-		calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)--decodePrivateKey :: L.ByteString -> Either String PrivateKey-decodePrivateKey dat = either (Left . show) parsePrivateKey $ decodeASN1 dat--encodePrivateKey :: PrivateKey -> L.ByteString-encodePrivateKey pk = encodeASN1 pkseq-	where-		pkseq = Sequence [ IntVal ver, IntVal modulus, IntVal pub_exp-		                 , IntVal priv_exp, IntVal p1, IntVal p2-		                 , IntVal exp1, IntVal exp2, IntVal coef ]-		ver = fromIntegral $ privKey_version pk-		modulus = privKey_modulus pk-		pub_exp = privKey_public_exponant pk-		priv_exp = privKey_private_exponant pk-		p1 = privKey_p1 pk-		p2 = privKey_p2 pk-		exp1 = privKey_exp1 pk-		exp2 = privKey_exp2 pk-		coef = fromIntegral $ privKey_coef pk

@@ -0,0 +1,63 @@+-- |+-- Module      : Data.Certificate.Key+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- Read/Write Private Key+--++module Data.Certificate.KeyDSA+	( Private(..)+	, decodePrivate+	, encodePrivate+	) where++import Data.ASN1.DER (encodeASN1Stream, ASN1(..), ASN1ConstructionType(..))+import Data.ASN1.BER (decodeASN1Stream)+import qualified Data.ByteString.Lazy as L++data Private = Private+	{ version :: Int+	, priv    :: Integer+	, pub     :: Integer+	, p       :: Integer+	, q       :: Integer+	, g       :: Integer+	}++parsePrivate :: [ASN1] -> Either String Private+parsePrivate+	[ Start Sequence+	, IntVal ver, IntVal p_pub, IntVal p_priv, IntVal p_p, IntVal p_g, IntVal p_q+	, End Sequence ] =+		Right $ Private+			{ version = fromIntegral ver+			, priv    = p_priv+			, pub     = p_pub+			, p       = p_p+			, q       = p_q+			, g       = p_g+			}++parsePrivate _ = Left "unexpected format"++decodePrivate :: L.ByteString -> Either String Private+decodePrivate dat = either (Left . show) parsePrivate $ decodeASN1Stream dat++encodePrivate :: Private -> L.ByteString+encodePrivate pk =+	case encodeASN1Stream pkseq of+		Left err  -> error $ show err+		Right lbs -> lbs+	where pkseq =+		[ Start Sequence+		, IntVal $ fromIntegral $ version pk+		, IntVal $ pub pk+		, IntVal $ priv pk+		, IntVal $ p pk+		, IntVal $ g pk+		, IntVal $ q pk+		, End Sequence+		]

@@ -0,0 +1,77 @@+-- |+-- Module      : Data.Certificate.Key+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- Read/Write Private RSA Key+--++module Data.Certificate.KeyRSA+	( Private(..)+	, decodePrivate+	, encodePrivate+	) where++import Data.ASN1.DER (encodeASN1Stream, ASN1(..), ASN1ConstructionType(..))+import Data.ASN1.BER (decodeASN1Stream)+import qualified Data.ByteString.Lazy as L++data Private = Private+	{ version          :: Int+	, lenmodulus       :: Int+	, modulus          :: Integer+	, public_exponant  :: Integer+	, private_exponant :: Integer+	, p1               :: Integer+	, p2               :: Integer+	, exp1             :: Integer+	, exp2             :: Integer+	, coef             :: Integer+	}++parsePrivate :: [ASN1] -> Either String Private+parsePrivate+	[ Start Sequence+	, IntVal ver, IntVal p_modulus, IntVal pub_exp+	, IntVal priv_exp, IntVal p_p1, IntVal p_p2+	, IntVal p_exp1, IntVal p_exp2, IntVal p_coef+	, End Sequence ] =+		Right $ Private+			{ version          = fromIntegral ver+			, lenmodulus       = calculate_modulus p_modulus 1+			, modulus          = p_modulus+			, public_exponant  = pub_exp+			, private_exponant = priv_exp+			, p1               = p_p1+			, p2               = p_p2+			, exp1             = p_exp1+			, exp2             = p_exp2+			, coef             = p_coef+			}+	where+		calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)+parsePrivate _ = Left "unexpected format"++decodePrivate :: L.ByteString -> Either String Private+decodePrivate dat = either (Left . show) parsePrivate $ decodeASN1Stream dat++encodePrivate :: Private -> L.ByteString+encodePrivate pk =+	case encodeASN1Stream pkseq of+		Left err  -> error $ show err+		Right lbs -> lbs+	where pkseq =+		[ Start Sequence+		, IntVal $ fromIntegral $ version pk+		, IntVal $ modulus pk+		, IntVal $ public_exponant pk+		, IntVal $ private_exponant pk+		, IntVal $ p1 pk+		, IntVal $ p2 pk+		, IntVal $ exp1 pk+		, IntVal $ exp2 pk+		, IntVal $ fromIntegral $ coef pk+		, End Sequence+		]

@@ -16,6 +16,7 @@ 	, parsePEMKeyRSA 	, parsePEMKeyDSA 	, parsePEMs+	, findPEM 	) where  import Data.ByteString (ByteString)

@@ -1,5 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- -- | -- Module      : Data.Certificate.X509 -- License     : BSD-style@@ -13,19 +11,16 @@ module Data.Certificate.X509 	( 	-- * Data Structure-	  SignatureALG(..)+	  X509(..)+	-- * Data Structure (reexported from X509Cert)+	, SignatureALG(..) 	, PubKeyALG(..) 	, PubKeyDesc(..) 	, PubKey(..)-	, Certificate(..) 	, ASN1StringType(..) 	, ASN1String--	-- * some common OIDs found in certificate Distinguish Names-	, oidCommonName-	, oidCountry-	, oidOrganization-	, oidOrganizationUnit+	, Certificate(..)+	, CertificateExts(..)  	-- * serialization from ASN1 bytestring 	, decodeCertificate@@ -33,437 +28,61 @@ 	) where  import Data.Word-import Data.List (find) import Data.ASN1.DER-import Data.Maybe-import Data.ByteString.Lazy (ByteString)-import Data.Text.Lazy (Text)+import Data.ASN1.Stream (getConstructedEndRepr)+import Data.ASN1.Raw (toBytes) import qualified Data.ByteString.Lazy as L-import Control.Monad.State-import Control.Monad.Error -{--the structure of an X509 Certificate is the following:--Certificate-	Version-	Serial Number-	Algorithm ID-	Issuer-	Validity-		Not Before-		Not After-	Subject-	Subject Public Key Info-		Public Key Algorithm-		Subject Public Key-	Issuer Unique Identifier (Optional)  (>= 2)-	Subject Unique Identifier (Optional) (>= 2)-	Extensions (Optional)   (>= v3)-	...-Certificate Signature Algorithm-Certificate Signature--}--{--data CertError =-	  CertErrorMissing String-	| CertErrorBadFormat String-	| CertErrorMisc String-	deriving (Show)--}-type OID = [Integer]--data SignatureALG =-	  SignatureALG_md5WithRSAEncryption-	| SignatureALG_md2WithRSAEncryption-	| SignatureALG_sha1WithRSAEncryption-	| SignatureALG_dsaWithSHA1-	| SignatureALG_ecdsaWithSHA384-	| SignatureALG_Unknown OID-	deriving (Show, Eq)--data PubKeyALG =-	  PubKeyALG_RSA-	| PubKeyALG_DSA-	| PubKeyALG_ECDSA-	| PubKeyALG_Unknown OID-	deriving (Show,Eq)--data PubKeyDesc =-	  PubKeyRSA (Int, Integer, Integer)              -- ^ RSA format with (len modulus, modulus, e)-	| PubKeyDSA (Integer, Integer, Integer, Integer) -- ^ DSA format with (pub, p, q, g)-	| PubKeyECDSA ASN1                               -- ^ ECDSA format not done yet FIXME-	| PubKeyUnknown [Word8]                          -- ^ unrecognized format-	deriving (Show,Eq)+import Data.Certificate.X509Internal+import Data.Certificate.X509Cert -data PubKey = PubKey PubKeyALG PubKeyDesc -- OID RSA|DSA|rawdata+data X509 = X509 Certificate (Maybe L.ByteString) SignatureALG [Word8] 	deriving (Show,Eq) --- 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 ASN1StringType = UTF8 | Printable | Univ | BMP | IA5 deriving (Show,Eq)-type ASN1String = (ASN1StringType, Text)--oidCommonName, oidCountry, oidOrganization, oidOrganizationUnit :: OID-oidCommonName       = [2,5,4,3]-oidCountry          = [2,5,4,6]-oidOrganization     = [2,5,4,10]-oidOrganizationUnit = [2,5,4,11]--data Certificate = Certificate-	{ certVersion      :: Int                           -- ^ Certificate Version-	, certSerial       :: Integer                       -- ^ Certificate Serial number-	, certSignatureAlg :: SignatureALG                  -- ^ Certificate Signature algorithm-	, certIssuerDN     :: [ (OID, ASN1String) ]         -- ^ Certificate Issuer DN-	, certSubjectDN    :: [ (OID, ASN1String) ]         -- ^ Certificate Subject DN-	, certValidity     :: (Time, Time)                  -- ^ Certificate Validity period-	, certPubKey       :: PubKey                        -- ^ Certificate Public key-	, certExtensions   :: Maybe CertificateExts         -- ^ Certificate Extensions-	, certSignature    :: Maybe (SignatureALG, [Word8]) -- ^ Certificate Signature Algorithm and Signature-	, certOthers       :: [ASN1]                        -- ^ any others fields not parsed-	} deriving (Show,Eq)--{- | parse a RSA pubkeys from ASN1 encoded bits.- - return PubKeyRSA (len-modulus, modulus, e) if successful -}-parse_RSA :: ByteString -> PubKeyDesc-parse_RSA bits =-	case decodeASN1 $ bits of-		Right (Sequence [ IntVal modulus, IntVal pubexp ]) ->-			PubKeyRSA (calculate_modulus modulus 1, modulus, pubexp)-		_ ->-			PubKeyUnknown $ L.unpack bits-	where-		calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)--parse_ECDSA :: ByteString -> PubKeyDesc-parse_ECDSA bits =-	case decodeASN1 bits of-		Right l -> PubKeyECDSA l-		Left x  -> PubKeyUnknown $ map (fromIntegral . fromEnum) $ show x--newtype ParseCert a = P { runP :: ErrorT String (State [ASN1]) a }-	deriving (Monad, MonadError String)--runParseCert :: ParseCert a -> [ASN1] -> Either String a-runParseCert f s =-	case runState (runErrorT (runP f)) s of-		(Left err, _) -> Left err-		(Right r, _) -> Right r--getNext :: ParseCert ASN1-getNext = do-	list <- P (lift get)-	case list of-		[]    -> throwError "empty"-		(h:l) -> P (lift (put l)) >> return h--getRemaining :: ParseCert [ASN1]-getRemaining = P (lift get)--hasNext :: ParseCert Bool-hasNext = do-	list <- P (lift get)-	case list of-		[] -> return False-		_  -> return True--lookNext :: ParseCert ASN1-lookNext = do-	list <- P (lift get)-	case list of-		[]    -> throwError "empty"-		(h:_) -> return h--parseCertHeaderVersion :: ParseCert Int-parseCertHeaderVersion = do-	n <- lookNext-	v <- case n of-		Other Context 0 (Right [ IntVal v ]) -> getNext >> return (fromIntegral v)-		_                                    -> return 1-	return v--parseCertHeaderSerial :: ParseCert Integer-parseCertHeaderSerial = do-	n <- getNext-	case n of-		IntVal v -> return v-		_        -> throwError ("missing serial" ++ show n)--sig_table :: [ (OID, SignatureALG) ]-sig_table =-	[ ([1,2,840,113549,1,1,5], SignatureALG_sha1WithRSAEncryption)-	, ([1,2,840,113549,1,1,4], SignatureALG_md5WithRSAEncryption)-	, ([1,2,840,113549,1,1,2], SignatureALG_md2WithRSAEncryption)-	, ([1,2,840,10040,4,3],    SignatureALG_dsaWithSHA1)-	, ([1,2,840,10045,4,3,3],  SignatureALG_ecdsaWithSHA384)-	]--pk_table :: [ (OID, PubKeyALG) ]-pk_table =-	[ ([1,2,840,113549,1,1,1], PubKeyALG_RSA)-	, ([1,2,840,10040,4,1],    PubKeyALG_DSA)-	, ([1,2,840,10045,2,1],    PubKeyALG_ECDSA)-	]--oidSig :: OID -> SignatureALG-oidSig oid = maybe (SignatureALG_Unknown oid) snd $ find ((==) oid . fst) sig_table--oidPubKey :: OID -> PubKeyALG-oidPubKey oid = maybe (PubKeyALG_Unknown oid) snd $ find ((==) oid . fst) pk_table--sigOID :: SignatureALG -> OID-sigOID (SignatureALG_Unknown oid) = oid-sigOID sig = maybe [] fst $ find ((==) sig . snd) sig_table--pubkeyalgOID :: PubKeyALG -> OID-pubkeyalgOID (PubKeyALG_Unknown oid) = oid-pubkeyalgOID sig = maybe [] fst $ find ((==) sig . snd) pk_table--parseCertHeaderAlgorithmID :: ParseCert SignatureALG-parseCertHeaderAlgorithmID = do-	n <- getNext-	case n of-		Sequence [ OID oid, Null ] -> return $ oidSig oid-		Sequence [ OID oid ]       -> return $ oidSig oid-		_                          -> throwError ("algorithm ID bad format " ++ show n)--asn1String :: ASN1 -> ASN1String-asn1String (PrintableString x) = (Printable, x)-asn1String (UTF8String x)      = (UTF8, x)-asn1String (UniversalString x) = (Univ, x)-asn1String (BMPString x)       = (BMP, x)-asn1String (IA5String x)       = (IA5, x)-asn1String x                   = error ("not a print string " ++ show x)--encodeAsn1String :: ASN1String -> ASN1-encodeAsn1String (Printable, x) = PrintableString x-encodeAsn1String (UTF8, x)      = UTF8String x-encodeAsn1String (Univ, x)      = UniversalString x-encodeAsn1String (BMP, x)       = BMPString x-encodeAsn1String (IA5, x)       = IA5String x--parseCertHeaderDN :: ParseCert [ (OID, ASN1String) ]-parseCertHeaderDN = do-	n <- getNext-	case n of-		Sequence l -> mapM parseDNOne l-		_          -> throwError "Distinguished name bad format"-	where-		parseDNOne (Set [ Sequence [OID oid, val]]) = return (oid, asn1String val)-		parseDNOne _                                = throwError "field in dn bad format"--parseCertHeaderValidity :: ParseCert (Time, Time)-parseCertHeaderValidity = do-	n <- getNext-	case n of-		Sequence [ UTCTime t1, UTCTime t2 ] -> return (t1, t2)-		_                                   -> throwError "bad validity format"--matchPubKey :: ASN1 -> ParseCert PubKey-matchPubKey (Sequence[Sequence[OID pkalg,Null],BitString _ bits]) = do-	let sig = oidPubKey pkalg-	let desc = case sig of-		PubKeyALG_RSA                      -> parse_RSA bits-		_                                  -> PubKeyUnknown $ L.unpack bits-	return $ PubKey sig desc--matchPubKey (Sequence[Sequence[OID pkalg,OID pkgalg2],BitString _ bits]) = do-	let sig = oidPubKey pkalg-	let desc = case sig of-		PubKeyALG_ECDSA  -> parse_ECDSA bits-		_                -> PubKeyUnknown $ L.unpack bits-	return $ PubKey sig desc---matchPubKey (Sequence[Sequence[OID pkalg,Sequence[IntVal p,IntVal q,IntVal g]], BitString _ pubenc ]) = do-	let sig = oidPubKey pkalg-	case decodeASN1 pubenc of-		Right (IntVal dsapub) -> return $ PubKey sig (PubKeyDSA (dsapub, p, q, g))-		_                     -> throwError "unrecognized DSA pub format"---matchPubKey n = throwError ("subject public key bad format : " ++ show n)--parseCertHeaderSubjectPK :: ParseCert PubKey-parseCertHeaderSubjectPK = getNext >>= matchPubKey---- 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 [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- - the version, the serial number, the issuer DN, the validity period,- - the subject DN, and the public keys -}-parseCertificate :: ParseCert Certificate-parseCertificate = do-	version  <- parseCertHeaderVersion-	serial   <- parseCertHeaderSerial-	sigalg   <- parseCertHeaderAlgorithmID-	issuer   <- parseCertHeaderDN-	validity <- parseCertHeaderValidity-	subject  <- parseCertHeaderDN-	pk       <- parseCertHeaderSubjectPK-	exts     <- parseCertExtensions-	l        <- getRemaining-	-	return $ Certificate-		{ certVersion      = version-		, certSerial       = serial-		, certSignatureAlg = sigalg-		, certIssuerDN     = issuer-		, certSubjectDN    = subject-		, certValidity     = validity-		, certPubKey       = pk-		, certSignature    = Nothing-		, certExtensions   = exts-		, certOthers       = l-		}--{- | parse root structure of a x509 certificate. this has to be a sequence of 3 objects :- - * the header- - * the signature algorithm- - * the signature -}-processCertificate :: ASN1 -> Either String Certificate-processCertificate (Sequence [ header, sigalg, sig ]) = do-	let sigAlg =-		case sigalg of-			Sequence [ OID oid, Null ] -> oidSig oid-			_                          -> SignatureALG_Unknown []-	let sigbits =-		case sig of-			BitString _ bits -> bits-			_                -> error "signature not in right format"-	case header of-		Sequence l ->-			let cert = runParseCert parseCertificate l in-			either Left (\c -> Right $ c { certSignature = Just (sigAlg, L.unpack sigbits) }) cert-		_          -> Left "Certificate is not a sequence" -	-processCertificate x = Left ("certificate root element error: " ++ show x)--{- | decode a X509 certificate from a bytestring -}-decodeCertificate :: L.ByteString -> Either String Certificate-decodeCertificate by = either (Left . show) processCertificate $ decodeASN1 by--encodeDN :: [ (OID, ASN1String) ] -> ASN1-encodeDN dn = Sequence $ map dnSet dn-	where-		dnSet (oid, stringy) = Set [ Sequence [ OID oid, encodeAsn1String stringy ]]--encodePK :: PubKey -> ASN1-encodePK (PubKey sig (PubKeyRSA (_, modulus, e))) = Sequence [ Sequence [ OID $ pubkeyalgOID sig, Null ], BitString 0 bits ]-	where bits = encodeASN1 $ Sequence [ IntVal modulus, IntVal e ]--encodePK (PubKey sig (PubKeyDSA (pub, p, q, g)))  = Sequence [ Sequence [ OID $ pubkeyalgOID sig, dsaseq ], BitString 0 bits ]+{- | decode an X509 from a bytestring+ - the structure is the following:+ -   Certificate+ -   Certificate Signature Algorithm+ -   Certificate Signature+-}+decodeCertificate :: L.ByteString -> Either String X509+decodeCertificate by = either (Left . show) parseRootASN1 $ decodeASN1StreamRepr by 	where-		dsaseq = Sequence [ IntVal p, IntVal q, IntVal g ]-		bits   = encodeASN1 $ IntVal pub+		{- | parse root structure of a x509 certificate. this has to be a sequence of 3 objects :+		 - * the header+		 - * the signature algorithm+		 - * the signature -}+		parseRootASN1 l = onContainer rootseq $ \l2 ->+				let (certrepr,rem1)  = getConstructedEndRepr l2 in+				let (sigalgseq,rem2) = getConstructedEndRepr rem1 in+				let (sigseq,_)       = getConstructedEndRepr rem2 in+				let cert = onContainer certrepr (runParseASN1 parseCertificate . map fst) in+				case (cert, map fst sigseq) of+					(Right c, [BitString _ b]) ->+						let certevs = toBytes $ concatMap snd certrepr in+						let sigalg  = onContainer sigalgseq (parseSigAlg . map fst) in+						Right $ X509 c (Just certevs) sigalg (L.unpack b)+					(Left err, _) -> Left $ ("certificate error: " ++ show err)+					_             -> Left $ "certificate structure error"+			where+				(rootseq, _) = getConstructedEndRepr l -encodePK (PubKey sig (PubKeyUnknown l))           = Sequence [ Sequence [ OID $ pubkeyalgOID sig, Null ], BitString 0 (L.pack l) ]+		onContainer ((Start _, _) : l) f =+			case reverse l of+				((End _, _) : l2) -> f $ reverse l2+				_                 -> f []+		onContainer _ f = f [] -encodeCertificateHeader :: Certificate -> [ASN1]-encodeCertificateHeader cert =-	[ eVer, eSerial, eAlgId, eIssuer, eValidity, eSubject, epkinfo ] ++ others-	where-		eVer      = Other Context 0 (Right [ IntVal (fromIntegral $ certVersion cert) ])-		eSerial   = IntVal $ certSerial cert-		eAlgId    = Sequence [ OID (sigOID $ certSignatureAlg cert), Null ]-		eIssuer   = encodeDN $ certIssuerDN cert-		(t1, t2)  = certValidity cert-		eValidity = Sequence [ UTCTime t1, UTCTime t2 ]-		eSubject  = encodeDN $ certSubjectDN cert-		epkinfo   = encodePK $ certPubKey cert-		others    = []+		parseSigAlg [ OID oid, Null ] = oidSig oid+		parseSigAlg _                 = SignatureALG_Unknown []  {-| encode a X509 certificate to a bytestring -}-encodeCertificate :: Certificate -> L.ByteString-encodeCertificate cert = encodeASN1 rootSeq+encodeCertificate :: X509 -> L.ByteString+encodeCertificate (X509 cert _ sigalg sigbits) = case encodeASN1Stream rootSeq of+		Right x  -> x+		Left err -> error (show err) 	where-		(sigalg, sigbits) = fromJust $ certSignature cert-		esigalg = Sequence [ OID (sigOID sigalg), Null ]-		esig = BitString 0 $ L.pack sigbits-		header = Sequence $ encodeCertificateHeader cert-		rootSeq = Sequence [ header, esigalg, esig ]+		esigalg   = asn1Container Sequence [OID (sigOID sigalg), Null]+		esig      = BitString 0 $ L.pack sigbits+		header    = asn1Container Sequence $ encodeCertificateHeader cert+		rootSeq   = asn1Container Sequence (header ++ esigalg ++ [esig])

@@ -0,0 +1,376 @@+module Data.Certificate.X509Cert+	( +	-- * Data Structure+	  SignatureALG(..)+	, PubKeyALG(..)+	, PubKeyDesc(..)+	, PubKey(..)+	, ASN1StringType(..)+	, ASN1String+	, Certificate(..)+	, CertificateExts(..)++	-- various OID+	, oidCommonName+	, oidCountry+	, oidOrganization+	, oidOrganizationUnit++	-- signature to/from oid+	, oidSig+	, sigOID++	-- * certificate to/from asn1+	, parseCertificate+	, encodeCertificateHeader+	) where++import Data.Word+import Data.List (find)+import Data.ASN1.DER+import Data.Maybe+import Data.ByteString.Lazy (ByteString)+import Data.Text.Lazy (Text)+import qualified Data.ByteString.Lazy as L+import Control.Monad.State+import Control.Monad.Error+import Data.Certificate.X509Internal++type OID = [Integer]++data SignatureALG =+	  SignatureALG_md5WithRSAEncryption+	| SignatureALG_md2WithRSAEncryption+	| SignatureALG_sha1WithRSAEncryption+	| SignatureALG_dsaWithSHA1+	| SignatureALG_ecdsaWithSHA384+	| SignatureALG_Unknown OID+	deriving (Show, Eq)++data PubKeyALG =+	  PubKeyALG_RSA+	| PubKeyALG_DSA+	| PubKeyALG_ECDSA+	| PubKeyALG_Unknown OID+	deriving (Show,Eq)++data PubKeyDesc =+	  PubKeyRSA (Int, Integer, Integer)              -- ^ RSA format with (len modulus, modulus, e)+	| PubKeyDSA (Integer, Integer, Integer, Integer) -- ^ DSA format with (pub, p, q, g)+	| PubKeyECDSA [ASN1]                             -- ^ ECDSA format not done yet FIXME+	| PubKeyUnknown [Word8]                          -- ^ unrecognized format+	deriving (Show,Eq)++data PubKey = PubKey PubKeyALG PubKeyDesc -- OID RSA|DSA|rawdata+	deriving (Show,Eq)++-- 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 ASN1StringType = UTF8 | Printable | Univ | BMP | IA5 deriving (Show,Eq)+type ASN1String = (ASN1StringType, Text)++data Certificate = Certificate+	{ certVersion      :: Int                   -- ^ Certificate Version+	, certSerial       :: Integer               -- ^ Certificate Serial number+	, certSignatureAlg :: SignatureALG          -- ^ Certificate Signature algorithm+	, certIssuerDN     :: [ (OID, ASN1String) ] -- ^ Certificate Issuer DN+	, certSubjectDN    :: [ (OID, ASN1String) ] -- ^ Certificate Subject DN+	, certValidity     :: (Time, Time)          -- ^ Certificate Validity period+	, certPubKey       :: PubKey                -- ^ Certificate Public key+	, certExtensions   :: Maybe CertificateExts -- ^ Certificate Extensions+	} 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)++oidCommonName, oidCountry, oidOrganization, oidOrganizationUnit :: OID+oidCommonName       = [2,5,4,3]+oidCountry          = [2,5,4,6]+oidOrganization     = [2,5,4,10]+oidOrganizationUnit = [2,5,4,11]++{- | parse a RSA pubkeys from ASN1 encoded bits.+ - return PubKeyRSA (len-modulus, modulus, e) if successful -}+parse_RSA :: ByteString -> PubKeyDesc+parse_RSA bits =+	case decodeASN1Stream $ bits of+		Right [Start Sequence, IntVal modulus, IntVal pubexp, End Sequence] ->+			PubKeyRSA (calculate_modulus modulus 1, modulus, pubexp)+		_ ->+			PubKeyUnknown $ L.unpack bits+	where+		calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)++parse_ECDSA :: ByteString -> PubKeyDesc+parse_ECDSA bits =+	case decodeASN1Stream bits of+		Right l -> PubKeyECDSA l+		Left x  -> PubKeyUnknown $ map (fromIntegral . fromEnum) $ show x+parseCertHeaderVersion :: ParseASN1 Int+parseCertHeaderVersion = do+	v <- onNextContainerMaybe (Container Context 0) $ do+		n <- getNext+		case n of+			IntVal v -> return $ fromIntegral v+			_        -> throwError "unexpected type for version"+	return $ maybe 1 id v++parseCertHeaderSerial :: ParseASN1 Integer+parseCertHeaderSerial = do+	n <- getNext+	case n of+		IntVal v -> return v+		_        -> throwError ("missing serial" ++ show n)++sig_table :: [ (OID, SignatureALG) ]+sig_table =+	[ ([1,2,840,113549,1,1,5], SignatureALG_sha1WithRSAEncryption)+	, ([1,2,840,113549,1,1,4], SignatureALG_md5WithRSAEncryption)+	, ([1,2,840,113549,1,1,2], SignatureALG_md2WithRSAEncryption)+	, ([1,2,840,10040,4,3],    SignatureALG_dsaWithSHA1)+	, ([1,2,840,10045,4,3,3],  SignatureALG_ecdsaWithSHA384)+	]++pk_table :: [ (OID, PubKeyALG) ]+pk_table =+	[ ([1,2,840,113549,1,1,1], PubKeyALG_RSA)+	, ([1,2,840,10040,4,1],    PubKeyALG_DSA)+	, ([1,2,840,10045,2,1],    PubKeyALG_ECDSA)+	]++oidSig :: OID -> SignatureALG+oidSig oid = maybe (SignatureALG_Unknown oid) snd $ find ((==) oid . fst) sig_table++oidPubKey :: OID -> PubKeyALG+oidPubKey oid = maybe (PubKeyALG_Unknown oid) snd $ find ((==) oid . fst) pk_table++sigOID :: SignatureALG -> OID+sigOID (SignatureALG_Unknown oid) = oid+sigOID sig = maybe [] fst $ find ((==) sig . snd) sig_table++pubkeyalgOID :: PubKeyALG -> OID+pubkeyalgOID (PubKeyALG_Unknown oid) = oid+pubkeyalgOID sig = maybe [] fst $ find ((==) sig . snd) pk_table++parseCertHeaderAlgorithmID :: ParseASN1 SignatureALG+parseCertHeaderAlgorithmID = do+	n <- getNextContainer Sequence+	case n of+		[ OID oid, Null ] -> return $ oidSig oid+		[ OID oid ]       -> return $ oidSig oid+		_                 -> throwError ("algorithm ID bad format " ++ show n)++asn1String :: ASN1 -> ASN1String+asn1String (PrintableString x) = (Printable, x)+asn1String (UTF8String x)      = (UTF8, x)+asn1String (UniversalString x) = (Univ, x)+asn1String (BMPString x)       = (BMP, x)+asn1String (IA5String x)       = (IA5, x)+asn1String x                   = error ("not a print string " ++ show x)++encodeAsn1String :: ASN1String -> ASN1+encodeAsn1String (Printable, x) = PrintableString x+encodeAsn1String (UTF8, x)      = UTF8String x+encodeAsn1String (Univ, x)      = UniversalString x+encodeAsn1String (BMP, x)       = BMPString x+encodeAsn1String (IA5, x)       = IA5String x++parseCertHeaderDN :: ParseASN1 [ (OID, ASN1String) ]+parseCertHeaderDN = do+	onNextContainer Sequence getDNs+	where+		getDNs = do+			n <- hasNext+			if n+				then do+					dn <- parseDNOne+					liftM (dn :) getDNs+				else return []+		parseDNOne = onNextContainer Set $ do+			s <- getNextContainer Sequence+			case s of+				[OID oid, val] -> return (oid, asn1String val)+				_              -> throwError "expecting sequence"++parseCertHeaderValidity :: ParseASN1 (Time, Time)+parseCertHeaderValidity = do+	n <- getNextContainer Sequence+	case n of+		[ UTCTime t1, UTCTime t2 ] -> return (t1, t2)+		_                          -> throwError "bad validity format"++parseCertHeaderSubjectPK :: ParseASN1 PubKey+parseCertHeaderSubjectPK = onNextContainer Sequence $ do+	l <- getNextContainer Sequence+	bits <- getNextBitString+	case l of+		[OID pkalg,Null]                                                   -> do+			let sig = oidPubKey pkalg+			let desc = case sig of+				PubKeyALG_RSA -> parse_RSA bits+				_             -> PubKeyUnknown $ L.unpack bits+			return $ PubKey sig desc+		[OID pkalg,OID pkalg2]                                            -> do+			let sig = oidPubKey pkalg+			let desc = case sig of+				PubKeyALG_ECDSA  -> parse_ECDSA bits+				_                -> PubKeyUnknown $ L.unpack bits+			return $ PubKey sig desc+		[OID pkalg,Start Sequence,IntVal p,IntVal q,IntVal g,End Sequence] -> do+			let sig = oidPubKey pkalg+			case decodeASN1Stream bits of+				Right [IntVal dsapub] -> return $ PubKey sig (PubKeyDSA (dsapub, p, q, g))+				_                     -> throwError "unrecognized DSA pub format"+		n ->+			throwError ("subject public key bad format : " ++ show n)++	where getNextBitString = getNext >>= \bs -> case bs of+		BitString _ bits -> return bits+		_                -> throwError "expecting bitstring"++-- 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 [Start Sequence, Boolean True, End Sequence]) ->+			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 [OID oid,Boolean True,OctetString obj] = Just (oid, True, decodeASN1Stream obj)+		extractStruct [OID oid,OctetString obj]              = Just (oid, False, decodeASN1Stream obj)+		extractStruct _                                      = Nothing++parseCertExtensions :: ParseASN1 (Maybe CertificateExts)+parseCertExtensions = do+	onNextContainerMaybe (Container Context 3) $ do+		let def = CertificateExts+			{ certExtKeyUsage             = Nothing+			, certExtBasicConstraints     = Nothing+			, certExtSubjectKeyIdentifier = Nothing+			, certExtPolicies             = Nothing+			, certExtOthers               = []+			}+		l <- getNextContainer Sequence+		return $ execState (parseCertExtensionHelper $ makeASN1Sequence l) def++{- | parse header structure of a x509 certificate. the structure the following:+	Version+	Serial Number+	Algorithm ID+	Issuer+	Validity+		Not Before+		Not After+	Subject+	Subject Public Key Info+		Public Key Algorithm+		Subject Public Key+	Issuer Unique Identifier (Optional)  (>= 2)+	Subject Unique Identifier (Optional) (>= 2)+	Extensions (Optional)   (>= v3)+-}+parseCertificate :: ParseASN1 Certificate+parseCertificate = do+	version  <- parseCertHeaderVersion+	serial   <- parseCertHeaderSerial+	sigalg   <- parseCertHeaderAlgorithmID+	issuer   <- parseCertHeaderDN+	validity <- parseCertHeaderValidity+	subject  <- parseCertHeaderDN+	pk       <- parseCertHeaderSubjectPK+	exts     <- parseCertExtensions+	hnext    <- hasNext+	when hnext $ throwError "expecting End Of Data."+	+	return $ Certificate+		{ certVersion      = version+		, certSerial       = serial+		, certSignatureAlg = sigalg+		, certIssuerDN     = issuer+		, certSubjectDN    = subject+		, certValidity     = validity+		, certPubKey       = pk+		, certExtensions   = exts+		}++encodeDN :: [ (OID, ASN1String) ] -> [ASN1]+encodeDN dn = asn1Container Sequence $ concatMap dnSet dn+	where+		dnSet (oid, stringy) = asn1Container Set (asn1Container Sequence [OID oid, encodeAsn1String stringy])++encodePK :: PubKey -> [ASN1]+encodePK (PubKey sig (PubKeyRSA (_, modulus, e))) =+	asn1Container Sequence (asn1Container Sequence [ OID $ pubkeyalgOID sig, Null ] ++ [BitString 0 bits])+	where+		(Right bits) = encodeASN1Stream $ asn1Container Sequence [IntVal modulus, IntVal e]++encodePK (PubKey sig (PubKeyDSA (pub, p, q, g)))  =+	asn1Container Sequence (asn1Container Sequence ([OID $ pubkeyalgOID sig] ++ dsaseq) ++ [BitString 0 bits])+	where+		dsaseq       = asn1Container Sequence [IntVal p,IntVal q,IntVal g]+		(Right bits) = encodeASN1Stream [IntVal pub]++encodePK (PubKey sig (PubKeyUnknown l))           = +	asn1Container Sequence (asn1Container Sequence [OID $ pubkeyalgOID sig, Null] ++ [BitString 0 $ L.pack l])++encodeCertificateHeader :: Certificate -> [ASN1]+encodeCertificateHeader cert =+	eVer ++ eSerial ++ eAlgId ++ eIssuer ++ eValidity ++ eSubject ++ epkinfo ++ eexts+	where+		eVer      = asn1Container (Container Context 0) [IntVal (fromIntegral $ certVersion cert)]+		eSerial   = [IntVal $ certSerial cert]+		eAlgId    = asn1Container Sequence [OID (sigOID $ certSignatureAlg cert), Null]+		eIssuer   = encodeDN $ certIssuerDN cert+		(t1, t2)  = certValidity cert+		eValidity = asn1Container Sequence [UTCTime t1, UTCTime t2]+		eSubject  = encodeDN $ certSubjectDN cert+		epkinfo   = encodePK $ certPubKey cert+		eexts     = [] -- FIXME encode extensions

@@ -0,0 +1,92 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Certificate.X509Internal+	( ParseASN1+	, runParseASN1+	, onNextContainer+	, onNextContainerMaybe+	, getNextContainer+	, getNextContainerMaybe+	, getNext+	, hasNext+	, makeASN1Sequence+	, asn1Container+	) where++import Data.ASN1.DER+import Data.ASN1.Stream (getConstructedEnd)+import Control.Monad.State+import Control.Monad.Error++newtype ParseASN1 a = P { runP :: ErrorT String (State [ASN1]) a }+	deriving (Functor, Monad, MonadError String)++runParseASN1 :: ParseASN1 a -> [ASN1] -> Either String a+runParseASN1 f s =+	case runState (runErrorT (runP f)) s of+		(Left err, _) -> Left err+		(Right r, _) -> Right r++getNext :: ParseASN1 ASN1+getNext = do+	list <- P (lift get)+	case list of+		[]    -> throwError "empty"+		(h:l) -> P (lift (put l)) >> return h++getNextContainer :: ASN1ConstructionType -> ParseASN1 [ASN1]+getNextContainer ty = do+	list <- P (lift get)+	case list of+		[]    -> throwError "empty"+		(h:l) -> if h == Start ty+			then do+				let (l1, l2) = getConstructedEnd 0 l+				P (lift $ put l2) >> return l1+			else throwError "not an expected container"+++onNextContainer :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a+onNextContainer ty f = do+	n <- getNextContainer ty+	case runParseASN1 f n of+		Left err -> throwError err+		Right r  -> return r++getNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])+getNextContainerMaybe ty = do+	list <- P (lift get)+	case list of+		[]    -> return Nothing+		(h:l) -> if h == Start ty+			then do+				let (l1, l2) = getConstructedEnd 0 l+				P (lift $ put l2) >> return (Just l1)+			else return Nothing++onNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)+onNextContainerMaybe ty f = do+	n <- getNextContainerMaybe ty+	case n of+		Just l -> case runParseASN1 f l of+			Left err -> throwError err+			Right r  -> return $ Just r+		Nothing -> return Nothing++hasNext :: ParseASN1 Bool+hasNext = do+	list <- P (lift get)+	case list of+		[] -> return False+		_  -> return True++asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1]+asn1Container ty l = [Start ty] ++ l ++ [End ty]++makeASN1Sequence :: [ASN1] -> [[ASN1]]+makeASN1Sequence list =+	let (l1, l2) = getConstructedEnd 0 list in+	case l2 of+		[] -> []+		_  -> l1 : makeASN1Sequence l2+

@@ -1,5 +1,5 @@ Name:                certificate-Version:             0.4.0+Version:             0.6.0 Description:     Certificates and Key reader/writer     .@@ -27,15 +27,17 @@  Library   Build-Depends:     base >= 3 && < 7,-                     binary >= 0.5,                      bytestring,                      text >= 0.11,                      mtl,-                     asn1-data >= 0.3 && < 0.4,+                     asn1-data >= 0.4.5 && < 0.5,                      base64-bytestring   Exposed-modules:   Data.Certificate.X509,+                     Data.Certificate.X509Cert,                      Data.Certificate.PEM,-                     Data.Certificate.Key+                     Data.Certificate.KeyDSA+                     Data.Certificate.KeyRSA+  Other-modules:     Data.Certificate.X509Internal   ghc-options:       -Wall  Executable           certificate