x509 (empty) → 1.4.0
raw patch · 15 files changed
+1333/−0 lines, 15 filesdep +HUnitdep +QuickCheckdep +asn1-encodingsetup-changed
Dependencies added: HUnit, QuickCheck, asn1-encoding, asn1-parse, asn1-types, base, bytestring, containers, crypto-pubkey-types, cryptohash, directory, filepath, mtl, pem, process, test-framework, test-framework-hunit, test-framework-quickcheck2, time, x509
Files
- Data/X509.hs +118/−0
- Data/X509/AlgorithmIdentifier.hs +79/−0
- Data/X509/CRL.hs +93/−0
- Data/X509/Cert.hs +110/−0
- Data/X509/CertificateChain.hs +42/−0
- Data/X509/DistinguishedName.hs +87/−0
- Data/X509/Ext.hs +222/−0
- Data/X509/ExtensionRaw.hs +83/−0
- Data/X509/Internal.hs +19/−0
- Data/X509/PublicKey.hs +117/−0
- Data/X509/Signed.hs +146/−0
- LICENSE +27/−0
- Setup.hs +2/−0
- Tests/Tests.hs +124/−0
- x509.cabal +64/−0
+ Data/X509.hs view
@@ -0,0 +1,118 @@+-- |+-- Module : Data.X509+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- Read/Write X509 Certificate, CRL and their signed equivalents.+--+-- Follows RFC5280 / RFC6818+--+module Data.X509+ (+ -- * Types+ SignedCertificate+ , SignedCRL+ , Certificate(..)+ , PubKey(..)+ , pubkeyToAlg+ , module Data.X509.AlgorithmIdentifier+ , module Data.X509.Ext+ , module Data.X509.ExtensionRaw++ -- * Certificate Revocation List (CRL)+ , module Data.X509.CRL++ -- * Naming+ , DistinguishedName(..)+ , DnElement(..)+ , ASN1CharacterString(..)+ , getDnElement++ -- * Certificate Chain+ , module Data.X509.CertificateChain++ -- * Signed types and marshalling+ , Signed(..)+ , SignedExact+ , getSigned+ , getSignedData+ , objectToSignedExact+ , encodeSignedObject+ , decodeSignedObject++ -- * Parametrized Signed accessor+ , getCertificate+ , getCRL+ , decodeSignedCertificate+ , decodeSignedCRL++ -- * Hash distinguished names related function+ , hashDN+ , hashDN_old+ ) where++import Control.Arrow (second)++import Data.ASN1.Types+import Data.ASN1.Encoding+import Data.ASN1.BinaryEncoding+import qualified Data.ByteString as B++import Data.X509.Cert+import Data.X509.Ext+import Data.X509.ExtensionRaw+import Data.X509.CRL+import Data.X509.CertificateChain+import Data.X509.DistinguishedName+import Data.X509.Signed+import Data.X509.PublicKey+import Data.X509.AlgorithmIdentifier++import qualified Crypto.Hash.MD5 as MD5+import qualified Crypto.Hash.SHA1 as SHA1++-- | A Signed Certificate+type SignedCertificate = SignedExact Certificate++-- | A Signed CRL+type SignedCRL = SignedExact CRL++-- | Get the Certificate associated to a SignedCertificate+getCertificate :: SignedCertificate -> Certificate+getCertificate = signedObject . getSigned++-- | Get the CRL associated to a SignedCRL+getCRL :: SignedCRL -> CRL+getCRL = signedObject . getSigned++-- | Try to decode a bytestring to a SignedCertificate+decodeSignedCertificate :: B.ByteString -> Either String SignedCertificate+decodeSignedCertificate = decodeSignedObject++-- | Try to decode a bytestring to a SignedCRL+decodeSignedCRL :: B.ByteString -> Either String SignedCRL+decodeSignedCRL = decodeSignedObject++-- | Make an OpenSSL style hash of distinguished name+--+-- OpenSSL algorithm is odd, and has been replicated here somewhat.+-- only lower the case of ascii character.+hashDN :: DistinguishedName -> B.ByteString+hashDN = shorten . SHA1.hash . encodeASN1' DER . flip toASN1 [] . DistinguishedNameInner . dnLowerUTF8+ where dnLowerUTF8 (DistinguishedName l) = DistinguishedName $ map (second toLowerUTF8) l+ toLowerUTF8 (ASN1CharacterString _ s) = ASN1CharacterString UTF8 (B.map asciiToLower s)+ asciiToLower c+ | c >= w8A && c <= w8Z = fromIntegral (fromIntegral c - fromEnum 'A' + fromEnum 'a')+ | otherwise = c+ w8A = fromIntegral $ fromEnum 'A'+ w8Z = fromIntegral $ fromEnum 'Z'++-- | Create an openssl style old hash of distinguished name+hashDN_old :: DistinguishedName -> B.ByteString+hashDN_old = shorten . MD5.hash . encodeASN1' DER . flip toASN1 []++shorten :: B.ByteString -> B.ByteString+shorten b = B.pack $ map i [3,2,1,0]+ where i n = B.index b n
+ Data/X509/AlgorithmIdentifier.hs view
@@ -0,0 +1,79 @@+-- |+-- Module : Data.X509.AlgorithmIdentifier+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+module Data.X509.AlgorithmIdentifier+ ( HashALG(..)+ , PubKeyALG(..)+ , SignatureALG(..)+ ) where++import Data.ASN1.Types+import Data.List (find)++-- | Hash Algorithm+data HashALG =+ HashMD2+ | HashMD5+ | HashSHA1+ | HashSHA224+ | HashSHA256+ | HashSHA384+ | HashSHA512+ deriving (Show,Eq)++-- | Public Key Algorithm+data PubKeyALG =+ PubKeyALG_RSA -- ^ RSA Public Key algorithm+ | PubKeyALG_DSA -- ^ DSA Public Key algorithm+ | PubKeyALG_ECDSA -- ^ ECDSA Public Key algorithm+ | PubKeyALG_DH -- ^ Diffie Hellman Public Key algorithm+ | PubKeyALG_Unknown OID -- ^ Unknown Public Key algorithm+ deriving (Show,Eq)++-- | Signature Algorithm often composed of+-- a public key algorithm and a hash algorithm+data SignatureALG =+ SignatureALG HashALG PubKeyALG+ | SignatureALG_Unknown OID+ deriving (Show,Eq)++instance OIDable PubKeyALG where+ getObjectID PubKeyALG_RSA = [1,2,840,113549,1,1,1]+ getObjectID PubKeyALG_DSA = [1,2,840,10040,4,1]+ getObjectID PubKeyALG_ECDSA = [1,2,840,10045,2,1]+ getObjectID PubKeyALG_DH = [1,2,840,10046,2,1]+ getObjectID (PubKeyALG_Unknown oid) = oid++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)+ ]++oidSig :: OID -> SignatureALG+oidSig oid = maybe (SignatureALG_Unknown oid) id $ lookup oid sig_table++sigOID :: SignatureALG -> OID+sigOID (SignatureALG_Unknown oid) = oid+sigOID sig = maybe [] fst $ find ((==) sig . snd) sig_table++instance ASN1Object SignatureALG where+ fromASN1 (Start Sequence:OID oid:Null:End Sequence:xs) =+ Right (oidSig oid, xs)+ fromASN1 (Start Sequence:OID oid:End Sequence:xs) =+ Right (oidSig oid, xs)+ fromASN1 _ =+ Left "fromASN1: X509.SignatureALG: unknown format"+ toASN1 signatureAlg = \xs -> Start Sequence:OID (sigOID signatureAlg):Null:End Sequence:xs
+ Data/X509/CRL.hs view
@@ -0,0 +1,93 @@+-- |+-- Module : Data.X509.CRL+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- Read and Write X509 Certificate Revocation List (CRL).+--+-- follows RFC5280 / RFC6818.+--+module Data.X509.CRL+ ( CRL(..)+ , RevokedCertificate(..)+ ) where++import Control.Applicative+import Control.Monad.Error++import Data.Time.Clock (UTCTime)+import Data.ASN1.Types++import Data.X509.DistinguishedName+import Data.X509.AlgorithmIdentifier+import Data.X509.ExtensionRaw+import Data.X509.Internal++-- | Describe a Certificate revocation list+data CRL = CRL+ { crlVersion :: Integer+ , crlSignatureAlg :: SignatureALG+ , crlIssuer :: DistinguishedName+ , crlThisUpdate :: UTCTime+ , crlNextUpdate :: Maybe UTCTime+ , crlRevokedCertificates :: [RevokedCertificate]+ , crlExtensions :: Extensions+ } deriving (Show,Eq)++-- | Describe a revoked certificate identifiable by serial number.+data RevokedCertificate = RevokedCertificate+ { revokedSerialNumber :: Integer+ , revokedDate :: UTCTime+ , revokedExtensions :: Extensions+ } deriving (Show,Eq)++instance ASN1Object CRL where+ toASN1 crl = encodeCRL crl+ fromASN1 = runParseASN1State parseCRL++-- TODO support extension+instance ASN1Object RevokedCertificate where+ fromASN1 (Start Sequence : IntVal serial : ASN1Time _ t _ : End Sequence : xs) =+ Right (RevokedCertificate serial t (Extensions Nothing), xs)+ fromASN1 l = Left ("fromASN1: X509.RevokedCertificate: unknown format:" ++ show l)+ toASN1 (RevokedCertificate serial time _) = \xs ->+ Start Sequence : IntVal serial : ASN1Time TimeGeneralized time Nothing : End Sequence : xs++parseCRL :: ParseASN1 CRL+parseCRL = do+ CRL <$> (getNext >>= getVersion)+ <*> getObject+ <*> getObject+ <*> (getNext >>= getThisUpdate)+ <*> getNextUpdate+ <*> getRevokedCertificates+ <*> getObject+ where getVersion (IntVal v) = return $ fromIntegral v+ getVersion _ = throwError "unexpected type for version"++ getThisUpdate (ASN1Time _ t1 _) = return t1+ getThisUpdate _ = throwError "bad this update format, expecting time"++ getNextUpdate = getNextMaybe timeOrNothing++ timeOrNothing (ASN1Time _ tnext _) = Just tnext+ timeOrNothing _ = Nothing++ getRevokedCertificates = onNextContainer Sequence $ getMany getObject++encodeCRL :: CRL -> ASN1S+encodeCRL crl xs =+ [IntVal $ crlVersion crl] +++ toASN1 (crlSignatureAlg crl) [] +++ toASN1 (crlIssuer crl) [] +++ [ASN1Time TimeGeneralized (crlThisUpdate crl) Nothing] +++ (maybe [] (\t -> [ASN1Time TimeGeneralized t Nothing]) (crlNextUpdate crl)) +++ [Start Sequence] +++ revoked +++ [End Sequence] +++ toASN1 (crlExtensions crl) [] +++ xs+ where+ revoked = concatMap (\e -> toASN1 e []) (crlRevokedCertificates crl)
+ Data/X509/Cert.hs view
@@ -0,0 +1,110 @@+-- |+-- Module : Data.X509.Cert+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- X.509 Certificate types and functions+--+module Data.X509.Cert (Certificate(..)) where++import Data.ASN1.Types+import Data.Time.Clock (UTCTime)+import Control.Applicative ((<$>), (<*>))+import Control.Monad.Error+import Data.X509.Internal+import Data.X509.PublicKey+import Data.X509.AlgorithmIdentifier+import Data.X509.DistinguishedName+import Data.X509.ExtensionRaw++data CertKeyUsage =+ CertKeyUsageDigitalSignature+ | CertKeyUsageNonRepudiation+ | CertKeyUsageKeyEncipherment+ | CertKeyUsageDataEncipherment+ | CertKeyUsageKeyAgreement+ | CertKeyUsageKeyCertSign+ | CertKeyUsageCRLSign+ | CertKeyUsageEncipherOnly+ | CertKeyUsageDecipherOnly+ deriving (Show, Eq)++-- | X.509 Certificate type.+--+-- This type doesn't include the signature, it's describe in the RFC+-- as tbsCertificate.+data Certificate = Certificate+ { certVersion :: Int -- ^ Version+ , certSerial :: Integer -- ^ Serial number+ , certSignatureAlg :: SignatureALG -- ^ Signature algorithm+ , certIssuerDN :: DistinguishedName -- ^ Issuer DN+ , certValidity :: (UTCTime, UTCTime) -- ^ Validity period+ , certSubjectDN :: DistinguishedName -- ^ Subject DN+ , certPubKey :: PubKey -- ^ Public key+ , certExtensions :: Extensions -- ^ Extensions+ } deriving (Show,Eq)++instance ASN1Object Certificate where+ toASN1 certificate = \xs -> encodeCertificateHeader certificate ++ xs+ fromASN1 s = runParseASN1State parseCertificate s++parseCertHeaderVersion :: ParseASN1 Int+parseCertHeaderVersion =+ maybe 1 id <$> onNextContainerMaybe (Container Context 0) (getNext >>= getVer)+ where getVer (IntVal v) = return $ fromIntegral v+ getVer _ = throwError "unexpected type for version"++parseCertHeaderSerial :: ParseASN1 Integer+parseCertHeaderSerial = do+ n <- getNext+ case n of+ IntVal v -> return v+ _ -> throwError ("missing serial" ++ show n)++parseCertHeaderValidity :: ParseASN1 (UTCTime, UTCTime)+parseCertHeaderValidity = getNextContainer Sequence >>= toTimeBound+ where toTimeBound [ ASN1Time _ t1 _, ASN1Time _ t2 _ ] = return (t1,t2)+ toTimeBound _ = throwError "bad validity format"++{- | parse header structure of a x509 certificate. the structure is 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 =+ Certificate <$> parseCertHeaderVersion+ <*> parseCertHeaderSerial+ <*> getObject+ <*> getObject+ <*> parseCertHeaderValidity+ <*> getObject+ <*> getObject+ <*> getObject+ +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 = toASN1 (certSignatureAlg cert) []+ eIssuer = toASN1 (certIssuerDN cert) []+ (t1, t2) = certValidity cert+ eValidity = asn1Container Sequence [ASN1Time TimeGeneralized t1 Nothing+ ,ASN1Time TimeGeneralized t2 Nothing]+ eSubject = toASN1 (certSubjectDN cert) []+ epkinfo = toASN1 (certPubKey cert) []+ eexts = toASN1 (certExtensions cert) []
+ Data/X509/CertificateChain.hs view
@@ -0,0 +1,42 @@+-- |+-- Module : Data.X509.CertificateChain+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+module Data.X509.CertificateChain+ ( CertificateChain(..)+ , CertificateChainRaw(..)+ -- * marshall between CertificateChain and CertificateChainRaw+ , decodeCertificateChain+ , encodeCertificateChain+ ) where++import Data.X509.Cert (Certificate)+import Data.X509.Signed (SignedExact, decodeSignedObject, encodeSignedObject)+import Data.ByteString (ByteString)++-- | A chain of X.509 certificates in exact form.+newtype CertificateChain = CertificateChain [SignedExact Certificate]+ deriving (Eq)++-- | Represent a chain of X.509 certificates in bytestring form.+newtype CertificateChainRaw = CertificateChainRaw [ByteString]+ deriving (Show,Eq)++-- | Decode a CertificateChainRaw into a CertificateChain if every+-- raw certificate are decoded correctly, otherwise return the index of the+-- failed certificate and the error associated.+decodeCertificateChain :: CertificateChainRaw -> Either (Int, String) CertificateChain+decodeCertificateChain (CertificateChainRaw l) =+ either Left (Right . CertificateChain) $ loop 0 l+ where loop _ [] = Right []+ loop i (r:rs) = case decodeSignedObject r of+ Left err -> Left (i, err)+ Right o -> either Left (Right . (o :)) $ loop (i+1) rs++-- | Convert a CertificateChain into a CertificateChainRaw+encodeCertificateChain :: CertificateChain -> CertificateChainRaw+encodeCertificateChain (CertificateChain chain) =+ CertificateChainRaw $ map encodeSignedObject chain
+ Data/X509/DistinguishedName.hs view
@@ -0,0 +1,87 @@+-- |+-- Module : Data.X509.DistinguishedName+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- X.509 Distinguished names types and functions+module Data.X509.DistinguishedName+ ( DistinguishedName(..)+ , DistinguishedNameInner(..)+ , ASN1CharacterString(..)+ -- Distinguished Name Elements+ , DnElement(..)+ , getDnElement+ ) where++import Control.Applicative+import Data.Monoid+import Data.ASN1.Types+import Data.X509.Internal+import Control.Monad.Error++-- | A list of OID and strings.+newtype DistinguishedName = DistinguishedName { getDistinguishedElements :: [(OID, ASN1CharacterString)] }+ deriving (Show,Eq,Ord)++-- | Elements commonly available in a 'DistinguishedName' structure+data DnElement =+ DnCommonName -- ^ CN+ | DnCountry -- ^ Country+ | DnOrganization -- ^ O+ | DnOrganizationUnit -- ^ OU+ deriving (Show,Eq)++instance OIDable DnElement where+ getObjectID DnCommonName = [2,5,4,3]+ getObjectID DnCountry = [2,5,4,6]+ getObjectID DnOrganization = [2,5,4,10]+ getObjectID DnOrganizationUnit = [2,5,4,11]++-- | Try to get a specific element in a 'DistinguishedName' structure+getDnElement :: DnElement -> DistinguishedName -> Maybe ASN1CharacterString+getDnElement element (DistinguishedName els) = lookup (getObjectID element) els++-- | Only use to encode a DistinguishedName without including it in a+-- Sequence+newtype DistinguishedNameInner = DistinguishedNameInner DistinguishedName+ deriving (Show,Eq)++instance Monoid DistinguishedName where+ mempty = DistinguishedName []+ mappend (DistinguishedName l1) (DistinguishedName l2) = DistinguishedName (l1++l2)++instance ASN1Object DistinguishedName where+ toASN1 dn = \xs -> encodeDN dn ++ xs+ fromASN1 = runParseASN1State parseDN++-- FIXME parseDNInner in fromASN1 is probably wrong as we don't have a container+-- and thus hasNext should be replaced by a isFinished clause.+instance ASN1Object DistinguishedNameInner where+ toASN1 (DistinguishedNameInner dn) = \xs -> encodeDNinner dn ++ xs+ fromASN1 = runParseASN1State (DistinguishedNameInner . DistinguishedName <$> parseDNInner)++parseDN :: ParseASN1 DistinguishedName+parseDN = DistinguishedName <$> onNextContainer Sequence parseDNInner++parseDNInner :: ParseASN1 [(OID, ASN1CharacterString)]+parseDNInner = do+ n <- hasNext+ if n+ then liftM2 (:) parseOneDN parseDNInner+ else return []++parseOneDN :: ParseASN1 (OID, ASN1CharacterString)+parseOneDN = onNextContainer Set $ do+ s <- getNextContainer Sequence+ case s of+ [OID oid, ASN1String cs] -> return (oid, cs)+ _ -> throwError "expecting sequence"++encodeDNinner :: DistinguishedName -> [ASN1]+encodeDNinner (DistinguishedName dn) = concatMap dnSet dn+ where dnSet (oid, cs) = asn1Container Set $ asn1Container Sequence [OID oid, ASN1String cs]++encodeDN :: DistinguishedName -> [ASN1]+encodeDN dn = asn1Container Sequence $ encodeDNinner dn
+ Data/X509/Ext.hs view
@@ -0,0 +1,222 @@+-- |+-- Module : Data.X509.Ext+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- extension processing module.+--+module Data.X509.Ext+ ( Extension(..)+ -- * Common extension usually found in x509v3+ , ExtBasicConstraints(..)+ , ExtKeyUsage(..)+ , ExtKeyUsageFlag(..)+ , ExtSubjectKeyId(..)+ , ExtSubjectAltName(..)+ , ExtAuthorityKeyId(..)+ , ExtCrlDistributionPoints(..)+ , AltName(..)+ , DistributionPoint(..)+ , ReasonFlag(..)+ -- * Accessor turning extension into a specific one+ , extensionGet+ , extensionDecode+ ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import Data.ASN1.Types+import Data.ASN1.BitArray+import Data.X509.Internal+import Data.X509.ExtensionRaw+import Data.X509.DistinguishedName+import Control.Applicative+import Control.Monad.Error++-- | 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)++{-+-- RFC 5280+oidDistributionPoints, oidPolicies, oidPoliciesMapping :: OID+oidPolicies = [2,5,29,32]+oidPoliciesMapping = [2,5,29,33]+-}++-- | Extension class.+--+-- each extension have a unique OID associated, and a way+-- to encode and decode an ASN1 stream.+class Extension a where+ extOID :: a -> OID+ extEncode :: a -> [ASN1]+ extDecode :: [ASN1] -> Either String a++-- | Get a specific extension from a lists of raw extensions+extensionGet :: Extension a => Extensions -> Maybe a+extensionGet (Extensions Nothing) = Nothing+extensionGet (Extensions (Just l)) = findExt l+ where findExt [] = Nothing+ findExt (x:xs) = case extensionDecode x of+ Just (Right e) -> Just e+ _ -> findExt xs++-- | Try to decode an ExtensionRaw.+--+-- If this function return:+-- * Nothing, the OID doesn't match+-- * Just Left, the OID matched, but the extension couldn't be decoded+-- * Just Right, the OID matched, and the extension has been succesfully decoded+extensionDecode :: Extension a => ExtensionRaw -> Maybe (Either String a)+extensionDecode = doDecode undefined+ where doDecode :: Extension a => a -> ExtensionRaw -> Maybe (Either String a)+ doDecode dummy (ExtensionRaw oid _ asn1)+ | extOID dummy == oid = Just (extDecode asn1)+ | otherwise = Nothing++-- | Basic Constraints+data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer)+ deriving (Show,Eq)++instance Extension ExtBasicConstraints where+ extOID = const [2,5,29,19]+ extEncode (ExtBasicConstraints b Nothing) = [Start Sequence,Boolean b,End Sequence]+ extEncode (ExtBasicConstraints b (Just i)) = [Start Sequence,Boolean b,IntVal i,End Sequence]++ extDecode [Start Sequence,Boolean b,IntVal v,End Sequence]+ | v >= 0 = Right (ExtBasicConstraints b (Just v))+ | otherwise = Left "invalid pathlen"+ extDecode [Start Sequence,Boolean b,End Sequence] = Right (ExtBasicConstraints b Nothing)+ extDecode [Start Sequence,End Sequence] = Right (ExtBasicConstraints False Nothing)+ extDecode _ = Left "unknown sequence"++-- | Describe key usage+data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag]+ 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"++-- | Provide a way to identify a public key by a short hash.+data ExtSubjectKeyId = ExtSubjectKeyId B.ByteString+ 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"++-- | Different naming scheme use by the extension.+--+-- Not all name types are available, missing:+-- otherName+-- x400Address+-- directoryName+-- ediPartyName+-- registeredID+--+data AltName =+ AltNameRFC822 String+ | AltNameDNS String+ | AltNameURI String+ | AltNameIP B.ByteString+ deriving (Show,Eq,Ord)++-- | Provide a way to supply alternate name that can be+-- used for matching host name.+data ExtSubjectAltName = ExtSubjectAltName [AltName]+ deriving (Show,Eq,Ord)++instance Extension ExtSubjectAltName where+ extOID = const [2,5,29,17]+ extEncode (ExtSubjectAltName names) = encodeGeneralNames names+ extDecode l = runParseASN1 (ExtSubjectAltName <$> parseGeneralNames) l++-- | Provide a mean to identify the public key corresponding to the private key+-- used to signed a certificate.+data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString+ 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"++-- | Identify how CRL information is obtained+data ExtCrlDistributionPoints = ExtCrlDistributionPoints [DistributionPoint]+ deriving (Show,Eq)++-- | Reason flag for the CRL+data ReasonFlag =+ Reason_Unused+ | Reason_KeyCompromise+ | Reason_CACompromise+ | Reason_AffiliationChanged+ | Reason_Superseded+ | Reason_CessationOfOperation+ | Reason_CertificateHold+ | Reason_PrivilegeWithdrawn+ | Reason_AACompromise+ deriving (Show,Eq,Ord,Enum)++-- | Distribution point as either some GeneralNames or a DN+data DistributionPoint =+ DistributionPointFullName [AltName]+ | DistributionNameRelative DistinguishedName+ deriving (Show,Eq)++instance Extension ExtCrlDistributionPoints where+ extOID _ = [2,5,29,31]+ extEncode = undefined+ extDecode = undefined+ --extEncode (ExtCrlDistributionPoints )++parseGeneralNames :: ParseASN1 [AltName]+parseGeneralNames = do+ c <- getNextContainer Sequence+ r <- sequence $ map toStringy c+ return r+ where+ toStringy (Other Context 1 b) = return $ AltNameRFC822 $ BC.unpack b+ toStringy (Other Context 2 b) = return $ AltNameDNS $ BC.unpack b+ toStringy (Other Context 6 b) = return $ AltNameURI $ BC.unpack b+ toStringy (Other Context 7 b) = return $ AltNameIP b+ toStringy b = throwError ("GeneralNames: not coping with anything else " ++ show b)++encodeGeneralNames :: [AltName] -> [ASN1]+encodeGeneralNames names =+ [Start Sequence]+ ++ map encodeAltName names+ ++ [End Sequence]+ where encodeAltName (AltNameRFC822 n) = Other Context 1 $ BC.pack n+ encodeAltName (AltNameDNS n) = Other Context 2 $ BC.pack n+ encodeAltName (AltNameURI n) = Other Context 6 $ BC.pack n+ encodeAltName (AltNameIP n) = Other Context 7 $ n++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 []++flagsToBits :: Enum a => [a] -> BitArray+flagsToBits flags = foldl bitArraySetBit bitArrayEmpty $ map (fromIntegral . fromEnum) flags+ where bitArrayEmpty = BitArray 2 (B.pack [0,0])
+ Data/X509/ExtensionRaw.hs view
@@ -0,0 +1,83 @@+-- |+-- Module : Data.X509.ExtensionRaw+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- extension marshalling+--+module Data.X509.ExtensionRaw+ ( ExtensionRaw(..)+ , Extensions(..)+ ) where++import Control.Applicative+import Data.ASN1.Types+import Data.ASN1.Encoding+import Data.ASN1.BinaryEncoding+import Data.X509.Internal++-- | An undecoded extension+data ExtensionRaw = ExtensionRaw+ { extRawOID :: OID -- ^ OID of this extension+ , extRawCritical :: Bool -- ^ if this extension is critical+ , extRawASN1 :: [ASN1] -- ^ the associated ASN1+ } deriving (Show,Eq)++-- | a Set of 'ExtensionRaw'+newtype Extensions = Extensions (Maybe [ExtensionRaw])+ deriving (Show,Eq)++instance ASN1Object Extensions where+ toASN1 exts = \xs -> encodeExts exts ++ xs+ fromASN1 = runParseASN1State parseExtensions++instance ASN1Object ExtensionRaw where+ toASN1 extraw = \xs -> encodeExt extraw ++ xs+ fromASN1 (Start Sequence:OID oid:xs) =+ case xs of+ Boolean b:OctetString obj:End Sequence:xs2 -> extractExt b obj xs2+ OctetString obj:End Sequence:xs2 -> extractExt False obj xs2+ _ -> Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show xs)+ where+ extractExt critical bs remainingStream =+ case decodeASN1' BER bs of+ Left err -> Left ("fromASN1: X509.ExtensionRaw: OID=" ++ show oid +++ ": cannot decode data: " ++ show err)+ Right r -> Right (ExtensionRaw oid critical r, remainingStream)+ fromASN1 l =+ Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show l)+++parseExtensions :: ParseASN1 Extensions+parseExtensions = Extensions <$> (+ onNextContainerMaybe (Container Context 3) $+ onNextContainer Sequence (getMany getObject)+ )+{-+ where getSequences = do+ n <- hasNext+ if n+ then getNextContainer Sequence >>= \sq -> liftM (sq :) getSequences+ else return []+ extractExtension [OID oid,Boolean b,OctetString obj] =+ case decodeASN1' BER obj of+ Left _ -> Nothing+ Right r -> Just (oid, b, r)+ extractExtension [OID oid,OctetString obj] =+ case decodeASN1' BER obj of+ Left _ -> Nothing+ Right r -> Just (oid, False, r)+ extractExtension _ =+ Nothing+-}++encodeExts :: Extensions -> [ASN1]+encodeExts (Extensions Nothing) = []+encodeExts (Extensions (Just l)) = asn1Container (Container Context 3) $ concatMap encodeExt l++encodeExt :: ExtensionRaw -> [ASN1]+encodeExt (ExtensionRaw oid critical asn1) =+ let bs = encodeASN1' DER asn1+ in asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString bs])
+ Data/X509/Internal.hs view
@@ -0,0 +1,19 @@+-- |+-- Module : Data.X509.Internal+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+module Data.X509.Internal+ ( module Data.ASN1.Parse+ , asn1Container+ , OID+ ) where++import Data.ASN1.Types+import Data.ASN1.Parse++-- | create a container around the stream of ASN1+asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1]+asn1Container ty l = [Start ty] ++ l ++ [End ty]
+ Data/X509/PublicKey.hs view
@@ -0,0 +1,117 @@+-- |+-- Module : Data.X509.PublicKey+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- Public key handling in X.509 infrastructure+--+module Data.X509.PublicKey+ ( PubKey(..)+ , pubkeyToAlg+ ) where++import Data.ASN1.Types+import Data.ASN1.Encoding+import Data.ASN1.BinaryEncoding+import Data.ASN1.BitArray++import Data.X509.Internal+import Data.X509.AlgorithmIdentifier++import qualified Crypto.Types.PubKey.RSA as RSA+import qualified Crypto.Types.PubKey.DSA as DSA+import Data.Word++import qualified Data.ByteString as B++-- FIXME this doesn't identify ECDSA_Hash_SHA384, but the curve name secp384r1+-- with implicit SHA384 hashing.+data ECDSA_Hash = ECDSA_Hash_SHA384+ deriving (Show,Eq)++-- | Public key types known and used in X.509+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 ECDSA_Hash B.ByteString+ | PubKeyUnknown OID B.ByteString -- ^ unrecognized format+ deriving (Show,Eq)++-- Public key are in the format:+--+-- Start Sequence+-- OID (Public key algorithm)+-- [public key specific format]+-- BitString+-- End Sequence+instance ASN1Object PubKey where+ fromASN1 (Start Sequence:Start Sequence:OID pkalg:xs)+ | pkalg == getObjectID PubKeyALG_RSA =+ case xs of+ Null:End Sequence:BitString bits:End Sequence:xs2 -> decodeASN1Err "RSA" bits xs2 (toPubKeyRSA . fromASN1)+ _ -> Left "fromASN1: X509.PubKey: unknown RSA format"+ | pkalg == getObjectID PubKeyALG_DSA =+ case xs of+ Start Sequence:IntVal p:IntVal q:IntVal g:End Sequence:End Sequence:BitString bits:End Sequence:xs2 ->+ decodeASN1Err "DSA" bits xs2 (\l -> case l of+ [IntVal dsapub] ->+ let pubkey = DSA.PublicKey { DSA.public_params = DSA.Params { DSA.params_p = p+ , DSA.params_q = q+ , DSA.params_g = g+ }+ , DSA.public_y = dsapub }+ in Right (PubKeyDSA pubkey, xs2)+ _ -> Left "fromASN1: X509.PubKey: unknown DSA format"+ )+ _ -> Left "fromASN1: X509.PubKey: unknown DSA format"+ | pkalg == getObjectID PubKeyALG_ECDSA =+ case xs of+ OID [1,3,132,0,34]:End Sequence:BitString bits:End Sequence:xs2 -> Right (PubKeyECDSA ECDSA_Hash_SHA384 (bitArrayGetData bits), xs2) -- secp384r1+ _ -> Left "fromASN1: X509.PubKey: unknown ECDSA format"+ | otherwise = undefined+ where decodeASN1Err format bits xs2 f =+ case decodeASN1' BER (bitArrayGetData bits) of+ Left err -> Left ("fromASN1: X509.PubKey " ++ format ++ " bitarray cannot be parsed: " ++ show err)+ Right s -> case f s of+ Left err -> Left err+ Right (r, xsinner) -> Right (r, xsinner ++ xs2)+ toPubKeyRSA = either Left (\(rsaKey, r) -> Right (PubKeyRSA rsaKey, r))+ + fromASN1 l = Left ("fromASN1: X509.PubKey: unknown format:" ++ show l)+ toASN1 a = \xs -> encodePK a ++ xs++-- | Convert a Public key to the Public Key Algorithm type+pubkeyToAlg :: PubKey -> PubKeyALG+pubkeyToAlg (PubKeyRSA _) = PubKeyALG_RSA+pubkeyToAlg (PubKeyDSA _) = PubKeyALG_DSA+pubkeyToAlg (PubKeyDH _) = PubKeyALG_DH+pubkeyToAlg (PubKeyECDSA _ _) = PubKeyALG_ECDSA+pubkeyToAlg (PubKeyUnknown oid _) = PubKeyALG_Unknown oid++encodePK :: PubKey -> [ASN1]+encodePK key = asn1Container Sequence (encodeInner key)+ where+ pkalg = OID $ getObjectID $ pubkeyToAlg key+ encodeInner (PubKeyRSA pubkey) =+ asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0]+ where bits = encodeASN1' DER $ asn1Container Sequence [IntVal (RSA.public_n pubkey), IntVal (RSA.public_e pubkey)]+ encodeInner (PubKeyDSA pubkey) =+ asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0]+ where+ dsaseq = asn1Container Sequence [IntVal (DSA.params_p params)+ ,IntVal (DSA.params_q params)+ ,IntVal (DSA.params_g params)]+ params = DSA.public_params pubkey+ bits = encodeASN1' DER [IntVal $ DSA.public_y pubkey]+ encodeInner (PubKeyECDSA ehash bits) =+ asn1Container Sequence [pkalg,OID eOid] ++ [BitString $ toBitArray bits 0]+ where+ eOid = case ehash of+ ECDSA_Hash_SHA384 -> [1,3,132,0,34]+ encodeInner (PubKeyDH _) = undefined+ encodeInner (PubKeyUnknown _ l) =+ asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray l 0]
+ Data/X509/Signed.hs view
@@ -0,0 +1,146 @@+-- |+-- Module : Data.X509.Signed+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+--+-- Exposes helpers for X509 certificate and revocation list, signed structures.+--+-- Signed structures are of the form:+-- Sequence {+-- object a+-- signatureAlgorithm AlgorithmIdentifier+-- signatureValue BitString+-- }+--+-- Unfortunately as lots of signed objects published have been signed on an+-- arbitrary BER ASN1 encoding (instead of using the unique DER encoding) or in+-- a non-valid DER implementation, we need to keep the raw data being signed,+-- as we can't recompute the bytestring used to sign for non compliant cases.+--+-- Signed represent the pure data type for compliant cases, and SignedExact+-- the real world situation of having to deal with compliant and non-compliant cases.+--+module Data.X509.Signed+ (+ -- * Types+ Signed(..)+ , SignedExact+ -- * SignedExact to Signed+ , getSigned+ , getSignedData+ -- * Marshalling function+ , encodeSignedObject+ , decodeSignedObject+ -- * Object to Signed and SignedExact+ , objectToSignedExact+ , objectToSigned+ , signedToExact+ ) where++import Control.Arrow (first)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.X509.AlgorithmIdentifier+import Data.ASN1.Types+import Data.ASN1.Encoding+import Data.ASN1.BinaryEncoding+import Data.ASN1.Stream+import Data.ASN1.BitArray+import qualified Data.ASN1.BinaryEncoding.Raw as Raw (toByteString)++-- | Represent a signed object using a traditional X509 structure.+--+-- When dealing with external certificate, use the SignedExact structure+-- not this one.+data (Eq a, ASN1Object a) => Signed a = Signed+ { signedObject :: a -- ^ Object to sign+ , signedAlg :: SignatureALG -- ^ Signature Algorithm used+ , signedSignature :: B.ByteString -- ^ Signature as bytes+ } deriving (Eq)++-- | Represent the signed object plus the raw data that we need to+-- keep around for non compliant case to be able to verify signature.+data (Eq a, ASN1Object a) => SignedExact a = SignedExact+ { getSigned :: Signed a -- ^ get the decoded Signed data+ , exactObjectRaw :: B.ByteString -- ^ The raw representation of the object a+ -- TODO: in later version, replace with offset in exactRaw+ , encodeSignedObject :: B.ByteString -- ^ The raw representation of the whole signed structure+ } deriving (Eq)++-- | Get the signed data for the signature+getSignedData :: (Eq a, ASN1Object a) => SignedExact a -> B.ByteString+getSignedData = exactObjectRaw++-- | make a 'SignedExact' copy of a 'Signed' object+--+-- As the signature is already generated, expect the+-- encoded object to have been made on a compliant DER ASN1 implementation.+--+-- It's better to use 'objectToSignedExact' instead of this.+signedToExact :: (Eq a, ASN1Object a) => Signed a -> SignedExact a+signedToExact signed = sExact+ where (sExact, ()) = objectToSignedExact fakeSigFunction (signedObject signed)+ fakeSigFunction _ = (signedSignature signed, signedAlg signed, ())++-- | Transform an object into a 'SignedExact' object+objectToSignedExact :: (Eq a, ASN1Object a)+ => (ByteString -> (ByteString, SignatureALG, r)) -- ^ signature function+ -> a -- ^ object to sign+ -> (SignedExact a, r)+objectToSignedExact signatureFunction object = (SignedExact signed objRaw signedRaw, r)+ where signed = Signed { signedObject = object+ , signedAlg = sigAlg+ , signedSignature = sigBits+ }+ signedRaw = encodeASN1' DER signedASN1+ signedASN1 = Start Sequence+ : objASN1+ (toASN1 sigAlg+ (BitString (toBitArray sigBits 0)+ : End Sequence+ : []))+ objASN1 = \xs -> Start Sequence : toASN1 object (End Sequence : xs)+ objRaw = encodeASN1' DER (objASN1 [])+ (sigBits,sigAlg,r) = signatureFunction objRaw++-- | Transform an object into a 'Signed' object.+--+-- It's recommended to use the SignedExact object instead of Signed.+objectToSigned :: (Eq a, ASN1Object a) => (ByteString -> (ByteString, SignatureALG, r)) -> a -> (Signed a, r)+objectToSigned signatureFunction object = first getSigned $ objectToSignedExact signatureFunction object++-- | Try to parse a bytestring that use the typical X509 signed structure format+decodeSignedObject :: (Eq a, ASN1Object a) => ByteString -> Either String (SignedExact a)+decodeSignedObject b = either (Left . show) parseSigned $ decodeASN1Repr' BER b+ where -- the following implementation is very inefficient.+ -- uses reverse and containing, move to a better solution eventually+ parseSigned l = onContainer (fst $ getConstructedEndRepr l) $ \l2 ->+ let (objRepr,rem1) = getConstructedEndRepr l2+ (sigAlgSeq,rem2) = getConstructedEndRepr rem1+ (sigSeq,_) = getConstructedEndRepr rem2+ obj = onContainer objRepr (either Left (Right . fst) . fromASN1 . map fst)+ in case (obj, map fst sigSeq) of+ (Right o, [BitString signature]) ->+ let rawObj = Raw.toByteString $ concatMap snd objRepr+ in case fromASN1 $ map fst sigAlgSeq of+ Left s -> Left ("signed object error sigalg: " ++ s)+ Right (sigAlg,_) ->+ let signed = Signed+ { signedObject = o+ , signedAlg = sigAlg+ , signedSignature = bitArrayGetData signature+ }+ in Right $ SignedExact+ { getSigned = signed+ , exactObjectRaw = rawObj+ , encodeSignedObject = b+ }+ (Left err, _) -> Left $ ("signed object error: " ++ show err)+ _ -> Left $ "signed object structure error"+ onContainer ((Start _, _) : l) f =+ case reverse l of+ ((End _, _) : l2) -> f $ reverse l2+ _ -> f []+ onContainer _ f = f []
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2010-2013 Vincent Hanquez <vincent@snarc.org>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Tests/Tests.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Test.QuickCheck++import qualified Data.ByteString as B++import Control.Applicative+import Control.Monad++import Data.ASN1.Types+import Data.X509+import qualified Crypto.Types.PubKey.RSA as RSA+import qualified Crypto.Types.PubKey.DSA as DSA++import Data.Time.Clock+import Data.Time.Clock.POSIX++instance Arbitrary RSA.PublicKey where+ arbitrary = do+ bytes <- elements [64,128,256]+ e <- elements [0x3,0x10001]+ n <- choose (2^(8*(bytes-1)),2^(8*bytes))+ return $ RSA.PublicKey { RSA.public_size = bytes+ , RSA.public_n = n+ , RSA.public_e = e+ }++instance Arbitrary DSA.Params where+ arbitrary = DSA.Params <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary DSA.PublicKey where+ arbitrary = DSA.PublicKey <$> arbitrary <*> arbitrary++instance Arbitrary PubKey where+ arbitrary = oneof+ [ PubKeyRSA <$> arbitrary+ , PubKeyDSA <$> arbitrary+ --, PubKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary)+ ]++instance Arbitrary HashALG where+ arbitrary = elements [HashMD2,HashMD5,HashSHA1,HashSHA224,HashSHA256,HashSHA384,HashSHA512]++instance Arbitrary PubKeyALG where+ arbitrary = elements [PubKeyALG_RSA,PubKeyALG_DSA,PubKeyALG_ECDSA,PubKeyALG_DH]++instance Arbitrary SignatureALG where+ -- unfortunately as the encoding of this is a single OID as opposed to two OID,+ -- the testing need to limit itself to Signature ALG that has been defined in the OID database. + -- arbitrary = SignatureALG <$> arbitrary <*> arbitrary+ arbitrary = elements+ [ SignatureALG HashSHA1 PubKeyALG_RSA+ , SignatureALG HashMD5 PubKeyALG_RSA+ , SignatureALG HashMD2 PubKeyALG_RSA+ , SignatureALG HashSHA256 PubKeyALG_RSA+ , SignatureALG HashSHA384 PubKeyALG_RSA+ , SignatureALG HashSHA1 PubKeyALG_DSA+ , SignatureALG HashSHA224 PubKeyALG_ECDSA+ , SignatureALG HashSHA256 PubKeyALG_ECDSA+ , SignatureALG HashSHA384 PubKeyALG_ECDSA+ , SignatureALG HashSHA512 PubKeyALG_ECDSA+ ]++arbitraryBS r1 r2 = choose (r1,r2) >>= \l -> (B.pack <$> replicateM l arbitrary)++instance Arbitrary ASN1StringEncoding where+ arbitrary = elements [IA5,UTF8]++instance Arbitrary ASN1CharacterString where+ arbitrary = ASN1CharacterString <$> arbitrary <*> arbitraryBS 2 36++instance Arbitrary DistinguishedName where+ arbitrary = DistinguishedName <$> (choose (1,5) >>= \l -> replicateM l arbitraryDE)+ where arbitraryDE = (,) <$> arbitrary <*> arbitrary++instance Arbitrary UTCTime where+ arbitrary = posixSecondsToUTCTime . fromIntegral <$> (arbitrary :: Gen Int)++instance Arbitrary Extensions where+ arbitrary = pure (Extensions Nothing)++instance Arbitrary Certificate where+ arbitrary = Certificate <$> pure 2+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary RevokedCertificate where+ arbitrary = RevokedCertificate <$> arbitrary+ <*> arbitrary+ <*> pure (Extensions Nothing)++instance Arbitrary CRL where+ arbitrary = CRL <$> pure 1+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++assertEq a b+ | a == b = True+ | otherwise = error (show b ++ " got: " ++ show a)++property_unmarshall_marshall_id :: (Show o, Arbitrary o, ASN1Object o, Eq o) => o -> Bool+property_unmarshall_marshall_id o = (fromASN1 (toASN1 o []) `assertEq` Right (o, []))++main = defaultMain+ [ testGroup "asn1 objects unmarshall.marshall=id"+ [ testProperty "pubkey" (property_unmarshall_marshall_id :: PubKey -> Bool)+ , testProperty "signature alg" (property_unmarshall_marshall_id :: SignatureALG -> Bool)+ , testProperty "certificate" (property_unmarshall_marshall_id :: Certificate -> Bool)+ , testProperty "crl" (property_unmarshall_marshall_id :: CRL -> Bool)+ ]+ ]
+ x509.cabal view
@@ -0,0 +1,64 @@+Name: x509+Version: 1.4.0+Description: X509 reader and writer+License: BSD3+License-file: LICENSE+Copyright: Vincent Hanquez <vincent@snarc.org>+Author: Vincent Hanquez <vincent@snarc.org>+Maintainer: Vincent Hanquez <vincent@snarc.org>+Synopsis: X509 reader and writer+Build-Type: Simple+Category: Data+stability: experimental+Homepage: http://github.com/vincenthz/hs-certificate+Cabal-Version: >=1.8++Library+ Build-Depends: base >= 3 && < 5+ , bytestring+ , mtl+ , pem >= 0.1 && < 0.2+ , asn1-types >= 0.2.0 && < 0.3.0+ , asn1-encoding >= 0.8.0 && < 0.9.0+ , asn1-parse >= 0.8.0 && < 0.9.0+ , crypto-pubkey-types >= 0.3 && < 0.4+ , cryptohash+ , containers+ , directory+ , filepath+ , process+ , time+ Exposed-modules: Data.X509+ Other-modules: Data.X509.Internal+ Data.X509.CertificateChain+ Data.X509.AlgorithmIdentifier+ Data.X509.DistinguishedName+ Data.X509.Cert+ Data.X509.PublicKey+ Data.X509.Ext+ Data.X509.ExtensionRaw+ Data.X509.CRL+ Data.X509.Signed+ ghc-options: -Wall++Test-Suite test-x509+ type: exitcode-stdio-1.0+ hs-source-dirs: Tests+ Main-is: Tests.hs+ Build-Depends: base >= 3 && < 5+ , bytestring+ , mtl+ , QuickCheck >= 2+ , HUnit+ , test-framework+ , test-framework-quickcheck2+ , test-framework-hunit+ , asn1-types+ , x509+ , time+ , crypto-pubkey-types+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures++source-repository head+ type: git+ location: git://github.com/vincenthz/hs-certificate