diff --git a/Data/X509.hs b/Data/X509.hs new file mode 100644 --- /dev/null +++ b/Data/X509.hs @@ -0,0 +1,118 @@ +-- | +-- Module : Data.X509 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/Data/X509/AlgorithmIdentifier.hs b/Data/X509/AlgorithmIdentifier.hs new file mode 100644 --- /dev/null +++ b/Data/X509/AlgorithmIdentifier.hs @@ -0,0 +1,79 @@ +-- | +-- Module : Data.X509.AlgorithmIdentifier +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/Data/X509/CRL.hs b/Data/X509/CRL.hs new file mode 100644 --- /dev/null +++ b/Data/X509/CRL.hs @@ -0,0 +1,93 @@ +-- | +-- Module : Data.X509.CRL +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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) diff --git a/Data/X509/Cert.hs b/Data/X509/Cert.hs new file mode 100644 --- /dev/null +++ b/Data/X509/Cert.hs @@ -0,0 +1,110 @@ +-- | +-- Module : Data.X509.Cert +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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) [] diff --git a/Data/X509/CertificateChain.hs b/Data/X509/CertificateChain.hs new file mode 100644 --- /dev/null +++ b/Data/X509/CertificateChain.hs @@ -0,0 +1,42 @@ +-- | +-- Module : Data.X509.CertificateChain +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/Data/X509/DistinguishedName.hs b/Data/X509/DistinguishedName.hs new file mode 100644 --- /dev/null +++ b/Data/X509/DistinguishedName.hs @@ -0,0 +1,87 @@ +-- | +-- Module : Data.X509.DistinguishedName +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/Data/X509/Ext.hs b/Data/X509/Ext.hs new file mode 100644 --- /dev/null +++ b/Data/X509/Ext.hs @@ -0,0 +1,222 @@ +-- | +-- Module : Data.X509.Ext +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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]) diff --git a/Data/X509/ExtensionRaw.hs b/Data/X509/ExtensionRaw.hs new file mode 100644 --- /dev/null +++ b/Data/X509/ExtensionRaw.hs @@ -0,0 +1,83 @@ +-- | +-- Module : Data.X509.ExtensionRaw +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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]) diff --git a/Data/X509/Internal.hs b/Data/X509/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/X509/Internal.hs @@ -0,0 +1,19 @@ +-- | +-- Module : Data.X509.Internal +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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] diff --git a/Data/X509/PublicKey.hs b/Data/X509/PublicKey.hs new file mode 100644 --- /dev/null +++ b/Data/X509/PublicKey.hs @@ -0,0 +1,117 @@ +-- | +-- Module : Data.X509.PublicKey +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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] diff --git a/Data/X509/Signed.hs b/Data/X509/Signed.hs new file mode 100644 --- /dev/null +++ b/Data/X509/Signed.hs @@ -0,0 +1,146 @@ +-- | +-- Module : Data.X509.Signed +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 [] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2010-2013 Vincent Hanquez + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Tests/Tests.hs b/Tests/Tests.hs new file mode 100644 --- /dev/null +++ b/Tests/Tests.hs @@ -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) + ] + ] diff --git a/x509.cabal b/x509.cabal new file mode 100644 --- /dev/null +++ b/x509.cabal @@ -0,0 +1,64 @@ +Name: x509 +Version: 1.4.0 +Description: X509 reader and writer +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: Vincent Hanquez +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