x509-1.7.5/Data/0000755000000000000000000000000013324566036011300 5ustar0000000000000000x509-1.7.5/Data/X509/0000755000000000000000000000000013367542641011750 5ustar0000000000000000x509-1.7.5/Tests/0000755000000000000000000000000013367542641011534 5ustar0000000000000000x509-1.7.5/Data/X509.hs0000644000000000000000000000673113324566036012310 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(..) , PrivKeyEC(..) , 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 , objectToSignedExactF , 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.7.5/Data/X509/EC.hs0000644000000000000000000001144313324566036012573 0ustar0000000000000000-- | -- Module : Data.X509.EC -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Utilities related to Elliptic Curve certificates and keys. -- module Data.X509.EC ( unserializePoint , ecPubKeyCurve , ecPubKeyCurveName , ecPrivKeyCurve , ecPrivKeyCurveName , lookupCurveNameByOID ) where import Data.ASN1.OID import Data.List (find) import Data.X509.OID import Data.X509.PublicKey import Data.X509.PrivateKey import qualified Crypto.PubKey.ECC.Prim as ECC import qualified Crypto.PubKey.ECC.Types as ECC import Crypto.Number.Serialize (os2ip) import qualified Data.ByteString as B -- | Read an EC point from a serialized format and make sure the point is -- valid for the specified curve. unserializePoint :: ECC.Curve -> SerializedPoint -> Maybe ECC.Point unserializePoint curve (SerializedPoint bs) = case B.uncons bs of Nothing -> Nothing Just (ptFormat, input) -> case ptFormat of 4 -> if B.length input /= 2 * bytes then Nothing else let (x, y) = B.splitAt bytes input p = ECC.Point (os2ip x) (os2ip y) in if ECC.isPointValid curve p then Just p else Nothing -- 2 and 3 for compressed format. _ -> Nothing where bits = ECC.curveSizeBits curve bytes = (bits + 7) `div` 8 -- | Return the curve associated to an EC Public Key. This does not check -- if a curve in explicit format is valid: if the input is not trusted one -- should consider 'ecPubKeyCurveName' instead. ecPubKeyCurve :: PubKeyEC -> Maybe ECC.Curve ecPubKeyCurve (PubKeyEC_Named name _) = Just $ ECC.getCurveByName name ecPubKeyCurve pub@PubKeyEC_Prime{} = fmap buildCurve $ unserializePoint (buildCurve undefined) (pubkeyEC_generator pub) where prime = pubkeyEC_prime pub buildCurve g = let cc = ECC.CurveCommon { ECC.ecc_a = pubkeyEC_a pub , ECC.ecc_b = pubkeyEC_b pub , ECC.ecc_g = g , ECC.ecc_n = pubkeyEC_order pub , ECC.ecc_h = pubkeyEC_cofactor pub } in ECC.CurveFP (ECC.CurvePrime prime cc) -- | Return the name of a standard curve associated to an EC Public Key ecPubKeyCurveName :: PubKeyEC -> Maybe ECC.CurveName ecPubKeyCurveName (PubKeyEC_Named name _) = Just name ecPubKeyCurveName pub@PubKeyEC_Prime{} = find matchPrimeCurve $ enumFrom $ toEnum 0 where matchPrimeCurve c = case ECC.getCurveByName c of ECC.CurveFP (ECC.CurvePrime p cc) -> ECC.ecc_a cc == pubkeyEC_a pub && ECC.ecc_b cc == pubkeyEC_b pub && ECC.ecc_n cc == pubkeyEC_order pub && p == pubkeyEC_prime pub _ -> False -- | Return the EC curve associated to an EC Private Key. This does not check -- if a curve in explicit format is valid: if the input is not trusted one -- should consider 'ecPrivKeyCurveName' instead. ecPrivKeyCurve :: PrivKeyEC -> Maybe ECC.Curve ecPrivKeyCurve (PrivKeyEC_Named name _) = Just $ ECC.getCurveByName name ecPrivKeyCurve priv@PrivKeyEC_Prime{} = fmap buildCurve $ unserializePoint (buildCurve undefined) (privkeyEC_generator priv) where prime = privkeyEC_prime priv buildCurve g = let cc = ECC.CurveCommon { ECC.ecc_a = privkeyEC_a priv , ECC.ecc_b = privkeyEC_b priv , ECC.ecc_g = g , ECC.ecc_n = privkeyEC_order priv , ECC.ecc_h = privkeyEC_cofactor priv } in ECC.CurveFP (ECC.CurvePrime prime cc) -- | Return the name of a standard curve associated to an EC Private Key ecPrivKeyCurveName :: PrivKeyEC -> Maybe ECC.CurveName ecPrivKeyCurveName (PrivKeyEC_Named name _) = Just name ecPrivKeyCurveName priv@PrivKeyEC_Prime{} = find matchPrimeCurve $ enumFrom $ toEnum 0 where matchPrimeCurve c = case ECC.getCurveByName c of ECC.CurveFP (ECC.CurvePrime p cc) -> ECC.ecc_a cc == privkeyEC_a priv && ECC.ecc_b cc == privkeyEC_b priv && ECC.ecc_n cc == privkeyEC_order priv && p == privkeyEC_prime priv _ -> False -- | Return the curve name associated to an OID lookupCurveNameByOID :: OID -> Maybe ECC.CurveName lookupCurveNameByOID = lookupByOID curvesOIDTable x509-1.7.5/Data/X509/Internal.hs0000644000000000000000000000145413324566036014061 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.7.5/Data/X509/CertificateChain.hs0000644000000000000000000000323513324566036015471 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.7.5/Data/X509/AlgorithmIdentifier.hs0000644000000000000000000001353213367542641016241 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_RSAPSS -- ^ RSA PSS Key algorithm (RFC 3447) | PubKeyALG_DSA -- ^ DSA Public Key algorithm | PubKeyALG_EC -- ^ ECDSA & ECDH Public Key algorithm | PubKeyALG_X25519 -- ^ ECDH 25519 key agreement | PubKeyALG_X448 -- ^ ECDH 448 key agreement | PubKeyALG_Ed25519 -- ^ EdDSA 25519 signature algorithm | PubKeyALG_Ed448 -- ^ EdDSA 448 signature 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. For some signature algorithms the hash algorithm is intrinsic to -- the public key algorithm and is not needed in the data type. data SignatureALG = SignatureALG HashALG PubKeyALG | SignatureALG_IntrinsicHash PubKeyALG | SignatureALG_Unknown OID deriving (Show,Eq) instance OIDable PubKeyALG where getObjectID PubKeyALG_RSA = [1,2,840,113549,1,1,1] getObjectID PubKeyALG_RSAPSS = [1,2,840,113549,1,1,10] getObjectID PubKeyALG_DSA = [1,2,840,10040,4,1] getObjectID PubKeyALG_EC = [1,2,840,10045,2,1] getObjectID PubKeyALG_X25519 = [1,3,101,110] getObjectID PubKeyALG_X448 = [1,3,101,111] getObjectID PubKeyALG_Ed25519 = [1,3,101,112] getObjectID PubKeyALG_Ed448 = [1,3,101,113] 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) , ([2,16,840,1,101,3,4,2,1], SignatureALG HashSHA256 PubKeyALG_RSAPSS) , ([2,16,840,1,101,3,4,2,2], SignatureALG HashSHA384 PubKeyALG_RSAPSS) , ([2,16,840,1,101,3,4,2,3], SignatureALG HashSHA512 PubKeyALG_RSAPSS) , ([2,16,840,1,101,3,4,2,4], SignatureALG HashSHA224 PubKeyALG_RSAPSS) , ([2,16,840,1,101,3,4,3,1], SignatureALG HashSHA224 PubKeyALG_DSA) , ([2,16,840,1,101,3,4,3,2], SignatureALG HashSHA256 PubKeyALG_DSA) , ([1,3,101,112], SignatureALG_IntrinsicHash PubKeyALG_Ed25519) , ([1,3,101,113], SignatureALG_IntrinsicHash PubKeyALG_Ed448) ] 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 -- | PSS salt length. Always assume ``-sigopt rsa_pss_saltlen:-1`` saltLen :: HashALG -> Integer saltLen HashSHA256 = 32 saltLen HashSHA384 = 48 saltLen HashSHA512 = 64 saltLen HashSHA224 = 28 saltLen _ = error "toASN1: X509.SignatureAlg.HashAlg: Unknown hash" 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 (Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start _:Start Sequence:OID hash1:End Sequence:End _:Start _:Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID _hash2:End Sequence:End Sequence:End _:Start _: IntVal _iv: End _: End Sequence : End Sequence:xs) = Right (oidSig hash1, xs) fromASN1 (Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start _:Start Sequence:OID hash1:Null:End Sequence:End _:Start _:Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID _hash2:Null:End Sequence:End Sequence:End _:Start _: IntVal _iv: End _: End Sequence : End Sequence:xs) = Right (oidSig hash1, xs) fromASN1 _ = Left "fromASN1: X509.SignatureALG: unknown format" toASN1 (SignatureALG_Unknown oid) = \xs -> Start Sequence:OID oid:Null:End Sequence:xs toASN1 signatureAlg@(SignatureALG hashAlg PubKeyALG_RSAPSS) = \xs -> Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start (Container Context 0):Start Sequence:OID (sigOID signatureAlg):End Sequence:End (Container Context 0):Start (Container Context 1): Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID (sigOID signatureAlg):End Sequence:End Sequence:End (Container Context 1):Start (Container Context 2):IntVal (saltLen hashAlg):End (Container Context 2):End Sequence:End Sequence:xs toASN1 signatureAlg = \xs -> Start Sequence:OID (sigOID signatureAlg):Null:End Sequence:xs x509-1.7.5/Data/X509/DistinguishedName.hs0000644000000000000000000000660413324566036015713 0ustar0000000000000000-- | -- Module : Data.X509.DistinguishedName -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Distinguished names types and functions {-# LANGUAGE CPP #-} module Data.X509.DistinguishedName ( DistinguishedName(..) , DistinguishedNameInner(..) , ASN1CharacterString(..) -- Distinguished Name Elements , DnElement(..) , getDnElement ) where import Control.Applicative #if MIN_VERSION_base(4,9,0) import Data.Semigroup #else import Data.Monoid #endif 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) #if MIN_VERSION_base(4,9,0) instance Semigroup DistinguishedName where DistinguishedName l1 <> DistinguishedName l2 = DistinguishedName (l1++l2) #endif instance Monoid DistinguishedName where mempty = DistinguishedName [] #if !(MIN_VERSION_base(4,11,0)) mappend (DistinguishedName l1) (DistinguishedName l2) = DistinguishedName (l1++l2) #endif 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.7.5/Data/X509/Cert.hs0000644000000000000000000001044013324566036013175 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 0 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.7.5/Data/X509/PublicKey.hs0000644000000000000000000003115413367542641014177 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.ByteArray (convert) import Data.ByteString (ByteString) import Data.X509.Internal import Data.X509.OID import Data.X509.AlgorithmIdentifier import Crypto.Error (CryptoFailable(..)) import qualified Crypto.PubKey.RSA.Types as RSA import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448 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 | PubKeyX25519 X25519.PublicKey -- ^ X25519 public key | PubKeyX448 X448.PublicKey -- ^ X448 public key | PubKeyEd25519 Ed25519.PublicKey -- ^ Ed25519 public key | PubKeyEd448 Ed448.PublicKey -- ^ Ed448 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 | pkalg == getObjectID PubKeyALG_X25519 = case xs of End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "X25519" PubKeyX25519 bits xs2 X25519.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown X25519 format: " ++ show xs) | pkalg == getObjectID PubKeyALG_X448 = case xs of End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "X448" PubKeyX448 bits xs2 X448.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown X448 format: " ++ show xs) | pkalg == getObjectID PubKeyALG_Ed25519 = case xs of End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "Ed25519" PubKeyEd25519 bits xs2 Ed25519.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown Ed25519 format: " ++ show xs) | pkalg == getObjectID PubKeyALG_Ed448 = case xs of End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "Ed448" PubKeyEd448 bits xs2 Ed448.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown Ed448 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 decodeCF format c bits xs2 f = case f (bitArrayGetData bits) of CryptoPassed pk -> Right (c pk, xs2) CryptoFailed err -> Left ("fromASN1: X509.PubKey " ++ format ++ " bitarray contains an invalid public key: " ++ show err) 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 (PubKeyX25519 _) = PubKeyALG_X25519 pubkeyToAlg (PubKeyX448 _) = PubKeyALG_X448 pubkeyToAlg (PubKeyEd25519 _) = PubKeyALG_Ed25519 pubkeyToAlg (PubKeyEd448 _) = PubKeyALG_Ed448 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 lookupOID curvesOIDTable curveName of Just oid -> oid _ -> error ("undefined curve OID: " ++ show curveName) encodeInner (PubKeyEC (PubKeyEC_Prime {})) = error "encodeInner: unimplemented public key EC_Prime" encodeInner (PubKeyX25519 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] encodeInner (PubKeyX448 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] encodeInner (PubKeyEd25519 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] encodeInner (PubKeyEd448 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] 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.7.5/Data/X509/PrivateKey.hs0000644000000000000000000002655013367542641014377 0ustar0000000000000000-- | -- Module : Data.X509.PublicKey -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Private key handling in X.509 infrastructure -- module Data.X509.PrivateKey ( PrivKey(..) , PrivKeyEC(..) , privkeyToAlg ) where import Control.Applicative ((<$>), pure) import Data.Maybe (fromMaybe) import Data.Word (Word) import Data.ByteArray (ByteArrayAccess, convert) import qualified Data.ByteString as B import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding import Data.ASN1.BitArray import Data.ASN1.Stream (getConstructedEnd) import Data.X509.AlgorithmIdentifier import Data.X509.PublicKey (SerializedPoint(..)) import Data.X509.OID (lookupByOID, lookupOID, curvesOIDTable) import Crypto.Error (CryptoFailable(..)) import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448 -- | Elliptic Curve Private Key -- -- TODO: missing support for binary curve. data PrivKeyEC = PrivKeyEC_Prime { privkeyEC_priv :: Integer , privkeyEC_a :: Integer , privkeyEC_b :: Integer , privkeyEC_prime :: Integer , privkeyEC_generator :: SerializedPoint , privkeyEC_order :: Integer , privkeyEC_cofactor :: Integer , privkeyEC_seed :: Integer } | PrivKeyEC_Named { privkeyEC_name :: ECC.CurveName , privkeyEC_priv :: Integer } deriving (Show,Eq) -- | Private key types known and used in X.509 data PrivKey = PrivKeyRSA RSA.PrivateKey -- ^ RSA private key | PrivKeyDSA DSA.PrivateKey -- ^ DSA private key | PrivKeyEC PrivKeyEC -- ^ EC private key | PrivKeyX25519 X25519.SecretKey -- ^ X25519 private key | PrivKeyX448 X448.SecretKey -- ^ X448 private key | PrivKeyEd25519 Ed25519.SecretKey -- ^ Ed25519 private key | PrivKeyEd448 Ed448.SecretKey -- ^ Ed448 private key deriving (Show,Eq) instance ASN1Object PrivKey where fromASN1 = privkeyFromASN1 toASN1 = privkeyToASN1 privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1]) privkeyFromASN1 asn1 = (mapFst PrivKeyRSA <$> rsaFromASN1 asn1) (mapFst PrivKeyDSA <$> dsaFromASN1 asn1) (mapFst PrivKeyEC <$> ecdsaFromASN1 asn1) newcurveFromASN1 asn1 where mapFst f (a, b) = (f a, b) Left _ b = b a _ = a rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1]) rsaFromASN1 (Start Sequence : IntVal 0 : IntVal n : IntVal e : IntVal d : IntVal p : IntVal q : IntVal dP : IntVal dQ : IntVal qinv : End Sequence : as) = pure (key, as) where key = RSA.PrivateKey (RSA.PublicKey (go n 1) n e) d p q dP dQ qinv go m i | 2 ^ (i * 8) > m = i | otherwise = go m (i + 1) rsaFromASN1 (Start Sequence : IntVal 0 : Start Sequence : OID [1, 2, 840, 113549, 1, 1, 1] : Null : End Sequence : OctetString bytes : End Sequence : as) = do asn1 <- mapLeft failure (decodeASN1' BER bytes) fmap (const as) <$> rsaFromASN1 asn1 where failure = ("rsaFromASN1: " ++) . show rsaFromASN1 _ = Left "rsaFromASN1: unexpected format" dsaFromASN1 :: [ASN1] -> Either String (DSA.PrivateKey, [ASN1]) dsaFromASN1 (Start Sequence : IntVal 0 : IntVal p : IntVal q : IntVal g : IntVal _ : IntVal x : End Sequence : as) = pure (DSA.PrivateKey (DSA.Params p g q) x, as) dsaFromASN1 (Start Sequence : IntVal 0 : Start Sequence : OID [1, 2, 840, 10040, 4, 1] : Start Sequence : IntVal p : IntVal q : IntVal g : End Sequence : End Sequence : OctetString bytes : End Sequence : as) = case decodeASN1' BER bytes of Right [IntVal x] -> pure (DSA.PrivateKey (DSA.Params p g q) x, as) Right _ -> Left "DSA.PrivateKey.fromASN1: unexpected format" Left e -> Left $ "DSA.PrivateKey.fromASN1: " ++ show e dsaFromASN1 _ = Left "DSA.PrivateKey.fromASN1: unexpected format" ecdsaFromASN1 :: [ASN1] -> Either String (PrivKeyEC, [ASN1]) ecdsaFromASN1 = go [] where failing = ("ECDSA.PrivateKey.fromASN1: " ++) go acc (Start Sequence : IntVal 1 : OctetString bytes : rest) = do key <- subgo (oid ++ acc) case rest'' of End Sequence : rest''' -> pure (key, rest''') _ -> Left $ failing "unexpected EC format" where d = os2ip bytes (oid, rest') = spanTag 0 rest (_, rest'') = spanTag 1 rest' subgo (OID oid_ : _) = maybe failure success mcurve where failure = Left $ failing $ "unknown curve " ++ show oid_ success = Right . flip PrivKeyEC_Named d mcurve = lookupByOID curvesOIDTable oid_ subgo (Start Sequence : IntVal 1 : Start Sequence : OID [1, 2, 840, 10045, 1, 1] : IntVal p : End Sequence : Start Sequence : OctetString a : OctetString b : BitString s : End Sequence : OctetString g : IntVal o : IntVal c : End Sequence : _) = pure $ PrivKeyEC_Prime d a' b' p g' o c s' where a' = os2ip a b' = os2ip b g' = SerializedPoint g s' = os2ip $ bitArrayGetData s subgo (Null : rest_) = subgo rest_ subgo [] = Left $ failing "curve is missing" subgo _ = Left $ failing "unexpected curve format" go acc (Start Sequence : IntVal 0 : Start Sequence : OID [1, 2, 840, 10045, 2, 1] : rest) = case rest' of (OctetString bytes : rest'') -> do asn1 <- mapLeft (failing . show) (decodeASN1' BER bytes) fmap (const rest'') <$> go (oid ++ acc) asn1 _ -> Left $ failing "unexpected EC format" where (oid, rest') = spanEnd 0 rest go _ _ = Left $ failing "unexpected EC format" spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1]) spanEnd = loop id where loop dlist n (a@(Start _) : as) = loop (dlist . (a :)) (n + 1) as loop dlist 0 (End _ : as) = (dlist [], as) loop dlist n (a@(End _) : as) = loop (dlist . (a :)) (n - 1) as loop dlist n (a : as) = loop (dlist . (a :)) n as loop dlist _ [] = (dlist [], []) spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1]) spanTag a (Start (Container _ b) : as) | a == b = spanEnd 0 as spanTag _ as = ([], as) newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1]) newcurveFromASN1 ( Start Sequence : IntVal v : Start Sequence : OID oid : End Sequence : OctetString bs : xs) | isValidVersion v = do let (_, ys) = containerWithTag 0 xs case primitiveWithTag 1 ys of (_, End Sequence : zs) -> case getP oid of Just (name, parse) -> do let err s = Left (name ++ ".SecretKey.fromASN1: " ++ s) case decodeASN1' BER bs of Right [OctetString key] -> case parse key of CryptoPassed s -> Right (s, zs) CryptoFailed e -> err ("invalid secret key: " ++ show e) Right _ -> err "unexpected inner format" Left e -> err (show e) Nothing -> Left ("newcurveFromASN1: unexpected OID " ++ show oid) _ -> Left "newcurveFromASN1: unexpected end format" | otherwise = Left ("newcurveFromASN1: unexpected version: " ++ show v) where getP [1,3,101,110] = Just ("X25519", fmap PrivKeyX25519 . X25519.secretKey) getP [1,3,101,111] = Just ("X448", fmap PrivKeyX448 . X448.secretKey) getP [1,3,101,112] = Just ("Ed25519", fmap PrivKeyEd25519 . Ed25519.secretKey) getP [1,3,101,113] = Just ("Ed448", fmap PrivKeyEd448 . Ed448.secretKey) getP _ = Nothing isValidVersion version = version >= 0 && version <= 1 newcurveFromASN1 _ = Left "newcurveFromASN1: unexpected format" containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1]) containerWithTag etag (Start (Container _ atag) : xs) | etag == atag = getConstructedEnd 0 xs containerWithTag _ xs = ([], xs) primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe B.ByteString, [ASN1]) primitiveWithTag etag (Other _ atag bs : xs) | etag == atag = (Just bs, xs) primitiveWithTag _ xs = (Nothing, xs) privkeyToASN1 :: PrivKey -> ASN1S privkeyToASN1 (PrivKeyRSA rsa) = rsaToASN1 rsa privkeyToASN1 (PrivKeyDSA dsa) = dsaToASN1 dsa privkeyToASN1 (PrivKeyEC ecdsa) = ecdsaToASN1 ecdsa privkeyToASN1 (PrivKeyX25519 k) = newcurveToASN1 [1,3,101,110] k privkeyToASN1 (PrivKeyX448 k) = newcurveToASN1 [1,3,101,111] k privkeyToASN1 (PrivKeyEd25519 k) = newcurveToASN1 [1,3,101,112] k privkeyToASN1 (PrivKeyEd448 k) = newcurveToASN1 [1,3,101,113] k rsaToASN1 :: RSA.PrivateKey -> ASN1S rsaToASN1 key = (++) [ Start Sequence, IntVal 0, IntVal n, IntVal e, IntVal d, IntVal p , IntVal q, IntVal dP, IntVal dQ, IntVal qinv, End Sequence ] where RSA.PrivateKey (RSA.PublicKey _ n e) d p q dP dQ qinv = key dsaToASN1 :: DSA.PrivateKey -> ASN1S dsaToASN1 (DSA.PrivateKey params@(DSA.Params p g q) y) = (++) [ Start Sequence, IntVal 0, IntVal p, IntVal q, IntVal g, IntVal x , IntVal y, End Sequence ] where x = DSA.calculatePublic params y ecdsaToASN1 :: PrivKeyEC -> ASN1S ecdsaToASN1 (PrivKeyEC_Named curveName d) = (++) [ Start Sequence, IntVal 1, OctetString (i2osp d) , Start (Container Context 0), OID oid, End (Container Context 0) , End Sequence ] where err = error . ("ECDSA.PrivateKey.toASN1: " ++) oid = fromMaybe (err $ "missing named curve " ++ show curveName) (lookupOID curvesOIDTable curveName) ecdsaToASN1 (PrivKeyEC_Prime d a b p g o c s) = (++) [ Start Sequence, IntVal 1, OctetString (i2osp d) , Start (Container Context 0), Start Sequence, IntVal 1 , Start Sequence, OID [1, 2, 840, 10045, 1, 1], IntVal p, End Sequence , Start Sequence, OctetString a', OctetString b', BitString s' , End Sequence, OctetString g' , IntVal o, IntVal c, End Sequence , End (Container Context 0), End Sequence ] where a' = i2osp a b' = i2osp b SerializedPoint g' = g s' = BitArray (8 * fromIntegral (B.length bytes)) bytes where bytes = i2osp s newcurveToASN1 :: ByteArrayAccess key => OID -> key -> ASN1S newcurveToASN1 oid key = (++) [ Start Sequence, IntVal 0, Start Sequence, OID oid, End Sequence , OctetString (encodeASN1' DER [OctetString $ convert key]) , End Sequence ] mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b mapLeft f (Left x) = Left (f x) mapLeft _ (Right x) = Right x -- | Convert a Private key to the Public Key Algorithm type privkeyToAlg :: PrivKey -> PubKeyALG privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA privkeyToAlg (PrivKeyEC _) = PubKeyALG_EC privkeyToAlg (PrivKeyX25519 _) = PubKeyALG_X25519 privkeyToAlg (PrivKeyX448 _) = PubKeyALG_X448 privkeyToAlg (PrivKeyEd25519 _) = PubKeyALG_Ed25519 privkeyToAlg (PrivKeyEd448 _) = PubKeyALG_Ed448 x509-1.7.5/Data/X509/Ext.hs0000644000000000000000000003340213324566036013043 0ustar0000000000000000-- | -- Module : Data.X509.Ext -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- extension processing module. -- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.X509.Ext ( Extension(..) -- * Common extension usually found in x509v3 , ExtBasicConstraints(..) , ExtKeyUsage(..) , ExtKeyUsageFlag(..) , ExtExtendedKeyUsage(..) , ExtKeyUsagePurpose(..) , ExtSubjectKeyId(..) , ExtSubjectAltName(..) , ExtAuthorityKeyId(..) , ExtCrlDistributionPoints(..) , ExtNetscapeComment(..) , 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.Encoding import Data.ASN1.BinaryEncoding import Data.ASN1.BitArray import Data.Proxy import Data.List (find) import Data.X509.ExtensionRaw import Data.X509.DistinguishedName import Control.Applicative import Control.Monad -- | 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. -- -- Errata: turns out, the content is not necessarily ASN1, -- it could be data that is only parsable by the extension -- e.g. raw ascii string. Add method to parse and encode with -- ByteString class Extension a where extOID :: a -> OID extHasNestedASN1 :: Proxy a -> Bool extEncode :: a -> [ASN1] extDecode :: [ASN1] -> Either String a extDecodeBs :: B.ByteString -> Either String a extDecodeBs = (either (Left . show) Right . decodeASN1' BER) >=> extDecode extEncodeBs :: a -> B.ByteString extEncodeBs = encodeASN1' DER . extEncode -- | 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 :: forall a . Extension a => ExtensionRaw -> Maybe (Either String a) extensionDecode er@(ExtensionRaw oid _ content) | extOID (undefined :: a) /= oid = Nothing | extHasNestedASN1 (Proxy :: Proxy a) = Just (tryExtRawASN1 er >>= extDecode) | otherwise = Just (extDecodeBs content) -- | Encode an Extension to extensionRaw extensionEncode :: forall a . Extension a => Bool -> a -> ExtensionRaw extensionEncode critical ext | extHasNestedASN1 (Proxy :: Proxy a) = ExtensionRaw (extOID ext) critical (encodeASN1' DER $ extEncode ext) | otherwise = ExtensionRaw (extOID ext) critical (extEncodeBs ext) -- | Basic Constraints data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer) deriving (Show,Eq) instance Extension ExtBasicConstraints where extOID = const [2,5,29,19] extHasNestedASN1 = const True 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] extHasNestedASN1 = const True 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] extHasNestedASN1 = const True 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] extHasNestedASN1 = const True 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] extHasNestedASN1 = const True 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] extHasNestedASN1 = const True 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] extHasNestedASN1 = const True 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 data ExtNetscapeComment = ExtNetscapeComment B.ByteString deriving (Show,Eq) instance Extension ExtNetscapeComment where extOID _ = [2,16,840,1,113730,1,13] extHasNestedASN1 = const False extEncode = error "Extension: Netscape Comment do not contain nested ASN1" extDecode = error "Extension: Netscape Comment do not contain nested ASN1" extEncodeBs (ExtNetscapeComment b) = b extDecodeBs = Right . ExtNetscapeComment x509-1.7.5/Data/X509/ExtensionRaw.hs0000644000000000000000000000477413324566036014743 0ustar0000000000000000-- | -- Module : Data.X509.ExtensionRaw -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- extension marshalling -- module Data.X509.ExtensionRaw ( ExtensionRaw(..) , tryExtRawASN1 , extRawASN1 , Extensions(..) ) where import Control.Applicative import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding import Data.X509.Internal import qualified Data.ByteString as B -- | An undecoded extension data ExtensionRaw = ExtensionRaw { extRawOID :: OID -- ^ OID of this extension , extRawCritical :: Bool -- ^ if this extension is critical , extRawContent :: B.ByteString -- ^ undecoded content } deriving (Show,Eq) tryExtRawASN1 :: ExtensionRaw -> Either String [ASN1] tryExtRawASN1 (ExtensionRaw oid _ content) = case decodeASN1' BER content of Left err -> Left $ "fromASN1: X509.ExtensionRaw: OID=" ++ show oid ++ ": cannot decode data: " ++ show err Right r -> Right r extRawASN1 :: ExtensionRaw -> [ASN1] extRawASN1 extRaw = either error id $ tryExtRawASN1 extRaw {-# DEPRECATED extRawASN1 "use tryExtRawASN1 instead" #-} -- | 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 -> Right (ExtensionRaw oid b obj, xs2) OctetString obj:End Sequence:xs2 -> Right (ExtensionRaw oid False obj, xs2) _ -> Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show xs) fromASN1 l = Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show l) encodeExt :: ExtensionRaw -> [ASN1] encodeExt (ExtensionRaw oid critical content) = asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString content]) x509-1.7.5/Data/X509/CRL.hs0000644000000000000000000000611513324566036012724 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.7.5/Data/X509/OID.hs0000644000000000000000000000343613324566036012722 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.7.5/Data/X509/Signed.hs0000644000000000000000000001750113324566036013516 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 , objectToSignedExactF , 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, val) where (val, signedExact) = objectToSignedExactF (wrap . signatureFunction) object wrap (b, s, r) = (r, (b, s)) -- | A generalization of 'objectToSignedExact' where the signature function -- runs in an arbitrary functor. This allows for example to sign using an -- algorithm needing random values. objectToSignedExactF :: (Functor f, Show a, Eq a, ASN1Object a) => (ByteString -> f (ByteString, SignatureALG)) -- ^ signature function -> a -- ^ object to sign -> f (SignedExact a) objectToSignedExactF signatureFunction object = fmap buildSignedExact (signatureFunction objRaw) where buildSignedExact (sigBits,sigAlg) = let signed = Signed { signedObject = object , signedAlg = sigAlg , signedSignature = sigBits } signedRaw = encodeASN1' DER signedASN1 signedASN1 = Start Sequence : objASN1 (toASN1 sigAlg (BitString (toBitArray sigBits 0) : End Sequence : [])) in SignedExact signed objRaw signedRaw objASN1 = \xs -> Start Sequence : toASN1 object (End Sequence : xs) objRaw = encodeASN1' DER (objASN1 []) -- | 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.7.5/Tests/Tests.hs0000644000000000000000000002122113367542641013170 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 Crypto.Error (throwCryptoError) import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448 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 X25519.PublicKey where arbitrary = X25519.toPublic <$> arbitrary instance Arbitrary X448.PublicKey where arbitrary = X448.toPublic <$> arbitrary instance Arbitrary Ed25519.PublicKey where arbitrary = Ed25519.toPublic <$> arbitrary instance Arbitrary Ed448.PublicKey where arbitrary = Ed448.toPublic <$> arbitrary instance Arbitrary PubKey where arbitrary = oneof [ PubKeyRSA <$> arbitrary , PubKeyDSA <$> arbitrary --, PubKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary) , PubKeyX25519 <$> arbitrary , PubKeyX448 <$> arbitrary , PubKeyEd25519 <$> arbitrary , PubKeyEd448 <$> arbitrary ] instance Arbitrary RSA.PrivateKey where arbitrary = RSA.PrivateKey <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary DSA.PrivateKey where arbitrary = DSA.PrivateKey <$> arbitrary <*> arbitrary instance Arbitrary X25519.SecretKey where arbitrary = throwCryptoError . X25519.secretKey <$> arbitraryBS 32 32 instance Arbitrary X448.SecretKey where arbitrary = throwCryptoError . X448.secretKey <$> arbitraryBS 56 56 instance Arbitrary Ed25519.SecretKey where arbitrary = throwCryptoError . Ed25519.secretKey <$> arbitraryBS 32 32 instance Arbitrary Ed448.SecretKey where arbitrary = throwCryptoError . Ed448.secretKey <$> arbitraryBS 57 57 instance Arbitrary PrivKey where arbitrary = oneof [ PrivKeyRSA <$> arbitrary , PrivKeyDSA <$> arbitrary --, PrivKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary) , PrivKeyX25519 <$> arbitrary , PrivKeyX448 <$> arbitrary , PrivKeyEd25519 <$> arbitrary , PrivKeyEd448 <$> 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_DSA , SignatureALG HashSHA256 PubKeyALG_DSA , SignatureALG HashSHA224 PubKeyALG_EC , SignatureALG HashSHA256 PubKeyALG_EC , SignatureALG HashSHA384 PubKeyALG_EC , SignatureALG HashSHA512 PubKeyALG_EC , SignatureALG_IntrinsicHash PubKeyALG_Ed25519 , SignatureALG_IntrinsicHash PubKeyALG_Ed448 ] 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 "privkey" (property_unmarshall_marshall_id :: PrivKey -> 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.7.5/LICENSE0000644000000000000000000000273113324566036011437 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.7.5/Setup.hs0000644000000000000000000000005613324566036012064 0ustar0000000000000000import Distribution.Simple main = defaultMain x509-1.7.5/x509.cabal0000644000000000000000000000426013367555352012130 0ustar0000000000000000Name: x509 version: 1.7.5 Description: X509 reader and writer. please see README 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.10 Library Default-Language: Haskell2010 Build-Depends: base >= 3 && < 5 , bytestring , memory , mtl , containers , hourglass , pem >= 0.1 , asn1-types >= 0.3.1 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 , asn1-parse >= 0.9.3 && < 0.10 , cryptonite >= 0.24 Exposed-modules: Data.X509 Data.X509.EC 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 Default-Language: Haskell2010 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