x509-1.6.4/Data/0000755000000000000000000000000012600024022011252 5ustar0000000000000000x509-1.6.4/Data/X509/0000755000000000000000000000000012766600577011753 5ustar0000000000000000x509-1.6.4/Tests/0000755000000000000000000000000012600066575011526 5ustar0000000000000000x509-1.6.4/Data/X509.hs0000644000000000000000000000665212600024022012264 0ustar0000000000000000-- | -- 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(..) , PubKeyEC(..) , SerializedPoint(..) , PrivKey(..) , pubkeyToAlg , privkeyToAlg , 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 qualified Data.ByteArray as BA 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.PrivateKey import Data.X509.AlgorithmIdentifier import Crypto.Hash -- | 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 . hashWith SHA1 . 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 . hashWith MD5 . encodeASN1' DER . flip toASN1 [] shorten :: Digest a -> B.ByteString shorten b = B.pack $ map i [3,2,1,0] where i n = BA.index b n x509-1.6.4/Data/X509/Internal.hs0000644000000000000000000000145412600002756014045 0ustar0000000000000000-- | -- Module : Data.X509.Internal -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- {-# LANGUAGE CPP #-} module Data.X509.Internal ( module Data.ASN1.Parse , asn1Container , OID -- * error handling , ErrT , runErrT ) where import Data.ASN1.Types import Data.ASN1.Parse #if MIN_VERSION_mtl(2,2,1) import Control.Monad.Except runErrT :: ExceptT e m a -> m (Either e a) runErrT = runExceptT type ErrT = ExceptT #else import Control.Monad.Error runErrT :: ErrorT e m a -> m (Either e a) runErrT = runErrorT type ErrT = ErrorT #endif -- | create a container around the stream of ASN1 asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1] asn1Container ty l = [Start ty] ++ l ++ [End ty] x509-1.6.4/Data/X509/CertificateChain.hs0000644000000000000000000000323512415407106015457 0ustar0000000000000000-- | -- 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 (Show,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 x509-1.6.4/Data/X509/AlgorithmIdentifier.hs0000644000000000000000000000577712600061206016231 0ustar0000000000000000-- | -- 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_EC -- ^ ECDSA & ECDH 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_EC = [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,113549,1,1,13], SignatureALG HashSHA512 PubKeyALG_RSA) , ([1,2,840,113549,1,1,14], SignatureALG HashSHA224 PubKeyALG_RSA) , ([1,2,840,10040,4,3], SignatureALG HashSHA1 PubKeyALG_DSA) , ([1,2,840,10045,4,1], SignatureALG HashSHA1 PubKeyALG_EC) , ([1,2,840,10045,4,3,1], SignatureALG HashSHA224 PubKeyALG_EC) , ([1,2,840,10045,4,3,2], SignatureALG HashSHA256 PubKeyALG_EC) , ([1,2,840,10045,4,3,3], SignatureALG HashSHA384 PubKeyALG_EC) , ([1,2,840,10045,4,3,4], SignatureALG HashSHA512 PubKeyALG_EC) ] 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 (error ("unknown OID for " ++ show sig)) 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 x509-1.6.4/Data/X509/DistinguishedName.hs0000644000000000000000000000612712600002561015671 0ustar0000000000000000-- | -- 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 -- | 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 | DnEmailAddress -- ^ Email Address (legacy) 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] getObjectID DnEmailAddress = [1,2,840,113549,1,9,1] -- | 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 = concat `fmap` getMany parseOneDN parseOneDN :: ParseASN1 [(OID, ASN1CharacterString)] parseOneDN = onNextContainer Set $ getMany $ do s <- getNextContainer Sequence case s of [OID oid, ASN1String cs] -> return (oid, cs) _ -> throwParseError ("expecting [OID,String] got " ++ show s) 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 x509-1.6.4/Data/X509/Cert.hs0000644000000000000000000001044012600002552013153 0ustar0000000000000000-- | -- Module : Data.X509.Cert -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Certificate types and functions -- {-# LANGUAGE FlexibleContexts #-} module Data.X509.Cert (Certificate(..)) where import Data.ASN1.Types import Control.Applicative ((<$>), (<*>)) import Data.X509.Internal import Data.X509.PublicKey import Data.X509.AlgorithmIdentifier import Data.X509.DistinguishedName import Data.X509.ExtensionRaw import Data.Hourglass 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 :: (DateTime, DateTime) -- ^ Validity period (UTC) , 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 _ = throwParseError "unexpected type for version" parseCertHeaderSerial :: ParseASN1 Integer parseCertHeaderSerial = do n <- getNext case n of IntVal v -> return v _ -> throwParseError ("missing serial" ++ show n) parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime) parseCertHeaderValidity = getNextContainer Sequence >>= toTimeBound where toTimeBound [ ASN1Time _ t1 _, ASN1Time _ t2 _ ] = return (t1,t2) toTimeBound _ = throwParseError "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 (timeType t1) t1 (Just (TimezoneOffset 0)) ,ASN1Time (timeType t2) t2 (Just (TimezoneOffset 0))] eSubject = toASN1 (certSubjectDN cert) [] epkinfo = toASN1 (certPubKey cert) [] eexts = toASN1 (certExtensions cert) [] timeType t = if t >= timeConvert (Date 2050 January 1) then TimeGeneralized else TimeUTC x509-1.6.4/Data/X509/PublicKey.hs0000644000000000000000000002400212766600577014174 0ustar0000000000000000-- | -- 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(..) , PubKeyEC(..) , SerializedPoint(..) , pubkeyToAlg ) where import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding import Data.ASN1.BitArray import Data.Bits import Data.ByteString (ByteString) import Data.X509.Internal import Data.X509.OID import Data.X509.AlgorithmIdentifier import qualified Crypto.PubKey.RSA.Types as RSA import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.Types as ECC import Crypto.Number.Serialize (os2ip) import Data.Word import qualified Data.ByteString as B -- | Serialized Elliptic Curve Point newtype SerializedPoint = SerializedPoint ByteString deriving (Show,Eq) -- | Elliptic Curve Public Key -- -- TODO: missing support for binary curve. data PubKeyEC = PubKeyEC_Prime { pubkeyEC_pub :: SerializedPoint , pubkeyEC_a :: Integer , pubkeyEC_b :: Integer , pubkeyEC_prime :: Integer , pubkeyEC_generator :: SerializedPoint , pubkeyEC_order :: Integer , pubkeyEC_cofactor :: Integer , pubkeyEC_seed :: Integer } | PubKeyEC_Named { pubkeyEC_name :: ECC.CurveName , pubkeyEC_pub :: SerializedPoint } 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)) | PubKeyEC PubKeyEC -- ^ EC public key | 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 removeNull xs of End Sequence:BitString bits:End Sequence:xs2 -> decodeASN1Err "RSA" bits xs2 (toPubKeyRSA . rsaPubFromASN1) _ -> Left ("fromASN1: X509.PubKey: unknown RSA format: " ++ show xs) | 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, []) _ -> Left "fromASN1: X509.PubKey: unknown DSA format" ) _ -> Left "fromASN1: X509.PubKey: unknown DSA format" | pkalg == getObjectID PubKeyALG_EC = case xs of OID curveOid:End Sequence:BitString bits:End Sequence:xs2 -> case lookupByOID curvesOIDTable curveOid of Just curveName -> Right (PubKeyEC $ PubKeyEC_Named curveName (bitArrayToPoint bits), xs2) Nothing -> Left ("fromASN1: X509.Pubkey: EC unknown curve " ++ show curveOid) Start Sequence :IntVal 1 :Start Sequence :OID [1,2,840,10045,1,1] :IntVal prime :End Sequence :Start Sequence :OctetString a :OctetString b :BitString seed :End Sequence :OctetString generator :IntVal order :IntVal cofactor :End Sequence :End Sequence :BitString pub :End Sequence :xs2 -> Right (PubKeyEC $ PubKeyEC_Prime { pubkeyEC_pub = bitArrayToPoint pub , pubkeyEC_a = os2ip a , pubkeyEC_b = os2ip b , pubkeyEC_prime = prime , pubkeyEC_generator = SerializedPoint generator , pubkeyEC_order = order , pubkeyEC_cofactor = cofactor , pubkeyEC_seed = os2ip $ bitArrayGetData seed }, xs2) _ -> Left $ "fromASN1: X509.PubKey: unknown EC format: " ++ show xs | otherwise = Left $ "fromASN1: unknown public key OID: " ++ show pkalg 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)) bitArrayToPoint = SerializedPoint . bitArrayGetData removeNull (Null:r) = r removeNull l = l 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 (PubKeyEC _) = PubKeyALG_EC 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 $ rsaPubToASN1 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 (PubKeyEC (PubKeyEC_Named curveName (SerializedPoint bits))) = asn1Container Sequence [pkalg,OID eOid] ++ [BitString $ toBitArray bits 0] where eOid = case curveName of ECC.SEC_p384r1 -> [1,3,132,0,34] _ -> error ("undefined curve OID: " ++ show curveName) encodeInner (PubKeyEC (PubKeyEC_Prime {})) = error "encodeInner: unimplemented public key EC_Prime" encodeInner (PubKeyDH _) = error "encodeInner: unimplemented public key DH" encodeInner (PubKeyUnknown _ l) = asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray l 0] rsaPubToASN1 :: RSA.PublicKey -> [ASN1] -> [ASN1] rsaPubToASN1 pubkey xs = Start Sequence : IntVal (RSA.public_n pubkey) : IntVal (RSA.public_e pubkey) : End Sequence : xs rsaPubFromASN1 :: [ASN1] -> Either String (RSA.PublicKey, [ASN1]) rsaPubFromASN1 (Start Sequence:IntVal smodulus:IntVal pubexp:End Sequence:xs) = Right (pub, xs) where pub = RSA.PublicKey { RSA.public_size = calculate_modulus modulus 1 , RSA.public_n = modulus , RSA.public_e = pubexp } calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1) -- some bad implementation will not serialize ASN.1 integer properly, leading -- to negative modulus. if that's the case, we correct it. modulus = toPositive smodulus rsaPubFromASN1 ( Start Sequence : IntVal ver : Start Sequence : OID oid : Null : End Sequence : OctetString bs : xs ) | ver /= 0 = Left "rsaPubFromASN1: Invalid version, expecting 0" | oid /= [1,2,840,113549,1,1,1] = Left "rsaPubFromASN1: invalid OID" | otherwise = let inner = either strError rsaPubFromASN1 $ decodeASN1' BER bs strError = Left . ("fromASN1: RSA.PublicKey: " ++) . show in either Left (\(k, _) -> Right (k, xs)) inner rsaPubFromASN1 _ = Left "fromASN1: RSA.PublicKey: unexpected format" -- some bad implementation will not serialize ASN.1 integer properly, leading -- to negative modulus. toPositive :: Integer -> Integer toPositive int | int < 0 = uintOfBytes $ bytesOfInt int | otherwise = int where uintOfBytes = foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 bytesOfInt :: Integer -> [Word8] bytesOfInt n = if testBit (head nints) 7 then nints else 0xff : nints where nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n) plusOne [] = [1] plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs bytesOfUInt x = reverse (list x) where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8) x509-1.6.4/Data/X509/PrivateKey.hs0000644000000000000000000000146712600061206014353 0ustar0000000000000000-- | -- Module : Data.X509.PublicKey -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Public key handling in X.509 infrastructure -- module Data.X509.PrivateKey ( PrivKey(..) , privkeyToAlg ) where import Data.X509.AlgorithmIdentifier import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA -- | Private key types known and used in X.509 data PrivKey = PrivKeyRSA RSA.PrivateKey -- ^ RSA private key | PrivKeyDSA DSA.PrivateKey -- ^ DSA private key deriving (Show,Eq) -- | Convert a Public key to the Public Key Algorithm type privkeyToAlg :: PrivKey -> PubKeyALG privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA x509-1.6.4/Data/X509/Ext.hs0000644000000000000000000003051612635040450013033 0ustar0000000000000000-- | -- Module : Data.X509.Ext -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- extension processing module. -- {-# LANGUAGE FlexibleContexts #-} module Data.X509.Ext ( Extension(..) -- * Common extension usually found in x509v3 , ExtBasicConstraints(..) , ExtKeyUsage(..) , ExtKeyUsageFlag(..) , ExtExtendedKeyUsage(..) , ExtKeyUsagePurpose(..) , ExtSubjectKeyId(..) , ExtSubjectAltName(..) , ExtAuthorityKeyId(..) , ExtCrlDistributionPoints(..) , AltName(..) , DistributionPoint(..) , ReasonFlag(..) -- * Accessor turning extension into a specific one , extensionGet , extensionGetE , extensionDecode , extensionEncode ) where import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.ASN1.Types import Data.ASN1.Parse import Data.ASN1.BitArray import Data.List (find) import Data.X509.ExtensionRaw import Data.X509.DistinguishedName import Data.X509.Internal import Control.Applicative -- | 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 -- | Get a specific extension from a lists of raw extensions extensionGetE :: Extension a => Extensions -> Maybe (Either String a) extensionGetE (Extensions Nothing) = Nothing extensionGetE (Extensions (Just l)) = findExt l where findExt [] = Nothing findExt (x:xs) = case extensionDecode x of Just r -> Just r _ -> 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 -- | Encode an Extension to extensionRaw extensionEncode :: Extension a => Bool -> a -> ExtensionRaw extensionEncode critical ext = ExtensionRaw (extOID ext) critical (extEncode ext) -- | 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" -- | Key usage purposes for the ExtendedKeyUsage extension data ExtKeyUsagePurpose = KeyUsagePurpose_ServerAuth | KeyUsagePurpose_ClientAuth | KeyUsagePurpose_CodeSigning | KeyUsagePurpose_EmailProtection | KeyUsagePurpose_TimeStamping | KeyUsagePurpose_OCSPSigning | KeyUsagePurpose_Unknown OID deriving (Show,Eq,Ord) extKeyUsagePurposedOID :: [(OID, ExtKeyUsagePurpose)] extKeyUsagePurposedOID = [(keyUsagePurposePrefix 1, KeyUsagePurpose_ServerAuth) ,(keyUsagePurposePrefix 2, KeyUsagePurpose_ClientAuth) ,(keyUsagePurposePrefix 3, KeyUsagePurpose_CodeSigning) ,(keyUsagePurposePrefix 4, KeyUsagePurpose_EmailProtection) ,(keyUsagePurposePrefix 8, KeyUsagePurpose_TimeStamping) ,(keyUsagePurposePrefix 9, KeyUsagePurpose_OCSPSigning)] where keyUsagePurposePrefix r = [1,3,6,1,5,5,7,3,r] -- | Extended key usage extension data ExtExtendedKeyUsage = ExtExtendedKeyUsage [ExtKeyUsagePurpose] deriving (Show,Eq) instance Extension ExtExtendedKeyUsage where extOID = const [2,5,29,37] extEncode (ExtExtendedKeyUsage purposes) = [Start Sequence] ++ map (OID . lookupRev) purposes ++ [End Sequence] where lookupRev (KeyUsagePurpose_Unknown oid) = oid lookupRev kup = maybe (error "unknown key usage purpose") fst $ find ((==) kup . snd) extKeyUsagePurposedOID extDecode l = ExtExtendedKeyUsage `fmap` (flip runParseASN1 l $ onNextContainer Sequence $ getMany $ do n <- getNext case n of OID o -> return $ maybe (KeyUsagePurpose_Unknown o) id $ lookup o extKeyUsagePurposedOID _ -> error "invalid content in extended key usage") -- | 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 | AltNameXMPP String | AltNameDNSSRV String 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 = error "extEncode ExtCrlDistributionPoints unimplemented" extDecode = error "extDecode ExtCrlDistributionPoints unimplemented" --extEncode (ExtCrlDistributionPoints ) parseGeneralNames :: ParseASN1 [AltName] parseGeneralNames = onNextContainer Sequence $ getMany getAddr where getAddr = do m <- onNextContainerMaybe (Container Context 0) getComposedAddr case m of Nothing -> getSimpleAddr Just r -> return r getComposedAddr = do n <- getNext case n of OID [1,3,6,1,5,5,7,8,5] -> do -- xmpp addr c <- getNextContainerMaybe (Container Context 0) case c of Just [ASN1String cs] -> case asn1CharacterToString cs of Nothing -> throwParseError ("GeneralNames: invalid string for XMPP Addr") Just s -> return $ AltNameXMPP s _ -> throwParseError ("GeneralNames: expecting string for XMPP Addr got: " ++ show c) OID [1,3,6,1,5,5,7,8,7] -> do -- DNSSRV addr c <- getNextContainerMaybe (Container Context 0) case c of Just [ASN1String cs] -> case asn1CharacterToString cs of Nothing -> throwParseError ("GeneralNames: invalid string for DNSSrv Addr") Just s -> return $ AltNameDNSSRV s _ -> throwParseError ("GeneralNames: expecting string for DNSSRV Addr got: " ++ show c) OID unknown -> throwParseError ("GeneralNames: unknown OID " ++ show unknown) _ -> throwParseError ("GeneralNames: expecting OID but got " ++ show n) getSimpleAddr = do n <- getNext case n of (Other Context 1 b) -> return $ AltNameRFC822 $ BC.unpack b (Other Context 2 b) -> return $ AltNameDNS $ BC.unpack b (Other Context 6 b) -> return $ AltNameURI $ BC.unpack b (Other Context 7 b) -> return $ AltNameIP b _ -> throwParseError ("GeneralNames: not coping with unknown stream " ++ show n) encodeGeneralNames :: [AltName] -> [ASN1] encodeGeneralNames names = [Start Sequence] ++ concatMap 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] encodeAltName (AltNameXMPP n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5] ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0) ,End (Container Context 0)] encodeAltName (AltNameDNSSRV n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5] ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0) ,End (Container Context 0)] 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 = toBitArray (B.pack [0,0]) 7 x509-1.6.4/Data/X509/ExtensionRaw.hs0000644000000000000000000000451512415407106014722 0ustar0000000000000000-- | -- 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 (Extensions Nothing) = \xs -> xs toASN1 (Extensions (Just exts)) = \xs -> asn1Container (Container Context 3) (asn1Container Sequence (concatMap encodeExt exts)) ++ xs fromASN1 s = runParseASN1State (Extensions <$> parseExtensions) s where parseExtensions = onNextContainerMaybe (Container Context 3) $ onNextContainer Sequence (getMany getObject) 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) 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]) x509-1.6.4/Data/X509/CRL.hs0000644000000000000000000000611512600002536012704 0ustar0000000000000000-- | -- 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. -- {-# LANGUAGE FlexibleContexts #-} module Data.X509.CRL ( CRL(..) , RevokedCertificate(..) ) where import Control.Applicative import Data.Hourglass (DateTime, TimezoneOffset(..)) 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 :: DateTime , crlNextUpdate :: Maybe DateTime , crlRevokedCertificates :: [RevokedCertificate] , crlExtensions :: Extensions } deriving (Show,Eq) -- | Describe a revoked certificate identifiable by serial number. data RevokedCertificate = RevokedCertificate { revokedSerialNumber :: Integer , revokedDate :: DateTime , 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 (Just (TimezoneOffset 0)) : 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 _ = throwParseError "unexpected type for version" getThisUpdate (ASN1Time _ t1 _) = return t1 getThisUpdate _ = throwParseError "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) (Just (TimezoneOffset 0))] ++ (maybe [] (\t -> [ASN1Time TimeGeneralized t (Just (TimezoneOffset 0))]) (crlNextUpdate crl)) ++ [Start Sequence] ++ revoked ++ [End Sequence] ++ toASN1 (crlExtensions crl) [] ++ xs where revoked = concatMap (\e -> toASN1 e []) (crlRevokedCertificates crl) x509-1.6.4/Data/X509/OID.hs0000644000000000000000000000343612541074511012710 0ustar0000000000000000-- | -- Module : Data.X509.OID -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Data.X509.OID ( OIDTable , lookupByOID , lookupOID , curvesOIDTable ) where import Control.Applicative import Crypto.PubKey.ECC.Types import Data.ASN1.OID import Data.List (find) type OIDTable a = [(a,OID)] lookupByOID :: OIDTable a -> OID -> Maybe a lookupByOID table oid = fst <$> find ((==) oid . snd) table lookupOID :: Eq a => OIDTable a -> a -> Maybe OID lookupOID table a = lookup a table curvesOIDTable :: OIDTable CurveName curvesOIDTable = [ (SEC_p112r1, [1,3,132,0,6]) , (SEC_p112r2, [1,3,132,0,7]) , (SEC_p128r1, [1,3,132,0,28]) , (SEC_p128r2, [1,3,132,0,29]) , (SEC_p160k1, [1,3,132,0,9]) , (SEC_p160r1, [1,3,132,0,8]) , (SEC_p160r2, [1,3,132,0,30]) , (SEC_p192k1, [1,3,132,0,31]) , (SEC_p192r1, [1,2,840,10045,3,1,1]) , (SEC_p224k1, [1,3,132,0,32]) , (SEC_p224r1, [1,3,132,0,33]) , (SEC_p256k1, [1,3,132,0,10]) , (SEC_p256r1, [1,2,840,10045,3,1,7]) , (SEC_p384r1, [1,3,132,0,34]) , (SEC_p521r1, [1,3,132,0,35]) , (SEC_t113r1, [1,3,132,0,4]) , (SEC_t113r2, [1,3,132,0,5]) , (SEC_t131r1, [1,3,132,0,22]) , (SEC_t131r2, [1,3,132,0,23]) , (SEC_t163k1, [1,3,132,0,1]) , (SEC_t163r1, [1,3,132,0,2]) , (SEC_t163r2, [1,3,132,0,15]) , (SEC_t193r1, [1,3,132,0,24]) , (SEC_t193r2, [1,3,132,0,25]) , (SEC_t233k1, [1,3,132,0,26]) , (SEC_t233r1, [1,3,132,0,27]) , (SEC_t239k1, [1,3,132,0,3]) , (SEC_t283k1, [1,3,132,0,16]) , (SEC_t283r1, [1,3,132,0,17]) , (SEC_t409k1, [1,3,132,0,36]) , (SEC_t409r1, [1,3,132,0,37]) , (SEC_t571k1, [1,3,132,0,38]) , (SEC_t571r1, [1,3,132,0,39]) ] x509-1.6.4/Data/X509/Signed.hs0000644000000000000000000001600512415407106013502 0ustar0000000000000000-- | -- 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 (Show a, Eq a, ASN1Object a) => Signed a = Signed { signedObject :: a -- ^ Object to sign , signedAlg :: SignatureALG -- ^ Signature Algorithm used , signedSignature :: B.ByteString -- ^ Signature as bytes } deriving (Show, 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 (Show a, 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 (Show, Eq) -- | Get the signed data for the signature getSignedData :: (Show a, 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 :: (Show a, 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 :: (Show a, 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 :: (Show a, 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 :: (Show a, 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 . 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 } (Right (_,remObj), _) -> Left $ ("signed object error: remaining stream in object: " ++ show remObj) (Left err, _) -> Left $ ("signed object error: " ++ show err) onContainer ((Start _, _) : l) f = case reverse l of ((End _, _) : l2) -> f $ reverse l2 _ -> f [] onContainer _ f = f [] x509-1.6.4/Tests/Tests.hs0000644000000000000000000001457512600066575013200 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Main where import Test.Tasty import Test.Tasty.QuickCheck import qualified Data.ByteString as B import Control.Applicative import Control.Monad import Data.List (nub, sort) import Data.ASN1.Types import Data.X509 import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA import Data.Hourglass 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_EC,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 HashSHA512 PubKeyALG_RSA , SignatureALG HashSHA224 PubKeyALG_RSA , SignatureALG HashSHA1 PubKeyALG_DSA , SignatureALG HashSHA224 PubKeyALG_EC , SignatureALG HashSHA256 PubKeyALG_EC , SignatureALG HashSHA384 PubKeyALG_EC , SignatureALG HashSHA512 PubKeyALG_EC ] 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 DateTime where arbitrary = timeConvert <$> (arbitrary :: Gen Elapsed) instance Arbitrary Elapsed where arbitrary = Elapsed . Seconds <$> (choose (1, 100000000)) instance Arbitrary Extensions where arbitrary = Extensions <$> oneof [ pure Nothing , Just <$> (listOf1 $ oneof [ extensionEncode <$> arbitrary <*> (arbitrary :: Gen ExtKeyUsage) ] ) ] instance Arbitrary ExtKeyUsageFlag where arbitrary = elements $ enumFrom KeyUsage_digitalSignature instance Arbitrary ExtKeyUsage where arbitrary = ExtKeyUsage . sort . nub <$> listOf1 arbitrary instance Arbitrary ExtKeyUsagePurpose where arbitrary = elements [ KeyUsagePurpose_ServerAuth , KeyUsagePurpose_ClientAuth , KeyUsagePurpose_CodeSigning , KeyUsagePurpose_EmailProtection , KeyUsagePurpose_TimeStamping , KeyUsagePurpose_OCSPSigning ] instance Arbitrary ExtExtendedKeyUsage where arbitrary = ExtExtendedKeyUsage . nub <$> listOf1 arbitrary 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 property_unmarshall_marshall_id :: (Show o, Arbitrary o, ASN1Object o, Eq o) => o -> Bool property_unmarshall_marshall_id o = case got of Right (gotObject, []) | gotObject == o -> True | otherwise -> error ("object is different: " ++ show gotObject ++ " expecting " ++ show o) Right (gotObject, l) -> error ("state remaining: " ++ show l ++ " marshalled: " ++ show oMarshalled ++ " parsed: " ++ show gotObject) Left e -> error ("parsing failed: " ++ show e ++ " object: " ++ show o ++ " marshalled as: " ++ show oMarshalled) where got = fromASN1 oMarshalled oMarshalled = toASN1 o [] property_extension_id :: (Show e, Eq e, Extension e) => e -> Bool property_extension_id e = case extDecode (extEncode e) of Left err -> error err Right v | v == e -> True | otherwise -> error ("expected " ++ show e ++ " got: " ++ show v) main = defaultMain $ testGroup "X509" [ testGroup "marshall" [ testProperty "pubkey" (property_unmarshall_marshall_id :: PubKey -> Bool) , testProperty "signature alg" (property_unmarshall_marshall_id :: SignatureALG -> Bool) , testGroup "extension" [ testProperty "key-usage" (property_extension_id :: ExtKeyUsage -> Bool) , testProperty "extended-key-usage" (property_extension_id :: ExtExtendedKeyUsage -> Bool) ] , testProperty "extensions" (property_unmarshall_marshall_id :: Extensions -> Bool) , testProperty "certificate" (property_unmarshall_marshall_id :: Certificate -> Bool) , testProperty "crl" (property_unmarshall_marshall_id :: CRL -> Bool) ] ] x509-1.6.4/LICENSE0000644000000000000000000000273112415407106011425 0ustar0000000000000000Copyright (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. x509-1.6.4/Setup.hs0000644000000000000000000000005612415407106012052 0ustar0000000000000000import Distribution.Simple main = defaultMain x509-1.6.4/x509.cabal0000644000000000000000000000407012766605055012123 0ustar0000000000000000Name: x509 Version: 1.6.4 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 , memory , mtl , containers , hourglass , pem >= 0.1 && < 0.3 , asn1-types >= 0.3.1 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 , asn1-parse >= 0.9.3 && < 0.10 , cryptonite 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.PrivateKey Data.X509.Ext Data.X509.ExtensionRaw Data.X509.CRL Data.X509.OID 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 , tasty , tasty-quickcheck , hourglass , asn1-types , x509 , cryptonite ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures source-repository head type: git location: git://github.com/vincenthz/hs-certificate subdir: x509