diff --git a/Data/Certificate/KeyRSA.hs b/Data/Certificate/KeyRSA.hs --- a/Data/Certificate/KeyRSA.hs +++ b/Data/Certificate/KeyRSA.hs @@ -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) diff --git a/Data/Certificate/X509.hs b/Data/Certificate/X509.hs --- a/Data/Certificate/X509.hs +++ b/Data/Certificate/X509.hs @@ -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 diff --git a/Data/Certificate/X509/Cert.hs b/Data/Certificate/X509/Cert.hs --- a/Data/Certificate/X509/Cert.hs +++ b/Data/Certificate/X509/Cert.hs @@ -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) diff --git a/Data/Certificate/X509/Ext.hs b/Data/Certificate/X509/Ext.hs --- a/Data/Certificate/X509/Ext.hs +++ b/Data/Certificate/X509/Ext.hs @@ -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]) diff --git a/Data/Certificate/X509/Internal.hs b/Data/Certificate/X509/Internal.hs --- a/Data/Certificate/X509/Internal.hs +++ b/Data/Certificate/X509/Internal.hs @@ -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 diff --git a/certificate.cabal b/certificate.cabal --- a/certificate.cabal +++ b/certificate.cabal @@ -1,5 +1,5 @@ Name: certificate -Version: 1.2.3 +Version: 1.2.4 Description: Certificates and Key reader/writer .