diff --git a/Codec/Encryption/OpenPGP/Arbitrary.hs b/Codec/Encryption/OpenPGP/Arbitrary.hs --- a/Codec/Encryption/OpenPGP/Arbitrary.hs +++ b/Codec/Encryption/OpenPGP/Arbitrary.hs @@ -61,7 +61,7 @@ return (SigSubPacket crit pl) instance Arbitrary SigSubPacketPayload where - arbitrary = oneof [sct, set, ec, ts, re, ket, psa, rk, i, nd, phas, pcas, ksps, pks, puid, purl, kfs, suid, rfr, fs, st {-, es -}, udss, oss] + arbitrary = oneof [sct, set, ec, ts, re, ket, psa, rk, i, nd, phas, pcas, ksps, pks, puid, purl, kfs, suid, rfr, fs, st {-, es -}, udss, oss, ifp] where sct = fmap SigCreationTime arbitrary set = fmap SigExpirationTime arbitrary @@ -85,13 +85,14 @@ fs = fmap Features arbitrary st = arbitrary >>= \pka -> arbitrary >>= \ha -> arbitrary >>= \sh -> return (SignatureTarget pka ha sh) es = fmap EmbeddedSignature arbitrary -- FIXME: figure out why EmbeddedSignature fails to serialize properly + ifp = choose (4,5) >>= \v -> fmap (IssuerFingerprint v) (if v == 4 then arbitrary else fmap (TwentyOctetFingerprint . BL.pack) (vector 32)) udss = choose (100,110) >>= \a -> arbitrary >>= \b -> return (UserDefinedSigSub a b) oss = choose (111,127) >>= \a -> arbitrary >>= \b -> return (OtherSigSub a b) -- FIXME: more comprehensive range -- instance Arbitrary PubKeyAlgorithm where - arbitrary = elements [RSA, DSA, ECDH, ECDSA, DH] + arbitrary = elements [RSA, DSA, ECDH, ECDSA, DH, EdDSA] instance Arbitrary EightOctetKeyId where arbitrary = fmap (EightOctetKeyId . BL.pack) (vector 8) diff --git a/Codec/Encryption/OpenPGP/Internal.hs b/Codec/Encryption/OpenPGP/Internal.hs --- a/Codec/Encryption/OpenPGP/Internal.hs +++ b/Codec/Encryption/OpenPGP/Internal.hs @@ -1,5 +1,5 @@ -- Internal.hs: private utility functions and such --- Copyright © 2012-2016 Clint Adams +-- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -19,6 +19,10 @@ , curveoidBSToCurve , curveToCurveoidBS , point2BS + , curveoidBSToEdSigningCurve + , edSigningCurveToCurveoidBS + , curve2Curve + , curveFromCurve ) where import Crypto.Number.Serialize (i2osp, os2ip) @@ -32,7 +36,6 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.List (find) -import Data.Maybe (fromJust) import Data.Word (Word8, Word16) import Codec.Encryption.OpenPGP.Types @@ -72,8 +75,10 @@ where pkParams f = MPI . f . DSA.public_params $ k pubkeyToMPIs (ElGamalPubKey p g y) = [MPI p, MPI g, MPI y] -pubkeyToMPIs (ECDHPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q)) _ _) = [MPI (os2ip (point2BS q))] -pubkeyToMPIs (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q))) = [MPI (os2ip (point2BS q))] +pubkeyToMPIs (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q))) _ _) = [MPI (os2ip (point2BS q))] +pubkeyToMPIs (ECDHPubKey (EdDSAPubKey _ (EPoint x)) _ _) = [MPI x] +pubkeyToMPIs (ECDSAPubKey ((ECDSA_PublicKey (ECDSA.PublicKey _ q)))) = [MPI (os2ip (point2BS q))] +pubkeyToMPIs (EdDSAPubKey _ (EPoint x)) = [MPI x] multiplicativeInverse :: Integral a => a -> a -> a multiplicativeInverse _ 1 = 1 @@ -100,22 +105,40 @@ sigCT (SigV4 _ _ _ hsubs _ _ _) = fmap (\(SigSubPacket _ (SigCreationTime i)) -> i) (find isSigCreationTime hsubs) sigCT _ = Nothing -curveoidBSToCurve :: B.ByteString -> Either String ECCT.Curve +curveoidBSToCurve :: B.ByteString -> Either String ECCCurve curveoidBSToCurve oidbs - | B.pack [0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07] == oidbs = Right $ ECCT.getCurveByName ECCT.SEC_p256r1 - | B.pack [0x2B,0x81,0x04,0x00,0x22] == oidbs = Right $ ECCT.getCurveByName ECCT.SEC_p384r1 - | B.pack [0x2B,0x81,0x04,0x00,0x23] == oidbs = Right $ ECCT.getCurveByName ECCT.SEC_p521r1 - | otherwise = Left "unknown curve OID" - --- [0x2B 0x06 0x01 0x04 0x01 0xDA 0x47 0x0F 0x01] -- ed25519 + | B.pack [0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07] == oidbs = Right $ NISTP256 -- ECCT.getCurveByName ECCT.SEC_p256r1 + | B.pack [0x2B,0x81,0x04,0x00,0x22] == oidbs = Right $ NISTP384 -- ECCT.getCurveByName ECCT.SEC_p384r1 + | B.pack [0x2B,0x81,0x04,0x00,0x23] == oidbs = Right $ NISTP521 -- ECCT.getCurveByName ECCT.SEC_p521r1 + | B.pack [0x2B,0x06,0x01,0x04,0x01,0x97,0x55,0x01,0x05,0x01] == oidbs = Right Curve25519 + | otherwise = Left $ concat ["unknown curve (...", show (B.unpack oidbs) ,")"] -curveToCurveoidBS :: ECCT.Curve -> Either String B.ByteString -curveToCurveoidBS curve - | curve == ECCT.getCurveByName ECCT.SEC_p256r1 = Right $ B.pack [0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07] - | curve == ECCT.getCurveByName ECCT.SEC_p384r1 = Right $ B.pack [0x2B,0x81,0x04,0x00,0x22] - | curve == ECCT.getCurveByName ECCT.SEC_p521r1 = Right $ B.pack [0x2B,0x81,0x04,0x00,0x23] - | otherwise = Left "unknown curve" +curveToCurveoidBS :: ECCCurve -> Either String B.ByteString +curveToCurveoidBS NISTP256 = Right $ B.pack [0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07] +curveToCurveoidBS NISTP384 = Right $ B.pack [0x2B,0x81,0x04,0x00,0x22] +curveToCurveoidBS NISTP521 = Right $ B.pack [0x2B,0x81,0x04,0x00,0x23] +curveToCurveoidBS Curve25519 = Right $ B.pack [0x2B,0x06,0x01,0x04,0x01,0x97,0x55,0x01,0x05,0x01] +curveToCurveoidBS _ = Left "unknown curve" point2BS :: ECCT.PublicPoint -> B.ByteString point2BS (ECCT.Point x y) = B.concat [B.singleton 0x04, i2osp x, i2osp y] -- FIXME: check for length equality? point2BS ECCT.PointO = error "FIXME: point at infinity" + +curveoidBSToEdSigningCurve :: B.ByteString -> Either String EdSigningCurve +curveoidBSToEdSigningCurve oidbs + | B.pack [0x2B,0x06,0x01,0x04,0x01,0xDA,0x47,0x0F,0x01] == oidbs = Right Ed25519 + | otherwise = Left $ concat ["unknown Edwards signing curve (...", show (B.unpack oidbs) ,")"] + +edSigningCurveToCurveoidBS :: EdSigningCurve -> Either String B.ByteString +edSigningCurveToCurveoidBS Ed25519 = Right $ B.pack [0x2B,0x06,0x01,0x04,0x01,0xDA,0x47,0x0F,0x01] + +curve2Curve :: ECCCurve -> ECCT.Curve +curve2Curve NISTP256 = ECCT.getCurveByName ECCT.SEC_p256r1 +curve2Curve NISTP384 = ECCT.getCurveByName ECCT.SEC_p384r1 +curve2Curve NISTP521 = ECCT.getCurveByName ECCT.SEC_p521r1 + +curveFromCurve :: ECCT.Curve -> ECCCurve +curveFromCurve c + | c == ECCT.getCurveByName ECCT.SEC_p256r1 = NISTP256 + | c == ECCT.getCurveByName ECCT.SEC_p384r1 = NISTP384 + | c == ECCT.getCurveByName ECCT.SEC_p521r1 = NISTP521 diff --git a/Codec/Encryption/OpenPGP/KeyInfo.hs b/Codec/Encryption/OpenPGP/KeyInfo.hs --- a/Codec/Encryption/OpenPGP/KeyInfo.hs +++ b/Codec/Encryption/OpenPGP/KeyInfo.hs @@ -1,5 +1,5 @@ -- KeyInfo.hs: OpenPGP (RFC4880) fingerprinting methods --- Copyright © 2012-2016 Clint Adams +-- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -22,7 +22,9 @@ pubkeySize (DSAPubKey (DSA_PublicKey x)) = Right (bitcount . DSA.params_p . DSA.public_params $ x) pubkeySize (ElGamalPubKey p _ _) = Right (bitcount p) pubkeySize (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) = Right (fromIntegral (ECCT.curveSizeBits curve)) -pubkeySize (ECDHPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) _ _) = Right (fromIntegral (ECCT.curveSizeBits curve)) +pubkeySize (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) _ _) = Right (fromIntegral (ECCT.curveSizeBits curve)) +pubkeySize (ECDHPubKey (EdDSAPubKey Ed25519 _) _ _) = Right 256 +pubkeySize (EdDSAPubKey Ed25519 _) = Right 256 pubkeySize x = Left $ "Unable to calculate size of " ++ show x bitcount :: Integer -> Int @@ -39,4 +41,5 @@ pkalgoAbbrev ECDSA = "E" pkalgoAbbrev ForbiddenElgamal = "f" pkalgoAbbrev DH = "d" +pkalgoAbbrev EdDSA = "w" pkalgoAbbrev (OtherPKA _) = "." diff --git a/Codec/Encryption/OpenPGP/Serialize.hs b/Codec/Encryption/OpenPGP/Serialize.hs --- a/Codec/Encryption/OpenPGP/Serialize.hs +++ b/Codec/Encryption/OpenPGP/Serialize.hs @@ -40,7 +40,7 @@ import Data.Maybe (fromMaybe) import Network.URI (nullURI, parseURI, uriToString) -import Codec.Encryption.OpenPGP.Internal (curveoidBSToCurve, curveToCurveoidBS, pubkeyToMPIs, multiplicativeInverse) +import Codec.Encryption.OpenPGP.Internal (curveoidBSToCurve, curveoidBSToEdSigningCurve, curveToCurveoidBS, edSigningCurveToCurveoidBS, pubkeyToMPIs, multiplicativeInverse, curve2Curve, curveFromCurve) import Codec.Encryption.OpenPGP.Types instance Binary SigSubPacket where @@ -264,6 +264,10 @@ | pt == 32 = do sp <- get :: Get SignaturePayload return $ SigSubPacket crit (EmbeddedSignature sp) + | pt == 33 = do + kv <- getWord8 + fp <- getLazyByteString (if kv == 4 then 20 else 32) + return $ SigSubPacket crit (IssuerFingerprint kv (TwentyOctetFingerprint fp)) | pt > 99 && pt < 111 = do payload <- getLazyByteString (l - 1) return $ SigSubPacket crit (UserDefinedSigSub pt payload) @@ -382,6 +386,12 @@ putSubPacketLength . fromIntegral $ (1 + BL.length spb) putSigSubPacketType crit 32 putLazyByteString spb +putSigSubPacket (SigSubPacket crit (IssuerFingerprint kv fp)) = do + let fpb = unTOF fp + putSubPacketLength . fromIntegral $ (2 + BL.length fpb) + putSigSubPacketType crit 33 + putWord8 kv + putLazyByteString fpb putSigSubPacket (SigSubPacket crit (UserDefinedSigSub ptype payload)) = putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) = do putSubPacketLength . fromIntegral $ (1 + BL.length payload) @@ -786,18 +796,26 @@ curvelength <- getWord8 -- FIXME: test for 0 or 0xFF as they are reserved curveoid <- getByteString (fromIntegral curvelength) MPI mpi <- getMPI -- FIXME: check length against curve type? - case curveoidBSToCurve curveoid >>= \c -> mpi2point c mpi of + case curveoidBSToCurve curveoid of Left e -> fail e - Right (curve, point) -> return . ECDSAPubKey . ECDSA_PublicKey . ECDSA.PublicKey curve $ point - where - mpi2point c cpi = fmap (\y -> (c,y)) (bs2Point (i2osp cpi)) + Right Curve25519 -> return $ EdDSAPubKey Ed25519 (EPoint mpi) + Right curve -> case bs2Point (i2osp mpi) of + Left e -> fail e + Right point -> return . ECDSAPubKey . ECDSA_PublicKey . ECDSA.PublicKey (curve2Curve curve) $ point getPubkey ECDH = do - ECDSAPubKey ed <- getPubkey ECDSA + ed <- getPubkey ECDSA -- could be an ECDSA or an EdDSA kdflen <- getWord8 -- FIXME: should be 3, test for 0 or 0xFF as they are reserved one <- getWord8 -- FIXME: should be 1 kdfHA <- get kdfSA <- get return $ ECDHPubKey ed kdfHA kdfSA +getPubkey EdDSA = do + curvelength <- getWord8 -- FIXME: test for 0 or 0xFF as they are reserved + curveoid <- getByteString (fromIntegral curvelength) + MPI mpi <- getMPI -- FIXME: check length against curve type? + case curveoidBSToEdSigningCurve curveoid of + Left e -> fail e + Right Ed25519 -> return . EdDSAPubKey Ed25519 $ EPoint mpi getPubkey _ = UnknownPKey <$> getRemainingLazyByteString @@ -810,8 +828,12 @@ putPubkey :: PKey -> Put putPubkey (UnknownPKey bs) = putLazyByteString bs -putPubkey p@(ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) = let Right curveoidbs = curveToCurveoidBS curve in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) -- FIXME: do not output length 0 or 0xff -putPubkey p@(ECDHPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) kha ksa) = let Right curveoidbs = curveToCurveoidBS curve in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) >> putWord8 0x03 >> putWord8 0x01 >> put kha >> put ksa -- FIXME: do not output length 0 or 0xff +putPubkey p@(ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) = let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve) in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) -- FIXME: do not output length 0 or 0xff +putPubkey p@(ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) kha ksa) = let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve) in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) >> putWord8 0x03 >> putWord8 0x01 >> put kha >> put ksa -- FIXME: do not output length 0 or 0xff +putPubkey p@(ECDHPubKey (EdDSAPubKey curve _) kha ksa) = let Right curveoidbs = curveToCurveoidBS (ed2ec curve) in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) >> putWord8 0x03 >> putWord8 0x01 >> put kha >> put ksa -- FIXME: do not output length 0 or 0xff + where + ed2ec Ed25519 = Curve25519 +putPubkey p@(EdDSAPubKey curve _) = let Right curveoidbs = edSigningCurveToCurveoidBS curve in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) -- FIXME: do not output length 0 or 0xff putPubkey p = mapM_ put (pubkeyToMPIs p) getSecretKey :: PKPayload -> Get SKey diff --git a/Codec/Encryption/OpenPGP/Signatures.hs b/Codec/Encryption/OpenPGP/Signatures.hs --- a/Codec/Encryption/OpenPGP/Signatures.hs +++ b/Codec/Encryption/OpenPGP/Signatures.hs @@ -16,18 +16,23 @@ import Control.Lens ((^.), _1) import Control.Monad (liftM2) +import Crypto.Error (eitherCryptoError) +import Crypto.Hash (hashWith) import qualified Crypto.Hash.Algorithms as CHA import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.RSA.PKCS15 as P15 import qualified Crypto.PubKey.RSA.Types as RSATypes import Data.Bifunctor (first) +import qualified Data.ByteArray as BA import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Either (isRight, lefts, rights) +import Data.Function (on) import Data.IxSet.Typed ((@=)) import qualified Data.IxSet.Typed as IxSet import Data.List.NonEmpty (NonEmpty(..)) @@ -130,12 +135,20 @@ verify' _ _ _ _ = error "This should never happen (verify')." verify'' (DSA,mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs = dsaVerify pub mpis hd pkey bs verify'' (ECDSA,mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs = ecdsaVerify pub mpis hd pkey bs + verify'' (EdDSA,mpis) hd pub (EdDSAPubKey Ed25519 pkey) bs = ed25519Verify pub mpis hd (i2osp (unEPoint pkey)) bs verify'' (RSA,mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs = rsaVerify pub mpis hd pkey bs verify'' _ _ _ _ _ = Left "unimplemented key type" dsaVerify pub (r:|[s]) hd pkey bs = if DSA.verify hd pkey (dsaMPIsToSig r s) bs then Right pub else Left ("DSA verification failed: " ++ show (hd,pkey,r,s,bs)) dsaVerify _ _ _ _ _ = Left "cannot verify DSA signature of wrong shape" ecdsaVerify pub (r:|[s]) hd pkey bs = if ECDSA.verify hd pkey (ecdsaMPIsToSig r s) bs then Right pub else Left ("ECDSA verification failed: " ++ show (hd,pkey,r,s,bs)) ecdsaVerify _ _ _ _ _ = Left "cannot verify ECDSA signature of wrong shape" + ed25519Verify pub (r:|[s]) hd pkey bs = either (Left . (("Ed25519 verification failed: " ++ show (hd,pkey,r,s,bs) ++ ": ")++) . show) return $ do + ep <- cf2es (Ed25519.publicKey (B.drop 1 pkey)) -- drop the 0x40 + es <- cf2es (Ed25519.signature ((B.append `on` i2osp . unMPI) r s)) + let prehash = crazyHash hd bs :: B.ByteString + if Ed25519.verify ep prehash es then Right pub else Left ("does not verify") + ed25519Verify _ _ _ _ _ = Left "cannot verify Ed25519 signature of wrong shape" + cf2es = either (Left . show) return . eitherCryptoError rsaVerify pub mpis hd pkey bs = if P15.verify (Just hd) pkey bs (rsaMPItoSig mpis) then Right pub else Left ("DSA verification failed: " ++ show (hd,pkey,mpis,bs)) dsaMPIsToSig r s = DSA.Signature (unMPI r) (unMPI s) ecdsaMPIsToSig r s = ECDSA.Signature (unMPI r) (unMPI s) @@ -151,6 +164,7 @@ expiredBefore :: UTCTime -> SigSubPacket -> Bool expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) = fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) < 0 expiredBefore _ _ = False + crazyHash h = BA.convert . hashWith h finalPayload :: Pkt -> ByteString -> ByteString finalPayload s pl = BL.concat [pl, sigbit, trailer s] diff --git a/Codec/Encryption/OpenPGP/Types/Internal/Base.hs b/Codec/Encryption/OpenPGP/Types/Internal/Base.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/Base.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/Base.hs @@ -245,6 +245,7 @@ | ECDSA | ForbiddenElgamal | DH + | EdDSA | OtherPKA Word8 deriving (Show, Data, Generic, Typeable) @@ -264,6 +265,7 @@ fromFVal ECDSA = 19 fromFVal ForbiddenElgamal = 20 fromFVal DH = 21 + fromFVal EdDSA = 22 fromFVal (OtherPKA o) = o toFVal 1 = RSA toFVal 2 = DeprecatedRSAEncryptOnly @@ -274,6 +276,7 @@ toFVal 19 = ECDSA toFVal 20 = ForbiddenElgamal toFVal 21 = DH + toFVal 22 = EdDSA toFVal o = OtherPKA o instance Hashable PubKeyAlgorithm @@ -288,6 +291,7 @@ pretty ECDSA = pretty "ECDSA" pretty ForbiddenElgamal = pretty "(forbidden) Elgamal" pretty DH = pretty "DH" + pretty EdDSA = pretty "EdDSA" pretty (OtherPKA pka) = pretty "unknown pubkey algorithm type" <+> pretty pka $(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm) @@ -768,6 +772,7 @@ | Features (Set FeatureFlag) | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash | EmbeddedSignature SignaturePayload + | IssuerFingerprint Word8 TwentyOctetFingerprint | UserDefinedSigSub Word8 ByteString | OtherSigSub Word8 ByteString deriving (Data, Eq, Generic, Show, Typeable) -- FIXME @@ -798,6 +803,7 @@ pretty (Features ffs) = pretty "features" <+> pretty (Set.toList ffs) pretty (SignatureTarget pka ha sh) = pretty "signature target" <+> pretty pka <+> pretty ha <+> prettyLBS sh pretty (EmbeddedSignature sp) = pretty "embedded signature" <+> pretty sp + pretty (IssuerFingerprint kv ifp) = pretty "issuer fingerprint (v" <> pretty kv <> pretty ")" <+> pretty ifp pretty (UserDefinedSigSub t bs) = pretty "user-defined signature subpacket type" <+> pretty t <+> pretty (BL.unpack bs) pretty (OtherSigSub t bs) = pretty "unknown signature subpacket type" <+> pretty t <+> prettyLBS bs @@ -825,6 +831,7 @@ toJSON (Features ffs) = object [T.pack "features" .= ffs] toJSON (SignatureTarget pka ha sh) = object [T.pack "signatureTarget" .= (pka, ha, BL.unpack sh)] toJSON (EmbeddedSignature sp) = object [T.pack "embeddedSignature" .= sp] + toJSON (IssuerFingerprint kv ifp) = object [T.pack "issuerFingerprint" .= (kv, ifp)] toJSON (UserDefinedSigSub t bs) = object [T.pack "userDefinedSigSub" .= (t, BL.unpack bs)] toJSON (OtherSigSub t bs) = object [T.pack "otherSigSub" .= (t, BL.unpack bs)] @@ -1018,10 +1025,17 @@ toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d) toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs) -data ECCCurve = BrokenNISTP256 - | BrokenNISTP384 - | BrokenNISTP521 +data ECCCurve = NISTP256 + | NISTP384 + | NISTP521 + | Curve25519 deriving (Data, Eq, Generic, Ord, Show, Typeable) + +instance Pretty ECCCurve where + pretty NISTP256 = pretty "NIST P-256" + pretty NISTP384 = pretty "NIST P-384" + pretty NISTP521 = pretty "NIST P-521" + pretty Curve25519 = pretty "Curve25519" instance Hashable ECCCurve diff --git a/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs @@ -1,5 +1,5 @@ -- PKITypes.hs: OpenPGP (RFC4880) data types for public/secret keys --- Copyright © 2012-2016 Clint Adams +-- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -19,6 +19,7 @@ import qualified Data.Aeson as A import qualified Data.Aeson.TH as ATH import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Data (Data) import Data.Hashable (Hashable(..)) @@ -28,11 +29,28 @@ import Data.Word (Word16) import Data.Text.Prettyprint.Doc (Pretty(..), (<+>)) +data EdSigningCurve = Ed25519 + deriving (Data, Eq, Generic, Ord, Show, Typeable) + +instance Hashable EdSigningCurve +instance Pretty EdSigningCurve where + pretty Ed25519 = pretty "Ed25519" +instance A.FromJSON EdSigningCurve +instance A.ToJSON EdSigningCurve + +newtype EPoint = EPoint { unEPoint :: Integer } + deriving (Data, Eq, Generic, Ord, Pretty, Show, Typeable) +instance Hashable EPoint + +instance A.FromJSON EPoint +instance A.ToJSON EPoint + data PKey = RSAPubKey RSA_PublicKey | DSAPubKey DSA_PublicKey | ElGamalPubKey Integer Integer Integer - | ECDHPubKey ECDSA_PublicKey HashAlgorithm SymmetricAlgorithm + | ECDHPubKey PKey HashAlgorithm SymmetricAlgorithm | ECDSAPubKey ECDSA_PublicKey + | EdDSAPubKey EdSigningCurve EPoint | UnknownPKey ByteString deriving (Data, Eq, Generic, Ord, Show, Typeable) @@ -44,6 +62,7 @@ pretty (ElGamalPubKey p g y) = pretty "Elgamal" <+> pretty p <+> pretty g <+> pretty y pretty (ECDHPubKey p ha sa) = pretty "ECDH" <+> pretty p <+> pretty ha <+> pretty sa pretty (ECDSAPubKey p) = pretty "ECDSA" <+> pretty p + pretty (EdDSAPubKey c ep) = pretty c <+> pretty ep pretty (UnknownPKey bs) = pretty "" <+> pretty (bsToHexUpper bs) instance A.ToJSON PKey where @@ -52,6 +71,7 @@ toJSON (ElGamalPubKey p g y) = A.toJSON (p, g, y) toJSON (ECDHPubKey p ha sa) = A.toJSON (p, ha, sa) toJSON (ECDSAPubKey p) = A.toJSON p + toJSON (EdDSAPubKey c ep) = A.toJSON (c, ep) toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs) data SKey = RSAPrivateKey RSA_PrivateKey @@ -59,6 +79,7 @@ | ElGamalPrivateKey Integer | ECDHPrivateKey ECDSA_PrivateKey | ECDSAPrivateKey ECDSA_PrivateKey + | EdDSAPrivateKey EdSigningCurve B.ByteString | UnknownSKey ByteString deriving (Data, Eq, Generic, Show, Typeable) @@ -70,6 +91,7 @@ pretty (ElGamalPrivateKey p) = pretty "Elgamal" <+> pretty p pretty (ECDHPrivateKey p) = pretty "ECDH" <+> pretty p pretty (ECDSAPrivateKey p) = pretty "ECDSA" <+> pretty p + pretty (EdDSAPrivateKey c bs) = pretty c <+> pretty (bsToHexUpper (BL.fromStrict bs)) pretty (UnknownSKey bs) = pretty "" <+> pretty (bsToHexUpper bs) instance A.ToJSON SKey where @@ -78,6 +100,7 @@ toJSON (ElGamalPrivateKey k) = A.toJSON k toJSON (ECDHPrivateKey k) = A.toJSON k toJSON (ECDSAPrivateKey k) = A.toJSON k + toJSON (EdDSAPrivateKey c bs) = A.toJSON (c, (B.unpack bs)) toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs) data PKPayload = PKPayload { diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -1,5 +1,5 @@ Name: hOpenPGP -Version: 2.7.2 +Version: 2.7.3 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581), plus ECC (RFC6637) Homepage: https://salsa.debian.org/clint/hOpenPGP @@ -149,6 +149,10 @@ , tests/data/nist_p-256_key.gpg , tests/data/nist_p-256_secretkey.gpg , tests/data/ecdsa-key-without-ecdh.pubkey + , tests/data/sample-eddsa.pubkey + , tests/data/ed25519-without-curve25519.pubkey + , tests/data/ed25519.pubkey + , tests/data/ed25519.secretkey Cabal-version: >= 1.10 flag network-uri @@ -338,4 +342,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git - tag: v2.7.2 + tag: v2.7.3 diff --git a/tests/data/ed25519-without-curve25519.pubkey b/tests/data/ed25519-without-curve25519.pubkey new file mode 100644 Binary files /dev/null and b/tests/data/ed25519-without-curve25519.pubkey differ diff --git a/tests/data/ed25519.pubkey b/tests/data/ed25519.pubkey new file mode 100644 Binary files /dev/null and b/tests/data/ed25519.pubkey differ diff --git a/tests/data/ed25519.secretkey b/tests/data/ed25519.secretkey new file mode 100644 Binary files /dev/null and b/tests/data/ed25519.secretkey differ diff --git a/tests/data/sample-eddsa.pubkey b/tests/data/sample-eddsa.pubkey new file mode 100644 --- /dev/null +++ b/tests/data/sample-eddsa.pubkey @@ -0,0 +1,1 @@ +˜3Só_  +ÚG@? ‰”½Ùí@Sy4ä¨|€s:€Ö/€™.Cî;$ diff --git a/tests/suite.hs b/tests/suite.hs --- a/tests/suite.hs +++ b/tests/suite.hs @@ -117,7 +117,7 @@ testKeysSelfVerification expectsuccess keyfile = do ks <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume let verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks - assertEqual (keyfile ++ " self-verification") expectsuccess (isRight verifieds) + assertEqual (keyfile ++ " self-verification") expectsuccess (isRight verifieds) -- FIXME: testKeysExpiration :: Bool -> FilePath -> Assertion testKeysExpiration expectsuccess keyfile = do @@ -281,11 +281,13 @@ , testCase "anibal-ed25519.gpg" (testSerialization "anibal-ed25519.gpg") , testCase "nist_p-256_key.gpg" (testSerialization "nist_p-256_key.gpg") , testCase "nist_p-256_secretkey.gpg" (testSerialization "nist_p-256_secretkey.gpg") + , testCase "sample-eddsa.pubkey" (testSerialization "sample-eddsa.pubkey") ], testGroup "PKA/Size/KeyID/fingerprint group" [ testCase "v3 key" (testPKAandSizeAndKeyIDandFingerprint "v3.key" "R1024:C7261095/CBD9 F412 6807 E405 CC2D 2712 1DF5 E86E") , testCase "v4 key" (testPKAandSizeAndKeyIDandFingerprint "000001-006.public_key" "R1248:D4D54EA16F87040E/421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E") , testCase "ECDSA key" (testPKAandSizeAndKeyIDandFingerprint "nist_p-256_key.gpg" "E256:F7708BADD6063224/174C CF12 C571 6D0E 527F B50E F770 8BAD D606 3224") + , testCase "EdDSA key" (testPKAandSizeAndKeyIDandFingerprint "sample-eddsa.pubkey" "w256:8CFDE12197965A9A/C959 BDBA FA32 A2F8 9A15 3B67 8CFD E121 9796 5A9A") ], testGroup "Keyring group" [ testCase "pubring 7732CF988A63EA86" (testKeyringLookup "pubring.gpg" "7732CF988A63EA86" True) @@ -321,11 +323,14 @@ , testCase "revoked pubkey" (testKeysSelfVerification False "revoked.pubkey") , testCase "expired pubkey" (testKeysSelfVerification True "expired.pubkey") , testCase "nist_p-256 pubkey" (testKeysSelfVerification True "nist_p-256_key.gpg") + , testCase "ed25519 pubkey" (testKeysSelfVerification True "ed25519.pubkey") ], testGroup "Key expiration group" [ testCase "6F87040E pubkey" (testKeysExpiration True "6F87040E.pubkey") , testCase "expired pubkey" (testKeysExpiration False "expired.pubkey") , testCase "nist_p-256 pubkey" (testKeysExpiration True "nist_p-256_key.gpg") + , testCase "ed25519-without-curve25519.pubkey" (testKeysExpiration True "ed25519-without-curve25519.pubkey") + , testCase "ed25519.pubkey" (testKeysExpiration True "ed25519.pubkey") ], testGroup "Compression group" [ testCase "compressedsig.gpg" (testCompression "compressedsig.gpg")