x509 1.4.13 → 1.7.7
raw patch · 16 files changed
Files
- ChangeLog.md +6/−0
- Data/X509.hs +10/−6
- Data/X509/AlgorithmIdentifier.hs +53/−12
- Data/X509/CRL.hs +47/−23
- Data/X509/Cert.hs +23/−12
- Data/X509/DistinguishedName.hs +17/−3
- Data/X509/EC.hs +126/−0
- Data/X509/Ext.hs +56/−20
- Data/X509/ExtensionRaw.hs +20/−15
- Data/X509/Internal.hs +8/−0
- Data/X509/OID.hs +63/−0
- Data/X509/PrivateKey.hs +268/−4
- Data/X509/PublicKey.hs +178/−19
- Data/X509/Signed.hs +27/−13
- Tests/Tests.hs +79/−17
- x509.cabal +21/−22
+ ChangeLog.md view
@@ -0,0 +1,6 @@+# ChangeLog for x509++## 2022-05-31 v1.7.7++- Bump requirements to GHC 7.8 and transformers 0.4 series [#130](https://github.com/haskell-tls/hs-certificate/pull/130)+
Data/X509.hs view
@@ -16,7 +16,10 @@ , SignedCRL , Certificate(..) , PubKey(..)+ , PubKeyEC(..)+ , SerializedPoint(..) , PrivKey(..)+ , PrivKeyEC(..) , pubkeyToAlg , privkeyToAlg , module Data.X509.AlgorithmIdentifier@@ -41,6 +44,7 @@ , getSigned , getSignedData , objectToSignedExact+ , objectToSignedExactF , encodeSignedObject , decodeSignedObject @@ -61,6 +65,7 @@ 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@@ -73,8 +78,7 @@ import Data.X509.PrivateKey import Data.X509.AlgorithmIdentifier -import qualified Crypto.Hash.MD5 as MD5-import qualified Crypto.Hash.SHA1 as SHA1+import Crypto.Hash -- | A Signed Certificate type SignedCertificate = SignedExact Certificate@@ -103,7 +107,7 @@ -- OpenSSL algorithm is odd, and has been replicated here somewhat. -- only lower the case of ascii character. hashDN :: DistinguishedName -> B.ByteString-hashDN = shorten . SHA1.hash . encodeASN1' DER . flip toASN1 [] . DistinguishedNameInner . dnLowerUTF8+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@@ -114,8 +118,8 @@ -- | Create an openssl style old hash of distinguished name hashDN_old :: DistinguishedName -> B.ByteString-hashDN_old = shorten . MD5.hash . encodeASN1' DER . flip toASN1 []+hashDN_old = shorten . hashWith MD5 . encodeASN1' DER . flip toASN1 [] -shorten :: B.ByteString -> B.ByteString+shorten :: Digest a -> B.ByteString shorten b = B.pack $ map i [3,2,1,0]- where i n = B.index b n+ where i n = BA.index b n
Data/X509/AlgorithmIdentifier.hs view
@@ -28,24 +28,36 @@ -- | 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_ECDSA -- ^ ECDSA 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+-- | 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_DSA = [1,2,840,10040,4,1]- getObjectID PubKeyALG_ECDSA = [1,2,840,10045,2,1]- getObjectID PubKeyALG_DH = [1,2,840,10046,2,1]+ getObjectID PubKeyALG_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) ]@@ -55,11 +67,22 @@ , ([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,3,1], SignatureALG HashSHA224 PubKeyALG_ECDSA)- , ([1,2,840,10045,4,3,2], SignatureALG HashSHA256 PubKeyALG_ECDSA)- , ([1,2,840,10045,4,3,3], SignatureALG HashSHA384 PubKeyALG_ECDSA)- , ([1,2,840,10045,4,3,4], SignatureALG HashSHA512 PubKeyALG_ECDSA)+ , ([1,2,840,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@@ -69,11 +92,29 @@ 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)+ case oidSig oid of+ SignatureALG_IntrinsicHash _ ->+ Left "fromASN1: X509.SignatureALG: EdDSA requires absent parameter"+ signatureAlg -> Right (signatureAlg, 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@(SignatureALG_IntrinsicHash _) = \xs -> Start Sequence:OID (sigOID signatureAlg):End Sequence:xs toASN1 signatureAlg = \xs -> Start Sequence:OID (sigOID signatureAlg):Null:End Sequence:xs
Data/X509/CRL.hs view
@@ -17,9 +17,8 @@ ) where import Control.Applicative-import Control.Monad.Error -import Data.Time.Clock (UTCTime)+import Data.Hourglass (DateTime, TimezoneOffset(..)) import Data.ASN1.Types import Data.X509.DistinguishedName@@ -32,8 +31,8 @@ { crlVersion :: Integer , crlSignatureAlg :: SignatureALG , crlIssuer :: DistinguishedName- , crlThisUpdate :: UTCTime- , crlNextUpdate :: Maybe UTCTime+ , crlThisUpdate :: DateTime+ , crlNextUpdate :: Maybe DateTime , crlRevokedCertificates :: [RevokedCertificate] , crlExtensions :: Extensions } deriving (Show,Eq)@@ -41,7 +40,7 @@ -- | Describe a revoked certificate identifiable by serial number. data RevokedCertificate = RevokedCertificate { revokedSerialNumber :: Integer- , revokedDate :: UTCTime+ , revokedDate :: DateTime , revokedExtensions :: Extensions } deriving (Show,Eq) @@ -49,14 +48,30 @@ toASN1 crl = encodeCRL crl fromASN1 = runParseASN1State parseCRL --- TODO support extension instance ASN1Object RevokedCertificate where- fromASN1 (Start Sequence : IntVal serial : ASN1Time _ t _ : End Sequence : xs) =- Right (RevokedCertificate serial t (Extensions Nothing), xs)- fromASN1 l = Left ("fromASN1: X509.RevokedCertificate: unknown format:" ++ show l)- toASN1 (RevokedCertificate serial time _) = \xs ->- Start Sequence : IntVal serial : ASN1Time TimeGeneralized time Nothing : End Sequence : xs+ fromASN1 = runParseASN1State $+ onNextContainer Sequence $+ RevokedCertificate+ <$> parseSerialNumber+ <*> (getNext >>= toTime)+ <*> getObject+ where toTime (ASN1Time _ t _) = pure t+ toTime _ = throwParseError "bad revocation date"+ toASN1 (RevokedCertificate serial time crlEntryExtensions) = \xs ->+ [ Start Sequence ] +++ [ IntVal serial ] +++ [ ASN1Time TimeGeneralized time (Just (TimezoneOffset 0)) ] +++ toASN1 crlEntryExtensions [] +++ [ End Sequence ] +++ xs +parseSerialNumber :: ParseASN1 Integer+parseSerialNumber = do+ n <- getNext+ case n of+ IntVal v -> return v+ _ -> throwParseError ("missing serial" ++ show n)+ parseCRL :: ParseASN1 CRL parseCRL = do CRL <$> (getNext >>= getVersion)@@ -64,32 +79,41 @@ <*> getObject <*> (getNext >>= getThisUpdate) <*> getNextUpdate- <*> getRevokedCertificates- <*> getObject+ <*> parseRevokedCertificates+ <*> parseCRLExtensions where getVersion (IntVal v) = return $ fromIntegral v- getVersion _ = throwError "unexpected type for version"+ getVersion _ = throwParseError "unexpected type for version" getThisUpdate (ASN1Time _ t1 _) = return t1- getThisUpdate _ = throwError "bad this update format, expecting time"+ getThisUpdate _ = throwParseError "bad this update format, expecting time" getNextUpdate = getNextMaybe timeOrNothing timeOrNothing (ASN1Time _ tnext _) = Just tnext timeOrNothing _ = Nothing - getRevokedCertificates = onNextContainer Sequence $ getMany getObject+parseRevokedCertificates :: ParseASN1 [RevokedCertificate]+parseRevokedCertificates =+ fmap (maybe [] id) $ onNextContainerMaybe Sequence $ getMany getObject +parseCRLExtensions :: ParseASN1 Extensions+parseCRLExtensions =+ fmap adapt $ onNextContainerMaybe (Container Context 0) $ getObject+ where adapt (Just e) = e+ adapt Nothing = Extensions Nothing+ encodeCRL :: CRL -> ASN1S encodeCRL crl xs = [IntVal $ crlVersion crl] ++ toASN1 (crlSignatureAlg crl) [] ++ toASN1 (crlIssuer crl) [] ++- [ASN1Time TimeGeneralized (crlThisUpdate crl) Nothing] ++- (maybe [] (\t -> [ASN1Time TimeGeneralized t Nothing]) (crlNextUpdate crl)) ++- [Start Sequence] ++- revoked ++- [End Sequence] ++- toASN1 (crlExtensions crl) [] +++ [ASN1Time TimeGeneralized (crlThisUpdate crl) (Just (TimezoneOffset 0))] +++ (maybe [] (\t -> [ASN1Time TimeGeneralized t (Just (TimezoneOffset 0))]) (crlNextUpdate crl)) +++ maybeRevoked (crlRevokedCertificates crl) +++ maybeCrlExts (crlExtensions crl) ++ xs where- revoked = concatMap (\e -> toASN1 e []) (crlRevokedCertificates crl)+ maybeRevoked [] = []+ maybeRevoked xs' = asn1Container Sequence $ concatMap (\e -> toASN1 e []) xs'+ maybeCrlExts (Extensions Nothing) = []+ maybeCrlExts exts = asn1Container (Container Context 0) $ toASN1 exts []
Data/X509/Cert.hs view
@@ -12,14 +12,13 @@ module Data.X509.Cert (Certificate(..)) where import Data.ASN1.Types-import Data.Time.Clock (UTCTime) import Control.Applicative ((<$>), (<*>))-import Control.Monad.Error import Data.X509.Internal import Data.X509.PublicKey import Data.X509.AlgorithmIdentifier import Data.X509.DistinguishedName import Data.X509.ExtensionRaw+import Data.Hourglass data CertKeyUsage = CertKeyUsageDigitalSignature@@ -42,7 +41,7 @@ , certSerial :: Integer -- ^ Serial number , certSignatureAlg :: SignatureALG -- ^ Signature algorithm , certIssuerDN :: DistinguishedName -- ^ Issuer DN- , certValidity :: (UTCTime, UTCTime) -- ^ Validity period+ , certValidity :: (DateTime, DateTime) -- ^ Validity period (UTC) , certSubjectDN :: DistinguishedName -- ^ Subject DN , certPubKey :: PubKey -- ^ Public key , certExtensions :: Extensions -- ^ Extensions@@ -54,21 +53,21 @@ parseCertHeaderVersion :: ParseASN1 Int parseCertHeaderVersion =- maybe 1 id <$> onNextContainerMaybe (Container Context 0) (getNext >>= getVer)+ maybe 0 id <$> onNextContainerMaybe (Container Context 0) (getNext >>= getVer) where getVer (IntVal v) = return $ fromIntegral v- getVer _ = throwError "unexpected type for version"+ getVer _ = throwParseError "unexpected type for version" parseCertHeaderSerial :: ParseASN1 Integer parseCertHeaderSerial = do n <- getNext case n of IntVal v -> return v- _ -> throwError ("missing serial" ++ show n)+ _ -> throwParseError ("missing serial" ++ show n) -parseCertHeaderValidity :: ParseASN1 (UTCTime, UTCTime)+parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime) parseCertHeaderValidity = getNextContainer Sequence >>= toTimeBound where toTimeBound [ ASN1Time _ t1 _, ASN1Time _ t2 _ ] = return (t1,t2)- toTimeBound _ = throwError "bad validity format"+ toTimeBound _ = throwParseError "bad validity format" {- | parse header structure of a x509 certificate. the structure is the following: Version@@ -86,6 +85,12 @@ Subject Unique Identifier (Optional) (>= 2) Extensions (Optional) (>= v3) -}++parseExtensions :: ParseASN1 Extensions+parseExtensions = fmap adapt $ onNextContainerMaybe (Container Context 3) $ getObject+ where adapt (Just e) = e+ adapt Nothing = Extensions Nothing+ parseCertificate :: ParseASN1 Certificate parseCertificate = Certificate <$> parseCertHeaderVersion@@ -95,7 +100,7 @@ <*> parseCertHeaderValidity <*> getObject <*> getObject- <*> getObject+ <*> parseExtensions encodeCertificateHeader :: Certificate -> [ASN1] encodeCertificateHeader cert =@@ -105,8 +110,14 @@ eAlgId = toASN1 (certSignatureAlg cert) [] eIssuer = toASN1 (certIssuerDN cert) [] (t1, t2) = certValidity cert- eValidity = asn1Container Sequence [ASN1Time TimeGeneralized t1 Nothing- ,ASN1Time TimeGeneralized t2 Nothing]+ 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) []+ eexts = case certExtensions cert of+ Extensions Nothing -> []+ exts -> asn1Container (Container Context 3) $ toASN1 exts []+ timeType t =+ if t >= timeConvert (Date 2050 January 1)+ then TimeGeneralized+ else TimeUTC
Data/X509/DistinguishedName.hs view
@@ -6,6 +6,8 @@ -- Portability : unknown -- -- X.509 Distinguished names types and functions++{-# LANGUAGE CPP #-} module Data.X509.DistinguishedName ( DistinguishedName(..) , DistinguishedNameInner(..)@@ -16,10 +18,13 @@ ) where import Control.Applicative-import Data.Monoid+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup+#else+import Data.Monoid+#endif import Data.ASN1.Types import Data.X509.Internal-import Control.Monad.Error -- | A list of OID and strings. newtype DistinguishedName = DistinguishedName { getDistinguishedElements :: [(OID, ASN1CharacterString)] }@@ -31,6 +36,7 @@ | DnCountry -- ^ Country | DnOrganization -- ^ O | DnOrganizationUnit -- ^ OU+ | DnEmailAddress -- ^ Email Address (legacy) deriving (Show,Eq) instance OIDable DnElement where@@ -38,6 +44,7 @@ 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@@ -48,9 +55,16 @@ 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@@ -73,7 +87,7 @@ s <- getNextContainer Sequence case s of [OID oid, ASN1String cs] -> return (oid, cs)- _ -> throwError ("expecting [OID,String] got " ++ show s)+ _ -> throwParseError ("expecting [OID,String] got " ++ show s) encodeDNinner :: DistinguishedName -> [ASN1] encodeDNinner (DistinguishedName dn) = concatMap dnSet dn
+ Data/X509/EC.hs view
@@ -0,0 +1,126 @@+-- |+-- Module : Data.X509.EC+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- 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
Data/X509/Ext.hs view
@@ -8,7 +8,7 @@ -- extension processing module. -- {-# LANGUAGE FlexibleContexts #-}-+{-# LANGUAGE ScopedTypeVariables #-} module Data.X509.Ext ( Extension(..) -- * Common extension usually found in x509v3@@ -21,6 +21,7 @@ , ExtSubjectAltName(..) , ExtAuthorityKeyId(..) , ExtCrlDistributionPoints(..)+ , ExtNetscapeComment(..) , AltName(..) , DistributionPoint(..) , ReasonFlag(..)@@ -35,12 +36,15 @@ 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.Error+import Control.Monad -- | key usage flag that is found in the key usage extension field. data ExtKeyUsageFlag =@@ -66,11 +70,24 @@ -- -- 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- extEncode :: a -> [ASN1]- extDecode :: [ASN1] -> Either String a+ 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@@ -95,16 +112,17 @@ -- * 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+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 :: Extension a => Bool -> a -> ExtensionRaw-extensionEncode critical ext = ExtensionRaw (extOID ext) critical (extEncode ext)+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)@@ -112,6 +130,7 @@ 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] @@ -128,6 +147,7 @@ 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"@@ -159,6 +179,7 @@ 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@@ -175,6 +196,7 @@ 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"@@ -204,6 +226,7 @@ instance Extension ExtSubjectAltName where extOID = const [2,5,29,17]+ extHasNestedASN1 = const True extEncode (ExtSubjectAltName names) = encodeGeneralNames names extDecode l = runParseASN1 (ExtSubjectAltName <$> parseGeneralNames) l @@ -214,6 +237,7 @@ 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] =@@ -245,6 +269,7 @@ instance Extension ExtCrlDistributionPoints where extOID _ = [2,5,29,31]+ extHasNestedASN1 = const True extEncode = error "extEncode ExtCrlDistributionPoints unimplemented" extDecode = error "extDecode ExtCrlDistributionPoints unimplemented" --extEncode (ExtCrlDistributionPoints )@@ -265,19 +290,19 @@ case c of Just [ASN1String cs] -> case asn1CharacterToString cs of- Nothing -> throwError ("GeneralNames: invalid string for XMPP Addr")+ Nothing -> throwParseError ("GeneralNames: invalid string for XMPP Addr") Just s -> return $ AltNameXMPP s- _ -> throwError ("GeneralNames: expecting string for XMPP Addr got: " ++ show c)+ _ -> 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 -> throwError ("GeneralNames: invalid string for DNSSrv Addr")+ Nothing -> throwParseError ("GeneralNames: invalid string for DNSSrv Addr") Just s -> return $ AltNameDNSSRV s- _ -> throwError ("GeneralNames: expecting string for DNSSRV Addr got: " ++ show c)- OID unknown -> throwError ("GeneralNames: unknown OID " ++ show unknown)- _ -> throwError ("GeneralNames: expecting OID but got " ++ show n)+ _ -> 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@@ -286,7 +311,7 @@ (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- _ -> throwError ("GeneralNames: not coping with unknown stream " ++ show n)+ _ -> throwParseError ("GeneralNames: not coping with unknown stream " ++ show n) encodeGeneralNames :: [AltName] -> [ASN1] encodeGeneralNames names =@@ -312,3 +337,14 @@ 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
Data/X509/ExtensionRaw.hs view
@@ -9,6 +9,8 @@ -- module Data.X509.ExtensionRaw ( ExtensionRaw(..)+ , tryExtRawASN1+ , extRawASN1 , Extensions(..) ) where @@ -17,14 +19,25 @@ 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- , extRawASN1 :: [ASN1] -- ^ the associated ASN1+ , 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)@@ -32,28 +45,20 @@ instance ASN1Object Extensions where toASN1 (Extensions Nothing) = \xs -> xs toASN1 (Extensions (Just exts)) = \xs ->- asn1Container (Container Context 3) (asn1Container Sequence (concatMap encodeExt exts)) ++ xs+ asn1Container Sequence (concatMap encodeExt exts) ++ xs fromASN1 s = runParseASN1State (Extensions <$> parseExtensions) s- where parseExtensions = onNextContainerMaybe (Container Context 3) $- onNextContainer Sequence (getMany getObject)+ where parseExtensions = onNextContainerMaybe 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+ 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)- 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])+encodeExt (ExtensionRaw oid critical content) =+ asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString content])
Data/X509/Internal.hs view
@@ -9,10 +9,18 @@ ( module Data.ASN1.Parse , asn1Container , OID+ -- * error handling+ , ErrT+ , runErrT ) where import Data.ASN1.Types import Data.ASN1.Parse+import Control.Monad.Trans.Except++runErrT :: ExceptT e m a -> m (Either e a)+runErrT = runExceptT+type ErrT = ExceptT -- | create a container around the stream of ASN1 asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1]
+ Data/X509/OID.hs view
@@ -0,0 +1,63 @@+-- |+-- Module : Data.X509.OID+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- 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])+ ]
Data/X509/PrivateKey.hs view
@@ -5,24 +5,288 @@ -- Stability : experimental -- Portability : unknown ----- Public key handling in X.509 infrastructure+-- 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 qualified Crypto.Types.PubKey.RSA as RSA-import qualified Crypto.Types.PubKey.DSA as DSA+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) --- | Convert a Public key to the Public Key Algorithm type+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
Data/X509/PublicKey.hs view
@@ -9,6 +9,8 @@ -- module Data.X509.PublicKey ( PubKey(..)+ , PubKeyEC(..)+ , SerializedPoint(..) , pubkeyToAlg ) where @@ -17,23 +19,63 @@ 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 qualified Crypto.Types.PubKey.RSA as RSA-import qualified Crypto.Types.PubKey.DSA as DSA-import qualified Crypto.Types.PubKey.ECC as ECC+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.Basic (numBytes)+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))- | PubKeyECDSA ECC.CurveName B.ByteString+ | 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) @@ -48,7 +90,7 @@ 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 . fromASN1)+ 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@@ -64,14 +106,60 @@ _ -> Left "fromASN1: X509.PubKey: unknown DSA format" ) _ -> Left "fromASN1: X509.PubKey: unknown DSA format"- | pkalg == getObjectID PubKeyALG_ECDSA =+ | pkalg == getObjectID PubKeyALG_EC = case xs of OID curveOid:End Sequence:BitString bits:End Sequence:xs2 ->- case fromObjectID curveOid of- Just curveName -> Right (PubKeyECDSA curveName (bitArrayGetData bits), xs2)- Nothing -> Left ("fromASN1: X509.Pubkey: ECDSA unknown curve " ++ show curveOid)- _ -> Left "fromASN1: X509.PubKey: unknown ECDSA format"- | otherwise = error ("unknown public key OID: " ++ show pkalg)+ 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)@@ -80,9 +168,15 @@ Right (r, xsinner) -> Right (r, xsinner ++ xs2) toPubKeyRSA = either Left (\(rsaKey, r) -> Right (PubKeyRSA rsaKey, r)) - removeNull (Null:xs) = xs- removeNull l = l+ 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 @@ -91,7 +185,11 @@ pubkeyToAlg (PubKeyRSA _) = PubKeyALG_RSA pubkeyToAlg (PubKeyDSA _) = PubKeyALG_DSA pubkeyToAlg (PubKeyDH _) = PubKeyALG_DH-pubkeyToAlg (PubKeyECDSA _ _) = PubKeyALG_ECDSA+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]@@ -100,7 +198,7 @@ pkalg = OID $ getObjectID $ pubkeyToAlg key encodeInner (PubKeyRSA pubkey) = asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0]- where bits = encodeASN1' DER $ asn1Container Sequence [IntVal (RSA.public_n pubkey), IntVal (RSA.public_e pubkey)]+ where bits = encodeASN1' DER $ rsaPubToASN1 pubkey [] encodeInner (PubKeyDSA pubkey) = asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0] where@@ -109,12 +207,73 @@ ,IntVal (DSA.params_g params)] params = DSA.public_params pubkey bits = encodeASN1' DER [IntVal $ DSA.public_y pubkey]- encodeInner (PubKeyECDSA curveName bits) =+ 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)+ 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 = numBytes modulus+ , RSA.public_n = modulus+ , RSA.public_e = pubexp+ }+ -- 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)
Data/X509/Signed.hs view
@@ -35,6 +35,7 @@ , decodeSignedObject -- * Object to Signed and SignedExact , objectToSignedExact+ , objectToSignedExactF , objectToSigned , signedToExact ) where@@ -93,21 +94,34 @@ => (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- : []))+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 [])- (sigBits,sigAlg,r) = signatureFunction objRaw -- | Transform an object into a 'Signed' object. --
Tests/Tests.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Main where -import Test.Framework (defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)--import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck import qualified Data.ByteString as B @@ -14,11 +12,15 @@ import Data.List (nub, sort) import Data.ASN1.Types import Data.X509-import qualified Crypto.Types.PubKey.RSA as RSA-import qualified Crypto.Types.PubKey.DSA as DSA+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.Time.Clock-import Data.Time.Clock.POSIX+import Data.Hourglass instance Arbitrary RSA.PublicKey where arbitrary = do@@ -36,18 +38,69 @@ 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_ECDSA,PubKeyALG_DH]+ 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,@@ -59,11 +112,17 @@ , 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_ECDSA- , SignatureALG HashSHA256 PubKeyALG_ECDSA- , SignatureALG HashSHA384 PubKeyALG_ECDSA- , SignatureALG HashSHA512 PubKeyALG_ECDSA+ , 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)@@ -78,8 +137,10 @@ arbitrary = DistinguishedName <$> (choose (1,5) >>= \l -> replicateM l arbitraryDE) where arbitraryDE = (,) <$> arbitrary <*> arbitrary -instance Arbitrary UTCTime where- arbitrary = posixSecondsToUTCTime . fromIntegral <$> (arbitrary :: Gen Int)+instance Arbitrary DateTime where+ arbitrary = timeConvert <$> (arbitrary :: Gen Elapsed)+instance Arbitrary Elapsed where+ arbitrary = Elapsed . Seconds <$> (choose (1, 100000000)) instance Arbitrary Extensions where arbitrary = Extensions <$> oneof@@ -118,7 +179,7 @@ instance Arbitrary RevokedCertificate where arbitrary = RevokedCertificate <$> arbitrary <*> arbitrary- <*> pure (Extensions Nothing)+ <*> arbitrary instance Arbitrary CRL where arbitrary = CRL <$> pure 1@@ -146,9 +207,10 @@ Right v | v == e -> True | otherwise -> error ("expected " ++ show e ++ " got: " ++ show v) -main = defaultMain+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)
x509.cabal view
@@ -1,6 +1,6 @@ Name: x509-Version: 1.4.13-Description: X509 reader and writer+version: 1.7.7+Description: X509 reader and writer. please see README License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez <vincent@snarc.org>@@ -11,24 +11,24 @@ Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate-Cabal-Version: >=1.8+Cabal-Version: >= 1.10+Extra-Source-Files: ChangeLog.md Library- Build-Depends: base >= 3 && < 5+ Default-Language: Haskell2010+ Build-Depends: base >= 4.7 && < 5 , bytestring- , mtl+ , memory+ , transformers >= 0.4 , containers- , directory- , filepath- , process- , time- , pem >= 0.1 && < 0.3- , asn1-types >= 0.2.3 && < 0.3- , asn1-encoding >= 0.8 && < 0.9- , asn1-parse >= 0.8 && < 0.9- , crypto-pubkey-types >= 0.4.2.1 && < 0.5- , cryptohash >= 0.9 && < 0.12+ , 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@@ -39,25 +39,24 @@ 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- , QuickCheck >= 2- , HUnit- , test-framework- , test-framework-quickcheck2- , test-framework-hunit- , time+ , tasty+ , tasty-quickcheck+ , hourglass , asn1-types , x509- , crypto-pubkey-types+ , cryptonite ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures source-repository head