diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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) + diff --git a/Data/X509.hs b/Data/X509.hs --- a/Data/X509.hs +++ b/Data/X509.hs @@ -19,6 +19,7 @@ , PubKeyEC(..) , SerializedPoint(..) , PrivKey(..) + , PrivKeyEC(..) , pubkeyToAlg , privkeyToAlg , module Data.X509.AlgorithmIdentifier diff --git a/Data/X509/AlgorithmIdentifier.hs b/Data/X509/AlgorithmIdentifier.hs --- a/Data/X509/AlgorithmIdentifier.hs +++ b/Data/X509/AlgorithmIdentifier.hs @@ -31,14 +31,20 @@ | 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 +-- | 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) @@ -47,6 +53,10 @@ 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 @@ -71,6 +81,8 @@ , ([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 @@ -90,13 +102,19 @@ 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@(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 _ _) = \xs -> Start Sequence:OID (sigOID signatureAlg):Null:End Sequence:xs 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 diff --git a/Data/X509/CRL.hs b/Data/X509/CRL.hs --- a/Data/X509/CRL.hs +++ b/Data/X509/CRL.hs @@ -48,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 (Just (TimezoneOffset 0)) : 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) @@ -63,8 +79,8 @@ <*> getObject <*> (getNext >>= getThisUpdate) <*> getNextUpdate - <*> getRevokedCertificates - <*> getObject + <*> parseRevokedCertificates + <*> parseCRLExtensions where getVersion (IntVal v) = return $ fromIntegral v getVersion _ = throwParseError "unexpected type for version" @@ -76,8 +92,16 @@ 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] ++ @@ -85,10 +109,11 @@ 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) [] ++ + 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 [] diff --git a/Data/X509/Cert.hs b/Data/X509/Cert.hs --- a/Data/X509/Cert.hs +++ b/Data/X509/Cert.hs @@ -53,7 +53,7 @@ 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 _ = throwParseError "unexpected type for version" @@ -85,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 @@ -94,7 +100,7 @@ <*> parseCertHeaderValidity <*> getObject <*> getObject - <*> getObject + <*> parseExtensions encodeCertificateHeader :: Certificate -> [ASN1] encodeCertificateHeader cert = @@ -108,7 +114,9 @@ ,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 diff --git a/Data/X509/DistinguishedName.hs b/Data/X509/DistinguishedName.hs --- a/Data/X509/DistinguishedName.hs +++ b/Data/X509/DistinguishedName.hs @@ -6,6 +6,8 @@ -- Portability : unknown -- -- X.509 Distinguished names types and functions + +{-# LANGUAGE CPP #-} module Data.X509.DistinguishedName ( DistinguishedName(..) , DistinguishedNameInner(..) @@ -16,7 +18,11 @@ ) 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 @@ -49,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 diff --git a/Data/X509/EC.hs b/Data/X509/EC.hs new file mode 100644 --- /dev/null +++ b/Data/X509/EC.hs @@ -0,0 +1,126 @@ +-- | +-- 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 diff --git a/Data/X509/Ext.hs b/Data/X509/Ext.hs --- a/Data/X509/Ext.hs +++ b/Data/X509/Ext.hs @@ -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,11 +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 -- | key usage flag that is found in the key usage extension field. data ExtKeyUsageFlag = @@ -65,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 @@ -94,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) @@ -111,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] @@ -127,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" @@ -158,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 @@ -174,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" @@ -203,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 @@ -213,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] = @@ -244,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 ) @@ -311,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 diff --git a/Data/X509/ExtensionRaw.hs b/Data/X509/ExtensionRaw.hs --- a/Data/X509/ExtensionRaw.hs +++ b/Data/X509/ExtensionRaw.hs @@ -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]) diff --git a/Data/X509/Internal.hs b/Data/X509/Internal.hs --- a/Data/X509/Internal.hs +++ b/Data/X509/Internal.hs @@ -5,7 +5,6 @@ -- Stability : experimental -- Portability : unknown -- -{-# LANGUAGE CPP #-} module Data.X509.Internal ( module Data.ASN1.Parse , asn1Container @@ -17,18 +16,11 @@ import Data.ASN1.Types import Data.ASN1.Parse +import Control.Monad.Trans.Except -#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] diff --git a/Data/X509/PrivateKey.hs b/Data/X509/PrivateKey.hs --- a/Data/X509/PrivateKey.hs +++ b/Data/X509/PrivateKey.hs @@ -5,25 +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 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 diff --git a/Data/X509/PublicKey.hs b/Data/X509/PublicKey.hs --- a/Data/X509/PublicKey.hs +++ b/Data/X509/PublicKey.hs @@ -20,15 +20,22 @@ 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.Basic (numBytes) import Crypto.Number.Serialize (os2ip) import Data.Word @@ -65,6 +72,10 @@ | 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) @@ -132,6 +143,22 @@ }, 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 @@ -146,6 +173,10 @@ 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 @@ -155,6 +186,10 @@ 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] @@ -180,6 +215,14 @@ _ -> 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] @@ -192,11 +235,10 @@ rsaPubFromASN1 (Start Sequence:IntVal smodulus:IntVal pubexp:End Sequence:xs) = Right (pub, xs) where - pub = RSA.PublicKey { RSA.public_size = calculate_modulus modulus 1 + pub = RSA.PublicKey { RSA.public_size = numBytes modulus , 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 diff --git a/Tests/Tests.hs b/Tests/Tests.hs --- a/Tests/Tests.hs +++ b/Tests/Tests.hs @@ -12,6 +12,11 @@ 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 @@ -33,13 +38,64 @@ 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] @@ -65,6 +121,8 @@ , 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) @@ -121,7 +179,7 @@ instance Arbitrary RevokedCertificate where arbitrary = RevokedCertificate <$> arbitrary <*> arbitrary - <*> pure (Extensions Nothing) + <*> arbitrary instance Arbitrary CRL where arbitrary = CRL <$> pure 1 @@ -152,6 +210,7 @@ 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) diff --git a/x509.cabal b/x509.cabal --- a/x509.cabal +++ b/x509.cabal @@ -1,6 +1,6 @@ Name: x509 -Version: 1.6.5 -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 @@ -11,21 +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 , memory - , mtl + , transformers >= 0.4 , containers , hourglass - , pem >= 0.1 && < 0.3 + , pem >= 0.1 , asn1-types >= 0.3.1 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 , asn1-parse >= 0.9.3 && < 0.10 - , cryptonite + , cryptonite >= 0.24 Exposed-modules: Data.X509 + Data.X509.EC Other-modules: Data.X509.Internal Data.X509.CertificateChain Data.X509.AlgorithmIdentifier @@ -41,6 +44,7 @@ ghc-options: -Wall Test-Suite test-x509 + Default-Language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: Tests Main-is: Tests.hs