certificate 1.2.3 → 1.2.4
raw patch · 6 files changed
+526/−481 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Certificate.KeyRSA: encodePublic :: PublicKey -> ByteString
+ Data.Certificate.X509: decodeDN :: ByteString -> Either String [(OID, ASN1String)]
+ Data.Certificate.X509: encodeDN :: [(OID, ASN1String)] -> Either String ByteString
+ Data.Certificate.X509: type OID = [Integer]
+ Data.Certificate.X509.Cert: encodeDN :: [(OID, ASN1String)] -> [ASN1]
+ Data.Certificate.X509.Cert: parseDN :: ParseASN1 [(OID, ASN1String)]
+ Data.Certificate.X509.Cert: type OID = [Integer]
Files
- Data/Certificate/KeyRSA.hs +87/−65
- Data/Certificate/X509.hs +77/−65
- Data/Certificate/X509/Cert.hs +240/−229
- Data/Certificate/X509/Ext.hs +67/−67
- Data/Certificate/X509/Internal.hs +54/−54
- certificate.cabal +1/−1
Data/Certificate/KeyRSA.hs view
@@ -5,15 +5,16 @@ -- Stability : experimental -- Portability : unknown ----- Read/Write Private RSA Key+-- Read/Write Private/Public RSA Key -- module Data.Certificate.KeyRSA- ( decodePublic- , decodePrivate- , encodePrivate- , parse_RSA- ) where+ ( decodePublic+ , decodePrivate+ , encodePublic+ , encodePrivate+ , parse_RSA+ ) where import Data.ASN1.DER (encodeASN1Stream, ASN1(..), ASN1ConstructionType(..)) import Data.ASN1.BER (decodeASN1Stream)@@ -23,47 +24,68 @@ parsePublic :: [ASN1] -> Either String RSA.PublicKey parsePublic- [ Start Sequence- , Start Sequence- , OID [1,2,840,113549,1,1,1] -- PubKeyALG_RSA- , Null- , End Sequence- , BitString (BitArray _ as1n)- , End Sequence ] = parse_RSA as1n+ [ Start Sequence+ , Start Sequence+ , OID [1,2,840,113549,1,1,1] -- PubKeyALG_RSA+ , Null+ , End Sequence+ , BitString (BitArray _ as1n)+ , End Sequence ] = parse_RSA as1n parsePublic _ = Left "unexpected format" decodePublic :: L.ByteString -> Either String RSA.PublicKey decodePublic dat = either (Left . show) parsePublic $ decodeASN1Stream dat +encodePublic :: RSA.PublicKey -> L.ByteString+encodePublic p =+ let innerSeq = encodeASN1Stream+ [ Start Sequence+ , IntVal $ RSA.public_n p+ , IntVal $ RSA.public_e p+ , End Sequence+ ]+ in case innerSeq of+ Left err -> error $ show err+ Right bs -> case encodeASN1Stream+ [ Start Sequence+ , Start Sequence+ , OID [1,2,840,113549,1,1,1] -- PubKeyALG_RSA+ , Null+ , End Sequence+ , BitString $ toBitArray bs 0+ , End Sequence ] of+ Left err -> error $ show err+ Right ibs -> ibs+ parsePrivate :: [ASN1] -> Either String (RSA.PublicKey, RSA.PrivateKey) parsePrivate- [ Start Sequence- , IntVal 0, 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 (pubkey, privkey)- where- privkey = RSA.PrivateKey- { RSA.private_size = calculate_modulus p_modulus 1- , RSA.private_n = p_modulus- , RSA.private_d = priv_exp- , RSA.private_p = p_p1- , RSA.private_q = p_p2- , RSA.private_dP = p_exp1- , RSA.private_dQ = p_exp2- , RSA.private_qinv = p_coef- }- pubkey = RSA.PublicKey- { RSA.public_size = calculate_modulus p_modulus 1- , RSA.public_n = p_modulus- , RSA.public_e = pub_exp- }- calculate_modulus n i = if (2 ^ (i * 8)) > n- then i- else calculate_modulus n (i+1)+ [ Start Sequence+ , IntVal 0, 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 (pubkey, privkey)+ where+ privkey = RSA.PrivateKey+ { RSA.private_size = calculate_modulus p_modulus 1+ , RSA.private_n = p_modulus+ , RSA.private_d = priv_exp+ , RSA.private_p = p_p1+ , RSA.private_q = p_p2+ , RSA.private_dP = p_exp1+ , RSA.private_dQ = p_exp2+ , RSA.private_qinv = p_coef+ }+ pubkey = RSA.PublicKey+ { RSA.public_size = calculate_modulus p_modulus 1+ , RSA.public_n = p_modulus+ , RSA.public_e = pub_exp+ }+ calculate_modulus n i = if (2 ^ (i * 8)) > n+ then i+ else calculate_modulus n (i+1) parsePrivate (Start Sequence : IntVal n : _)- | n == 0 = Left "RSA key format: not recognized"- | otherwise = Left ("RSA key format: unknown version " ++ show n)+ | n == 0 = Left "RSA key format: not recognized"+ | otherwise = Left ("RSA key format: unknown version " ++ show n) parsePrivate _ = Left "unexpected format" decodePrivate :: L.ByteString -> Either String (RSA.PublicKey, RSA.PrivateKey)@@ -71,34 +93,34 @@ encodePrivate :: (RSA.PublicKey, RSA.PrivateKey) -> L.ByteString encodePrivate (pubkey, privkey) =- case encodeASN1Stream pkseq of- Left err -> error $ show err- Right lbs -> lbs- where pkseq =- [ Start Sequence- , IntVal 0- , IntVal $ RSA.private_n privkey- , IntVal $ RSA.public_e pubkey- , IntVal $ RSA.private_d privkey- , IntVal $ RSA.private_p privkey- , IntVal $ RSA.private_q privkey- , IntVal $ RSA.private_dP privkey- , IntVal $ RSA.private_dQ privkey- , IntVal $ fromIntegral $ RSA.private_qinv privkey- , End Sequence- ]+ case encodeASN1Stream pkseq of+ Left err -> error $ show err+ Right lbs -> lbs+ where pkseq =+ [ Start Sequence+ , IntVal 0+ , IntVal $ RSA.private_n privkey+ , IntVal $ RSA.public_e pubkey+ , IntVal $ RSA.private_d privkey+ , IntVal $ RSA.private_p privkey+ , IntVal $ RSA.private_q privkey+ , IntVal $ RSA.private_dP privkey+ , IntVal $ RSA.private_dQ privkey+ , IntVal $ fromIntegral $ RSA.private_qinv privkey+ , End Sequence+ ] {- | parse a RSA pubkeys from ASN1 encoded bits. - return RSA.PublicKey (len-modulus, modulus, e) if successful -} parse_RSA :: L.ByteString -> Either String RSA.PublicKey parse_RSA bits =- case decodeASN1Stream $ bits of- Right [Start Sequence, IntVal modulus, IntVal pubexp, End Sequence] ->- Right $ RSA.PublicKey- { RSA.public_size = calculate_modulus modulus 1- , RSA.public_n = modulus- , RSA.public_e = pubexp- }- _ -> Left "bad RSA format"- where- calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)+ case decodeASN1Stream $ bits of+ Right [Start Sequence, IntVal modulus, IntVal pubexp, End Sequence] ->+ Right $ RSA.PublicKey+ { RSA.public_size = calculate_modulus modulus 1+ , RSA.public_n = modulus+ , RSA.public_e = pubexp+ }+ _ -> Left "bad RSA format"+ where+ calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)
Data/Certificate/X509.hs view
@@ -9,27 +9,32 @@ -- module Data.Certificate.X509- (- -- * Data Structure- X509(..)- -- * Data Structure (reexported from X509Cert)- , SignatureALG(..)- , HashALG(..)- , PubKeyALG(..)- , PubKey(..)- , ASN1StringType(..)- , ASN1String- , Certificate(..)- , module Data.Certificate.X509.Ext+ (+ -- * Data Structure+ X509(..)+ -- * Data Structure (reexported from X509Cert)+ , SignatureALG(..)+ , HashALG(..)+ , PubKeyALG(..)+ , PubKey(..)+ , OID+ , ASN1StringType(..)+ , ASN1String+ , Certificate(..)+ , module Data.Certificate.X509.Ext - -- * helper for signing/veryfing certificate- , getSigningData+ -- * helper for signing/veryfing certificate+ , getSigningData - -- * serialization from ASN1 bytestring- , decodeCertificate- , encodeCertificate- ) where+ -- * serialization from ASN1 bytestring+ , decodeCertificate+ , encodeCertificate + -- * serialization from ASN1 bytestring+ , decodeDN+ , encodeDN+ ) where+ import Data.Word import Data.ASN1.DER import Data.ASN1.Stream (getConstructedEndRepr)@@ -38,32 +43,33 @@ import qualified Data.ByteString.Lazy as L import Data.Certificate.X509.Internal-import Data.Certificate.X509.Cert+import Data.Certificate.X509.Cert hiding (encodeDN)+import qualified Data.Certificate.X509.Cert as Cert import Data.Certificate.X509.Ext data X509 = X509- { x509Cert :: Certificate -- ^ the certificate part of a X509 structure- , x509CachedSigningData :: (Maybe L.ByteString) -- ^ a cache of the raw representation of the x509 part for signing+ { x509Cert :: Certificate -- ^ the certificate part of a X509 structure+ , x509CachedSigningData :: (Maybe L.ByteString) -- ^ a cache of the raw representation of the x509 part for signing -- since encoding+decoding might not result in the same data being signed.- , x509CachedData :: (Maybe L.ByteString) -- ^ a cache of the raw representation of the whole x509.- , x509SignatureALG :: SignatureALG -- ^ the signature algorithm used.- , x509Signature :: [Word8] -- ^ the signature.- } deriving (Show)+ , x509CachedData :: (Maybe L.ByteString) -- ^ a cache of the raw representation of the whole x509.+ , x509SignatureALG :: SignatureALG -- ^ the signature algorithm used.+ , x509Signature :: [Word8] -- ^ the signature.+ } deriving (Show) instance Eq X509 where- x1 == x2 =- (x509Cert x1 == x509Cert x2) &&- (x509SignatureALG x1 == x509SignatureALG x2) &&- (x509Signature x1 == x509Signature x2)+ x1 == x2 =+ (x509Cert x1 == x509Cert x2) &&+ (x509SignatureALG x1 == x509SignatureALG x2) &&+ (x509Signature x1 == x509Signature x2) {- | get signing data related to a X509 message, - which is either the cached data or the encoded certificate -} getSigningData :: X509 -> L.ByteString getSigningData (X509 _ (Just e) _ _ _) = e getSigningData (X509 cert Nothing _ _ _) = e- where- (Right e) = encodeASN1Stream header- header = asn1Container Sequence $ encodeCertificateHeader cert+ where+ (Right e) = encodeASN1Stream header+ header = asn1Container Sequence $ encodeCertificateHeader cert {- | decode an X509 from a bytestring - the structure is the following:@@ -73,43 +79,49 @@ -} decodeCertificate :: L.ByteString -> Either String X509 decodeCertificate by = either (Left . show) parseRootASN1 $ decodeASN1StreamRepr by- where- {- | 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) (Just by) sigalg (L.unpack $ bitArrayGetData b)- (Left err, _) -> Left $ ("certificate error: " ++ show err)- _ -> Left $ "certificate structure error"- where- (rootseq, _) = getConstructedEndRepr l+ where+ {- | 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) (Just by) sigalg (L.unpack $ bitArrayGetData b)+ (Left err, _) -> Left $ ("certificate error: " ++ show err)+ _ -> Left $ "certificate structure error"+ where+ (rootseq, _) = getConstructedEndRepr l - onContainer ((Start _, _) : l) f =- case reverse l of- ((End _, _) : l2) -> f $ reverse l2- _ -> f []- onContainer _ f = f []+ onContainer ((Start _, _) : l) f =+ case reverse l of+ ((End _, _) : l2) -> f $ reverse l2+ _ -> f []+ onContainer _ f = f [] - parseSigAlg [ OID oid, Null ] = oidSig oid- parseSigAlg _ = SignatureALG_Unknown []+ parseSigAlg [ OID oid, Null ] = oidSig oid+ parseSigAlg _ = SignatureALG_Unknown [] {-| encode a X509 certificate to a bytestring -} encodeCertificate :: X509 -> L.ByteString encodeCertificate (X509 _ _ (Just lbs) _ _ ) = lbs encodeCertificate (X509 cert _ Nothing sigalg sigbits) = case encodeASN1Stream rootSeq of- Right x -> x- Left err -> error (show err)- where- esigalg = asn1Container Sequence [OID (sigOID sigalg), Null]- esig = BitString $ toBitArray (L.pack sigbits) 0- header = asn1Container Sequence $ encodeCertificateHeader cert- rootSeq = asn1Container Sequence (header ++ esigalg ++ [esig])+ Right x -> x+ Left err -> error (show err)+ where+ esigalg = asn1Container Sequence [OID (sigOID sigalg), Null]+ esig = BitString $ toBitArray (L.pack sigbits) 0+ header = asn1Container Sequence $ encodeCertificateHeader cert+ rootSeq = asn1Container Sequence (header ++ esigalg ++ [esig])++decodeDN :: L.ByteString -> Either String [(OID, ASN1String)]+decodeDN by = either (Left . show) (runParseASN1 parseDN) $ decodeASN1Stream by++encodeDN :: [(OID, ASN1String)] -> Either String L.ByteString+encodeDN dn = either (Left . show) Right $ encodeASN1Stream $ Cert.encodeDN dn
Data/Certificate/X509/Cert.hs view
@@ -1,32 +1,37 @@ module Data.Certificate.X509.Cert- ( - -- * Data Structure- SignatureALG(..)- , HashALG(..)- , PubKeyALG(..)- , PubKey(..)- , ASN1StringType(..)- , ASN1String- , Certificate(..)+ (+ -- * Data Structure+ SignatureALG(..)+ , HashALG(..)+ , PubKeyALG(..)+ , PubKey(..)+ , ASN1StringType(..)+ , ASN1String+ , Certificate(..)+ , OID - -- various OID- , oidCommonName- , oidCountry- , oidOrganization- , oidOrganizationUnit+ -- various OID+ , oidCommonName+ , oidCountry+ , oidOrganization+ , oidOrganizationUnit - -- signature to/from oid- , oidSig- , sigOID+ -- signature to/from oid+ , oidSig+ , sigOID - -- * certificate to/from asn1- , parseCertificate- , encodeCertificateHeader+ -- * certificate to/from asn1+ , parseCertificate+ , encodeCertificateHeader - -- * extensions- , module Data.Certificate.X509.Ext- ) where+ -- * Parse and encode a single distinguished name+ , parseDN+ , encodeDN + -- * extensions+ , module Data.Certificate.X509.Ext+ ) where+ import Data.Word import Data.List (find, sortBy) import Data.ASN1.DER@@ -47,64 +52,64 @@ import Data.Certificate.KeyRSA (parse_RSA) data HashALG =- HashMD2- | HashMD5- | HashSHA1- | HashSHA224- | HashSHA256- | HashSHA384- | HashSHA512- deriving (Show,Eq)+ HashMD2+ | HashMD5+ | HashSHA1+ | HashSHA224+ | HashSHA256+ | HashSHA384+ | HashSHA512+ deriving (Show,Eq) data PubKeyALG =- PubKeyALG_RSA- | PubKeyALG_DSA- | PubKeyALG_ECDSA- | PubKeyALG_DH- | PubKeyALG_Unknown OID- deriving (Show,Eq)+ PubKeyALG_RSA+ | PubKeyALG_DSA+ | PubKeyALG_ECDSA+ | PubKeyALG_DH+ | PubKeyALG_Unknown OID+ deriving (Show,Eq) data SignatureALG =- SignatureALG HashALG PubKeyALG- | SignatureALG_Unknown OID- deriving (Show,Eq)+ SignatureALG HashALG PubKeyALG+ | SignatureALG_Unknown OID+ deriving (Show,Eq) data PubKey =- PubKeyRSA RSA.PublicKey -- ^ RSA public key- | PubKeyDSA DSA.PublicKey -- ^ DSA public key- | PubKeyDH (Integer,Integer,Integer,Maybe Integer,([Word8], Integer))- -- ^ DH format with (p,g,q,j,(seed,pgenCounter))- | PubKeyECDSA [ASN1] -- ^ ECDSA format not done yet FIXME- | PubKeyUnknown OID [Word8] -- ^ unrecognized format- deriving (Show,Eq)+ PubKeyRSA RSA.PublicKey -- ^ RSA public key+ | PubKeyDSA DSA.PublicKey -- ^ DSA public key+ | PubKeyDH (Integer,Integer,Integer,Maybe Integer,([Word8], Integer))+ -- ^ DH format with (p,g,q,j,(seed,pgenCounter))+ | PubKeyECDSA [ASN1] -- ^ ECDSA format not done yet FIXME+ | PubKeyUnknown OID [Word8] -- ^ unrecognized format+ deriving (Show,Eq) type Time = (Day, DiffTime, Bool) data CertKeyUsage =- CertKeyUsageDigitalSignature- | CertKeyUsageNonRepudiation- | CertKeyUsageKeyEncipherment- | CertKeyUsageDataEncipherment- | CertKeyUsageKeyAgreement- | CertKeyUsageKeyCertSign- | CertKeyUsageCRLSign- | CertKeyUsageEncipherOnly- | CertKeyUsageDecipherOnly- deriving (Show, Eq)+ CertKeyUsageDigitalSignature+ | CertKeyUsageNonRepudiation+ | CertKeyUsageKeyEncipherment+ | CertKeyUsageDataEncipherment+ | CertKeyUsageKeyAgreement+ | CertKeyUsageKeyCertSign+ | CertKeyUsageCRLSign+ | CertKeyUsageEncipherOnly+ | CertKeyUsageDecipherOnly+ deriving (Show, Eq) data ASN1StringType = UTF8 | Printable | Univ | BMP | IA5 | T61 deriving (Show,Eq) type ASN1String = (ASN1StringType, String) 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 [ExtensionRaw] -- ^ Certificate Extensions- } deriving (Show,Eq)+ { 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 [ExtensionRaw] -- ^ Certificate Extensions+ } deriving (Show,Eq) oidCommonName, oidCountry, oidOrganization, oidOrganizationUnit :: OID oidCommonName = [2,5,4,3]@@ -114,47 +119,47 @@ parse_ECDSA :: ByteString -> ParseASN1 PubKey parse_ECDSA bits =- case decodeASN1Stream bits of- Right l -> return $ PubKeyECDSA l- Left _ -> return $ PubKeyUnknown (pubkeyalgOID PubKeyALG_ECDSA) (L.unpack bits)+ case decodeASN1Stream bits of+ Right l -> return $ PubKeyECDSA l+ Left _ -> return $ PubKeyUnknown (pubkeyalgOID PubKeyALG_ECDSA) (L.unpack bits) 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+ 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)+ 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 HashSHA1 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,4], SignatureALG HashMD5 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,2], SignatureALG HashMD2 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,11], SignatureALG HashSHA256 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,12], SignatureALG HashSHA384 PubKeyALG_RSA)- , ([1,2,840,10040,4,3], SignatureALG HashSHA1 PubKeyALG_DSA)- , ([1,2,840,10045,4,3,1], SignatureALG HashSHA224 PubKeyALG_ECDSA)- , ([1,2,840,10045,4,3,2], SignatureALG HashSHA256 PubKeyALG_ECDSA)- , ([1,2,840,10045,4,3,3], SignatureALG HashSHA384 PubKeyALG_ECDSA)- , ([1,2,840,10045,4,3,4], SignatureALG HashSHA512 PubKeyALG_ECDSA)- ]+ [ ([1,2,840,113549,1,1,5], SignatureALG HashSHA1 PubKeyALG_RSA)+ , ([1,2,840,113549,1,1,4], SignatureALG HashMD5 PubKeyALG_RSA)+ , ([1,2,840,113549,1,1,2], SignatureALG HashMD2 PubKeyALG_RSA)+ , ([1,2,840,113549,1,1,11], SignatureALG HashSHA256 PubKeyALG_RSA)+ , ([1,2,840,113549,1,1,12], SignatureALG HashSHA384 PubKeyALG_RSA)+ , ([1,2,840,10040,4,3], SignatureALG HashSHA1 PubKeyALG_DSA)+ , ([1,2,840,10045,4,3,1], SignatureALG HashSHA224 PubKeyALG_ECDSA)+ , ([1,2,840,10045,4,3,2], SignatureALG HashSHA256 PubKeyALG_ECDSA)+ , ([1,2,840,10045,4,3,3], SignatureALG HashSHA384 PubKeyALG_ECDSA)+ , ([1,2,840,10045,4,3,4], SignatureALG HashSHA512 PubKeyALG_ECDSA)+ ] 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)- , ([1,2,840,10046,2,1], PubKeyALG_DH)- ]+ [ ([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)+ , ([1,2,840,10046,2,1], PubKeyALG_DH)+ ] oidSig :: OID -> SignatureALG oidSig oid = maybe (SignatureALG_Unknown oid) id $ lookup oid sig_table@@ -179,11 +184,11 @@ 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)+ 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)@@ -203,165 +208,171 @@ encodeAsn1String (T61, x) = T61String x parseCertHeaderDN :: ParseASN1 [(OID, ASN1String)]-parseCertHeaderDN = sortByOID <$> onNextContainer Sequence getDNs where- sortByOID = sortBy (\a b -> fst a `compare` fst b)- getDNs = do- n <- hasNext- if n- then liftM2 (:) parseDNOne getDNs- else return []- parseDNOne = onNextContainer Set $ do- s <- getNextContainer Sequence- case s of- [OID oid, val] -> return (oid, asn1String val)- _ -> throwError "expecting sequence"+parseCertHeaderDN = parseDN +parseDN :: ParseASN1 [(OID, ASN1String)]+parseDN = onNextContainer Sequence getDNs where+ getDNs = do+ n <- hasNext+ if n+ then liftM2 (:) parseOneDN getDNs+ else return []++parseOneDN :: ParseASN1 (OID, ASN1String)+parseOneDN = 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 (convertTime t1, convertTime t2)- _ -> throwError "bad validity format"- where convertTime (y,m,d,h,mi,s,u) =- let day = fromGregorian (fromIntegral y) m d in- let dtime = secondsToDiffTime (fromIntegral h * 3600 + fromIntegral mi * 60 + fromIntegral s) in- (day, dtime, u)+ n <- getNextContainer Sequence+ case n of+ [ UTCTime t1, UTCTime t2 ] -> return (convertTime t1, convertTime t2)+ _ -> throwError "bad validity format"+ where convertTime (y,m,d,h,mi,s,u) =+ let day = fromGregorian (fromIntegral y) m d in+ let dtime = secondsToDiffTime (fromIntegral h * 3600 + fromIntegral mi * 60 + fromIntegral s) in+ (day, dtime, u) parseCertHeaderSubjectPK :: ParseASN1 PubKey parseCertHeaderSubjectPK = onNextContainer Sequence $ do- l <- getNextContainer Sequence- bits <- getNextBitString- case l of- [OID pkalg,Null] -> do- let sig = oidPubKey pkalg- case sig of- PubKeyALG_RSA -> either (throwError) (return . PubKeyRSA) (parse_RSA bits)- _ -> return $ PubKeyUnknown pkalg $ L.unpack bits- [OID pkalg,OID _] -> do- let sig = oidPubKey pkalg- case sig of- PubKeyALG_ECDSA -> parse_ECDSA bits- _ -> return $ PubKeyUnknown pkalg $ L.unpack bits- [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 $ PubKeyDSA $ DSA.PublicKey- { DSA.public_params = (p, q, g), DSA.public_y = dsapub }- _ -> return $ PubKeyUnknown pkalg $ L.unpack bits- n ->- throwError ("subject public key bad format : " ++ show n)+ l <- getNextContainer Sequence+ bits <- getNextBitString+ case l of+ [OID pkalg,Null] -> do+ let sig = oidPubKey pkalg+ case sig of+ PubKeyALG_RSA -> either (throwError) (return . PubKeyRSA) (parse_RSA bits)+ _ -> return $ PubKeyUnknown pkalg $ L.unpack bits+ [OID pkalg,OID _] -> do+ let sig = oidPubKey pkalg+ case sig of+ PubKeyALG_ECDSA -> parse_ECDSA bits+ _ -> return $ PubKeyUnknown pkalg $ L.unpack bits+ [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 $ PubKeyDSA $ DSA.PublicKey+ { DSA.public_params = (p, q, g), DSA.public_y = dsapub }+ _ -> return $ PubKeyUnknown pkalg $ L.unpack bits+ n ->+ throwError ("subject public key bad format : " ++ show n) - where getNextBitString = getNext >>= \bs -> case bs of- BitString bits -> return $ bitArrayGetData bits- _ -> throwError "expecting bitstring"+ where getNextBitString = getNext >>= \bs -> case bs of+ BitString bits -> return $ bitArrayGetData bits+ _ -> throwError "expecting bitstring" parseCertExtensions :: ParseASN1 (Maybe [ExtensionRaw]) parseCertExtensions = onNextContainerMaybe (Container Context 3) (sortByOID . mapMaybe extractExtension <$> onNextContainer Sequence getSequences)- where- sortByOID = sortBy (\(a,_,_) (b,_,_) -> a `compare` b)- getSequences = do- n <- hasNext- if n- then getNextContainer Sequence >>= \sq -> liftM (sq :) getSequences- else return []- extractExtension [OID oid,Boolean True,OctetString obj] = case decodeASN1Stream obj of- Left _ -> Nothing- Right r -> Just (oid, True, r)- extractExtension [OID oid,OctetString obj] = case decodeASN1Stream obj of- Left _ -> Nothing- Right r -> Just (oid, False, r)- extractExtension _ = Nothing+ where+ sortByOID = sortBy (\(a,_,_) (b,_,_) -> a `compare` b)+ getSequences = do+ n <- hasNext+ if n+ then getNextContainer Sequence >>= \sq -> liftM (sq :) getSequences+ else return []+ extractExtension [OID oid,Boolean True,OctetString obj] = case decodeASN1Stream obj of+ Left _ -> Nothing+ Right r -> Just (oid, True, r)+ extractExtension [OID oid,OctetString obj] = case decodeASN1Stream obj of+ Left _ -> Nothing+ Right r -> Just (oid, False, r)+ extractExtension _ = Nothing {- | 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)+ 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- }+ 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 = sortByOID issuer+ , certSubjectDN = sortByOID subject+ , certValidity = validity+ , certPubKey = pk+ , certExtensions = exts+ }+ where sortByOID = sortBy (\a b -> fst a `compare` fst b) + encodeDN :: [ (OID, ASN1String) ] -> [ASN1] encodeDN dn = asn1Container Sequence $ concatMap dnSet dn- where- dnSet (oid, stringy) = asn1Container Set (asn1Container Sequence [OID oid, encodeAsn1String stringy])+ where+ dnSet (oid, stringy) = asn1Container Set (asn1Container Sequence [OID oid, encodeAsn1String stringy]) encodePK :: PubKey -> [ASN1] encodePK k@(PubKeyRSA pubkey) =- asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0])- where- pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k- (Right bits) = encodeASN1Stream $ asn1Container Sequence [IntVal (RSA.public_n pubkey), IntVal (RSA.public_e pubkey)]+ asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0])+ where+ pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k+ (Right bits) = encodeASN1Stream $ asn1Container Sequence [IntVal (RSA.public_n pubkey), IntVal (RSA.public_e pubkey)] encodePK k@(PubKeyDSA pubkey) =- asn1Container Sequence (asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0])- where- pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k- dsaseq = asn1Container Sequence [IntVal p,IntVal q,IntVal g]- (p,q,g) = DSA.public_params pubkey- (Right bits) = encodeASN1Stream [IntVal $ DSA.public_y pubkey]+ asn1Container Sequence (asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0])+ where+ pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k+ dsaseq = asn1Container Sequence [IntVal p,IntVal q,IntVal g]+ (p,q,g) = DSA.public_params pubkey+ (Right bits) = encodeASN1Stream [IntVal $ DSA.public_y pubkey] encodePK k@(PubKeyUnknown _ l) =- asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray (L.pack l) 0])- where- pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k+ asn1Container Sequence (asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray (L.pack l) 0])+ where+ pkalg = OID $ pubkeyalgOID $ pubkeyToAlg k 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- Left _ -> error "cannot encode asn1 extension"- Right bs -> asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString bs])+ where encodeExt (oid, critical, asn1) = case encodeASN1Stream asn1 of+ Left _ -> error "cannot encode asn1 extension"+ Right bs -> asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString bs]) 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 $ unconvertTime t1, UTCTime $ unconvertTime t2]- eSubject = encodeDN $ certSubjectDN cert- epkinfo = encodePK $ certPubKey cert- eexts = encodeExts $ certExtensions 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 $ unconvertTime t1, UTCTime $ unconvertTime t2]+ eSubject = encodeDN $ certSubjectDN cert+ epkinfo = encodePK $ certPubKey cert+ eexts = encodeExts $ certExtensions cert - unconvertTime (day, difftime, z) =- let (y, m, d) = toGregorian day in- let seconds = floor $ toRational difftime in- let h = seconds `div` 3600 in- let mi = (seconds `div` 60) `mod` 60 in- let s = seconds `mod` 60 in- (fromIntegral y,m,d,h,mi,s,z)+ unconvertTime (day, difftime, z) =+ let (y, m, d) = toGregorian day in+ let seconds = floor $ toRational difftime in+ let h = seconds `div` 3600 in+ let mi = (seconds `div` 60) `mod` 60 in+ let s = seconds `mod` 60 in+ (fromIntegral y,m,d,h,mi,s,z)
Data/Certificate/X509/Ext.hs view
@@ -8,18 +8,18 @@ -- extension processing module. -- module Data.Certificate.X509.Ext- ( ExtensionRaw- , Extension(..)- -- * Common extension usually found in x509v3- , ExtBasicConstraints(..)- , ExtKeyUsage(..)- , ExtKeyUsageFlag(..)- , ExtSubjectKeyId(..)- , ExtSubjectAltName(..)- , ExtAuthorityKeyId(..)- -- * Accessor turning extension into a specific one- , extensionGet- ) where+ ( ExtensionRaw+ , Extension(..)+ -- * Common extension usually found in x509v3+ , ExtBasicConstraints(..)+ , ExtKeyUsage(..)+ , ExtKeyUsageFlag(..)+ , 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@@ -32,16 +32,16 @@ -- | key usage flag that is found in the key usage extension field. data ExtKeyUsageFlag =- KeyUsage_digitalSignature -- (0)- | KeyUsage_nonRepudiation -- (1) recent X.509 ver have renamed this bit to contentCommitment- | KeyUsage_keyEncipherment -- (2)- | KeyUsage_dataEncipherment -- (3)- | KeyUsage_keyAgreement -- (4)- | KeyUsage_keyCertSign -- (5)- | KeyUsage_cRLSign -- (6)- | KeyUsage_encipherOnly -- (7)- | KeyUsage_decipherOnly -- (8)- deriving (Show,Eq,Ord,Enum)+ KeyUsage_digitalSignature -- (0)+ | KeyUsage_nonRepudiation -- (1) recent X.509 ver have renamed this bit to contentCommitment+ | KeyUsage_keyEncipherment -- (2)+ | KeyUsage_dataEncipherment -- (3)+ | KeyUsage_keyAgreement -- (4)+ | KeyUsage_keyCertSign -- (5)+ | KeyUsage_cRLSign -- (6)+ | KeyUsage_encipherOnly -- (7)+ | KeyUsage_decipherOnly -- (8)+ deriving (Show,Eq,Ord,Enum) {- -- RFC 5280@@ -52,78 +52,78 @@ -} class Extension a where- extOID :: a -> OID- extEncode :: a -> [ASN1]- extDecode :: [ASN1] -> Either String a+ 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+ Right b+ | oid == extOID b -> Just b+ | otherwise -> extensionGet xs+ Left _ -> extensionGet xs data ExtBasicConstraints = ExtBasicConstraints Bool- deriving (Show,Eq)+ deriving (Show,Eq) 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"+ 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" data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag]- deriving (Show,Eq)+ deriving (Show,Eq) instance Extension ExtKeyUsage where- extOID = const [2,5,29,15]- extEncode (ExtKeyUsage flags) = [BitString $ flagsToBits flags]- extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits- extDecode _ = Left "unknown sequence"+ extOID = const [2,5,29,15]+ extEncode (ExtKeyUsage flags) = [BitString $ flagsToBits flags]+ extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits+ extDecode _ = Left "unknown sequence" data ExtSubjectKeyId = ExtSubjectKeyId L.ByteString- deriving (Show,Eq)+ deriving (Show,Eq) instance Extension ExtSubjectKeyId where- extOID = const [2,5,29,14]- extEncode (ExtSubjectKeyId o) = [OctetString o]- extDecode [OctetString o] = Right $ ExtSubjectKeyId o- extDecode _ = Left "unknown sequence"+ extOID = const [2,5,29,14]+ extEncode (ExtSubjectKeyId o) = [OctetString o]+ extDecode [OctetString o] = Right $ ExtSubjectKeyId o+ extDecode _ = Left "unknown sequence" data ExtSubjectAltName = ExtSubjectAltName [String]- deriving (Show,Eq)+ deriving (Show,Eq) instance Extension ExtSubjectAltName where- extOID = const [2,5,29,17]- extEncode (ExtSubjectAltName names) =- [Start Sequence]- ++ map (Other Context 2 . BC.pack) names- ++ [End Sequence]- 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)+ extOID = const [2,5,29,17]+ extEncode (ExtSubjectAltName names) =+ [Start Sequence]+ ++ map (Other Context 2 . BC.pack) names+ ++ [End Sequence]+ 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)+ deriving (Show,Eq) instance Extension ExtAuthorityKeyId where- extOID _ = [2,5,29,35]- extEncode (ExtAuthorityKeyId keyid) =- [Start Sequence,Other Context 0 keyid,End Sequence]- extDecode [Start Sequence,Other Context 0 keyid,End Sequence] =- Right $ ExtAuthorityKeyId keyid- extDecode _ = Left "unknown sequence"+ extOID _ = [2,5,29,35]+ extEncode (ExtAuthorityKeyId keyid) =+ [Start Sequence,Other Context 0 keyid,End Sequence]+ 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 []+ let isSet = bitArrayGetBit bits i+ if isSet then [toEnum $ fromIntegral i] else [] flagsToBits :: Enum a => [a] -> BitArray flagsToBits flags = foldl bitArraySetBit bitArrayEmpty $ map (fromIntegral . fromEnum) flags- where bitArrayEmpty = BitArray 2 (L.pack [0,0])+ where bitArrayEmpty = BitArray 2 (L.pack [0,0])
Data/Certificate/X509/Internal.hs view
@@ -1,18 +1,18 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.Certificate.X509.Internal- ( ParseASN1- , runParseASN1- , onNextContainer- , onNextContainerMaybe- , getNextContainer- , getNextContainerMaybe- , getNext- , hasNext- , makeASN1Sequence- , asn1Container- , OID- ) where+ ( ParseASN1+ , runParseASN1+ , onNextContainer+ , onNextContainerMaybe+ , getNextContainer+ , getNextContainerMaybe+ , getNext+ , hasNext+ , makeASN1Sequence+ , asn1Container+ , OID+ ) where import Data.ASN1.DER import Data.ASN1.Stream (getConstructedEnd)@@ -22,74 +22,74 @@ type OID = [Integer] newtype ParseASN1 a = P { runP :: ErrorT String (State [ASN1]) a }- deriving (Functor, Monad, MonadError String)+ 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+ 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+ 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"+ 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+ 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+ 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+ 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+ 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+ let (l1, l2) = getConstructedEnd 0 list in+ case l2 of+ [] -> []+ _ -> l1 : makeASN1Sequence l2
certificate.cabal view
@@ -1,5 +1,5 @@ Name: certificate-Version: 1.2.3+Version: 1.2.4 Description: Certificates and Key reader/writer .