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 @@ -16,20 +16,18 @@ , sigPKA , sigHA , sigCT - , truncatingVerify + , curveoidBSToCurve + , curveToCurveoidBS + , point2BS ) where -import Crypto.Hash (hashWith) -import qualified Crypto.Hash.IO as CHI -import Crypto.Number.Basic (numBits) -import Crypto.Number.ModArithmetic (expFast, inverse) -import Crypto.Number.Serialize (os2ip) +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.ECC.Types as ECCT import qualified Crypto.PubKey.RSA as RSA import Data.Bits (testBit) -import Data.ByteArray (ByteArrayAccess) -import qualified Data.ByteArray as BA import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL @@ -74,6 +72,8 @@ 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))] multiplicativeInverse :: Integral a => a -> a -> a multiplicativeInverse _ 1 = 1 @@ -100,18 +100,22 @@ sigCT (SigV4 _ _ _ hsubs _ _ _) = fmap (\(SigSubPacket _ (SigCreationTime i)) -> i) (find isSigCreationTime hsubs) sigCT _ = Nothing -truncatingVerify :: (ByteArrayAccess msg, CHI.HashAlgorithm hash) => hash -> DSA.PublicKey -> DSA.Signature -> msg -> Bool -truncatingVerify hashAlg pk (DSA.Signature r s) m - -- Reject the signature if either 0 < r < q or 0 < s < q is not satisfied. - | r <= 0 || r >= q || s <= 0 || s >= q = False - | otherwise = v == r - where (DSA.Params p g q) = DSA.public_params pk - y = DSA.public_y pk - hm = os2ip . dsaTruncate . BA.convert $ hashWith hashAlg m +curveoidBSToCurve :: B.ByteString -> Either String ECCT.Curve +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" - w = fromJust $ inverse s q - u1 = (hm*w) `mod` q - u2 = (r*w) `mod` q - v = (expFast g u1 p * expFast y u2 p) `mod` p `mod` q - dsaTruncate bs = let lbs = BL.fromStrict bs in if countBits lbs > fromIntegral dsaQLen then B.take (dsaQLen `div` 8) bs else bs -- FIXME: uneven bits - dsaQLen = numBits q +-- [0x2B 0x06 0x01 0x04 0x01 0xDA 0x47 0x0F 0x01] -- ed25519 + +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" + +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" 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 @@ -8,8 +8,10 @@ , pkalgoAbbrev ) where -import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.PubKey.ECC.Types as ECCT +import qualified Crypto.PubKey.RSA as RSA import Data.Bits (shiftR) import Data.List (unfoldr) @@ -19,6 +21,8 @@ pubkeySize (RSAPubKey (RSA_PublicKey x)) = Right (RSA.public_size x * 8) 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 x = Left $ "Unable to calculate size of " ++ show x bitcount :: Integer -> Int 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 @@ -23,6 +23,9 @@ import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.RSA as R import qualified Crypto.PubKey.DSA as D +import qualified Crypto.PubKey.ECC.Types as ECCT +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import Data.Bifunctor (bimap) import Data.Bits ((.&.), (.|.), shiftL, shiftR, testBit) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B @@ -45,7 +48,7 @@ import Data.Maybe (fromMaybe) import Network.URI (nullURI, parseURI, uriToString) -import Codec.Encryption.OpenPGP.Internal (pubkeyToMPIs, multiplicativeInverse) +import Codec.Encryption.OpenPGP.Internal (curveoidBSToCurve, curveToCurveoidBS, pubkeyToMPIs, multiplicativeInverse) import Codec.Encryption.OpenPGP.Types instance Binary SigSubPacket where @@ -609,8 +612,12 @@ udata <- getByteString (fromIntegral len) return . UserIdPkt . decodeUtf8With lenientDecode $ udata | t == 14 = do - pkp <- getPKPayload - return $ PublicSubkeyPkt pkp + bs <- getLazyByteString len + let ps = flip runGetOrFail bs $ do pkp <- getPKPayload + return $ PublicSubkeyPkt pkp + case ps of + Left (_, _, err) -> fail ("public subkey " ++ err) + Right (_, _, key) -> return key | t == 17 = do bs <- getLazyByteString len case runGetOrFail (many getUserAttrSubPacket) bs of @@ -783,10 +790,36 @@ MPI g <- get MPI y <- get return $ ElGamalPubKey p g y +getPubkey ECDSA = 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 curveoidBSToCurve curveoid >>= \c -> mpi2point c mpi 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)) +getPubkey ECDH = do + ECDSAPubKey ed <- getPubkey ECDSA + 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 _ = UnknownPKey <$> getRemainingLazyByteString +bs2Point :: B.ByteString -> Either String ECDSA.PublicPoint +bs2Point bs = let xy = B.drop 1 bs in + let l = B.length xy in + if B.head bs == 0x04 + then return (uncurry ECCT.Point (bimap os2ip os2ip (B.splitAt (div l 2) xy))) + else fail $ "unknown type of point: " ++ show (B.unpack bs) + 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 = mapM_ put (pubkeyToMPIs p) getSecretKey :: PKPayload -> Get SKey @@ -806,6 +839,14 @@ | _pkalgo pkp `elem` [ElgamalEncryptOnly,ForbiddenElgamal] = do MPI x <- get return $ ElGamalPrivateKey x + | _pkalgo pkp == ECDSA = + do MPI pn <- get + let pubcurve = (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p) (pkp^.pubkey) + return $ ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey pubcurve pn)) + | _pkalgo pkp == ECDH = -- FIXME: deduplicate this and above + do MPI pn <- get + let pubcurve = (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p) (pkp^.pubkey) + return $ ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey pubcurve pn)) putSKey :: SKey -> Put putSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey _ d p q _ _ _))) = put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u) diff --git a/Codec/Encryption/OpenPGP/SerializeForSigs.hs b/Codec/Encryption/OpenPGP/SerializeForSigs.hs --- a/Codec/Encryption/OpenPGP/SerializeForSigs.hs +++ b/Codec/Encryption/OpenPGP/SerializeForSigs.hs @@ -38,7 +38,7 @@ putPKPforFingerprinting _ = fail "This should never happen (putPKPforFingerprinting)" putMPIforFingerprinting:: MPI -> Put -putMPIforFingerprinting(MPI i) = let bs = i2osp i in putByteString bs +putMPIforFingerprinting (MPI i) = let bs = i2osp i in putByteString bs putPartialSigforSigning :: Pkt -> Put putPartialSigforSigning (SignaturePkt (SigV4 st pka ha hashed _ _ _)) = do 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 @@ -22,11 +22,17 @@ import qualified Crypto.Hash.Algorithms as CHA import Crypto.Number.Serialize (i2osp) import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.RSA.PKCS15 as P15 import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Either (lefts, rights) +#if MIN_VERSION_base(4,7,0) +import Data.Either (isRight) +#else +import Control.Error.Util (isRight) +#endif import Data.IxSet.Typed ((@=)) import qualified Data.IxSet.Typed as IxSet import Data.List.NonEmpty (NonEmpty(..)) @@ -36,7 +42,7 @@ import Data.Binary.Put (runPut) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) -import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), issuer, emptyPSC, truncatingVerify) +import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), issuer, emptyPSC) import Codec.Encryption.OpenPGP.Ontology (isRevokerP, isRevocationKeySSP, isSubkeyBindingSig, isSubkeyRevocation) import Codec.Encryption.OpenPGP.SerializeForSigs (putPartialSigforSigning, putSigTrailer, payloadForSig) @@ -59,8 +65,8 @@ verifyTKWith vsf mt key = do revokers <- checkRevokers key revs <- checkKeyRevocations revokers key - let uids = filter (\(_, sps) -> sps /= []) . checkUidSigs $ key^.tkUIDs -- FIXME: check revocations here? - let uats = filter (\(_, sps) -> sps /= []) . checkUAtSigs $ key^.tkUAts -- FIXME: check revocations here? + let uids = filter (not . null . snd) . checkUidSigs $ key^.tkUIDs -- FIXME: check revocations here? + let uats = filter (not . null . snd) . checkUAtSigs $ key^.tkUAts -- FIXME: check revocations here? let subs = concatMap checkSub $ key^.tkSubs -- FIXME: check revocations here? return (TK (key^.tkKey) revs uids uats subs) where @@ -92,9 +98,7 @@ vSig :: SignaturePayload -> Either String Verification vSig sp = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (key ^. tkKey._1) } mt vSubSig :: Pkt -> SignaturePayload -> Bool - vSubSig sk sp = case vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (key ^. tkKey._1), lastSubkey = sk} mt of - Left _ -> False - Right _ -> True + vSubSig sk sp = isRight (vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (key ^. tkKey._1), lastSubkey = sk} mt) verifyRevoker :: SignaturePayload -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)] verifyRevoker sp = do _ <- vSig sp @@ -128,14 +132,17 @@ verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) SHA224 pl = verify'' (pkaAndMPIs s) CHA.SHA224 pub pkey pl verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) DeprecatedMD5 pl = verify'' (pkaAndMPIs s) CHA.MD5 pub pkey pl verify' _ _ _ _ = error "This should never happen (verify')." - verify'' (DSA,mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs = verify''' (dsaVerify mpis hd pkey bs) pub - verify'' (RSA,mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs = verify''' (rsaVerify mpis hd pkey bs) pub + 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'' (RSA,mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs = rsaVerify pub mpis hd pkey bs verify'' _ _ _ _ _ = Left "unimplemented key type" - verify''' f pub = if f then Right pub else Left "verification failed" - dsaVerify (r:|[s]) hd pkey = truncatingVerify hd pkey (dsaMPIsToSig r s) - dsaVerify _ _ _ = const False -- FIXME: this should be some sort of Either chain? - rsaVerify mpis hd pkey bs = P15.verify (Just hd) pkey bs (rsaMPItoSig mpis) + 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" + 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) rsaMPItoSig (s:|[]) = i2osp (unMPI s) hashalgo :: Pkt -> HashAlgorithm hashalgo (SignaturePkt (SigV4 _ _ ha _ _ _ _)) = ha 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 @@ -27,7 +27,6 @@ import Data.Aeson ((.=), object) import qualified Data.Aeson as A import qualified Data.Aeson.TH as ATH -import Data.Byteable (Byteable) import Data.ByteArray (ByteArrayAccess) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B @@ -869,7 +868,7 @@ $(ATH.deriveJSON ATH.defaultOptions ''KeyVersion) newtype IV = IV {unIV :: B.ByteString} - deriving (Byteable, ByteArrayAccess, Data, Eq, Generic, Hashable, Monoid, Show, Typeable) + deriving (ByteArrayAccess, Data, Eq, Generic, Hashable, Monoid, Show, Typeable) instance Newtype IV B.ByteString where pack = IV @@ -915,7 +914,7 @@ $(ATH.deriveJSON ATH.defaultOptions ''DataType) newtype Salt = Salt {unSalt :: B.ByteString} - deriving (Byteable, Data, Eq, Generic, Hashable, Show, Typeable) + deriving (Data, Eq, Generic, Hashable, Show, Typeable) instance Newtype Salt B.ByteString where pack = Salt diff --git a/Codec/Encryption/OpenPGP/Types/Internal/CryptoniteNewtypes.hs b/Codec/Encryption/OpenPGP/Types/Internal/CryptoniteNewtypes.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/CryptoniteNewtypes.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/CryptoniteNewtypes.hs @@ -11,9 +11,11 @@ import GHC.Generics (Generic) +import Control.Monad (mzero) import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.PubKey.ECC.Types as ECCT import qualified Data.Aeson as A import Data.Data (Data) import Data.Hashable (Hashable(..)) @@ -83,4 +85,13 @@ hashWithSalt s (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = s `hashWithSalt` show curve `hashWithSalt` show q -- FIXME: don't use show instance Hashable ECDSA_PrivateKey where hashWithSalt s (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = s `hashWithSalt` show curve `hashWithSalt` show d -- FIXME: don't use show + +newtype ECurvePoint = ECurvePoint { unECurvepoint :: ECCT.Point } + deriving (Data, Eq, Generic, Show, Typeable) +instance A.ToJSON ECurvePoint where + toJSON (ECurvePoint (ECCT.Point x y)) = A.toJSON (x, y) + toJSON (ECurvePoint ECCT.PointO) = A.toJSON "point at infinity" +instance A.FromJSON ECurvePoint where + parseJSON (A.Object v) = error "FIXME: whatsit" + parseJSON _ = mzero diff --git a/Data/Conduit/OpenPGP/Compression.hs b/Data/Conduit/OpenPGP/Compression.hs --- a/Data/Conduit/OpenPGP/Compression.hs +++ b/Data/Conduit/OpenPGP/Compression.hs @@ -1,5 +1,5 @@ -- Compression.hs: OpenPGP (RFC4880) compression conduits --- Copyright © 2012-2014 Clint Adams +-- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -14,8 +14,8 @@ import qualified Data.Conduit.List as CL import Control.Monad.Trans.Resource (MonadThrow) -conduitCompress :: MonadThrow m => CompressionAlgorithm -> Conduit Pkt m Pkt +conduitCompress :: MonadThrow m => CompressionAlgorithm -> ConduitT Pkt Pkt m () conduitCompress algo = CL.consume >>= \ps -> yield (compressPkts algo ps) -conduitDecompress :: MonadThrow m => Conduit Pkt m Pkt +conduitDecompress :: MonadThrow m => ConduitT Pkt Pkt m () conduitDecompress = CL.concatMap decompressPkt diff --git a/Data/Conduit/OpenPGP/Decrypt.hs b/Data/Conduit/OpenPGP/Decrypt.hs --- a/Data/Conduit/OpenPGP/Decrypt.hs +++ b/Data/Conduit/OpenPGP/Decrypt.hs @@ -1,5 +1,5 @@ -- Decrypt.hs: OpenPGP (RFC4880) recursive packet decryption --- Copyright © 2013-2016 Clint Adams +-- Copyright © 2013-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -11,7 +11,8 @@ import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Trans.Resource (MonadBaseControl, MonadResource, MonadThrow, runResourceT) +import Control.Monad.IO.Unlift (MonadUnliftIO) +import Control.Monad.Trans.Resource (MonadResource, MonadThrow) import qualified Control.Monad.Trans.State.Lazy as S import qualified Crypto.Hash as CH import qualified Crypto.Hash.Algorithms as CHA @@ -42,13 +43,13 @@ type InputCallback m = String -> m BL.ByteString -conduitDecrypt :: (MonadBaseControl IO m, MonadResource m) => InputCallback IO -> Conduit Pkt m Pkt +conduitDecrypt :: (MonadUnliftIO m, MonadResource m, MonadThrow m) => InputCallback IO -> ConduitT Pkt Pkt m () conduitDecrypt = conduitDecrypt' 0 -conduitDecrypt' :: (MonadBaseControl IO m, MonadResource m) => Int -> InputCallback IO -> Conduit Pkt m Pkt +conduitDecrypt' :: (MonadUnliftIO m, MonadResource m, MonadThrow m) => Int -> InputCallback IO -> ConduitT Pkt Pkt m () conduitDecrypt' depth cb = CL.concatMapAccumM push def { _depth = depth } -- FIXME: this depth stuff is convoluted where - push :: (MonadBaseControl IO m, MonadResource m) => Pkt -> RecursorState -> m (RecursorState, [Pkt]) + push :: (MonadUnliftIO m, MonadResource m, MonadThrow m) => Pkt -> RecursorState -> m (RecursorState, [Pkt]) push i s | _depth s > 42 = fail "I think we've been quine-attacked" | otherwise = case i of @@ -65,20 +66,20 @@ ldpCheck l@LiteralDataPkt{} = S.get >>= \o -> S.put o { _lastLDP = Just . fromPkt $ l } ldpCheck _ = return () -decryptSEDP :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => Int -> InputCallback IO -> SKESK -> BL.ByteString -> m [Pkt] +decryptSEDP :: (MonadUnliftIO m, MonadIO m, MonadThrow m) => Int -> InputCallback IO -> SKESK -> BL.ByteString -> m [Pkt] decryptSEDP depth cb skesk bs = do -- FIXME: this shouldn't pass the whole SKESK passphrase <- liftIO $ cb "Input the passphrase I want" let key = skesk2Key skesk passphrase decrypted = case decryptOpenPGPCfb (_skeskSymmetricAlgorithm skesk) (BL.toStrict bs) key of Left e -> error e Right x -> x - runResourceT $ CB.sourceLbs (BL.fromStrict decrypted) $= conduitGet get $= conduitDecompress $= conduitDecrypt' depth cb $$ CL.consume + runConduitRes $ CB.sourceLbs (BL.fromStrict decrypted) .| conduitGet get .| conduitDecompress .| conduitDecrypt' depth cb .| CL.consume -decryptSEIPDP :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => Int -> InputCallback IO -> SKESK -> BL.ByteString -> m [Pkt] +decryptSEIPDP :: (MonadUnliftIO m, MonadIO m, MonadThrow m) => Int -> InputCallback IO -> SKESK -> BL.ByteString -> m [Pkt] decryptSEIPDP depth cb skesk bs = do -- FIXME: this shouldn't pass the whole SKESK passphrase <- liftIO $ cb "Input the passphrase I want" let key = skesk2Key skesk passphrase decrypted = case decrypt (_skeskSymmetricAlgorithm skesk) (BL.toStrict bs) key of Left e -> error e Right x -> x - runResourceT $ CB.sourceLbs (BL.fromStrict decrypted) $= conduitGet get $= conduitDecompress $= conduitDecrypt' depth cb $$ CL.consume + runConduitRes $ CB.sourceLbs (BL.fromStrict decrypted) .| conduitGet get .| conduitDecompress .| conduitDecrypt' depth cb .| CL.consume diff --git a/Data/Conduit/OpenPGP/Filter.hs b/Data/Conduit/OpenPGP/Filter.hs --- a/Data/Conduit/OpenPGP/Filter.hs +++ b/Data/Conduit/OpenPGP/Filter.hs @@ -1,5 +1,5 @@ -- Filter.hs: OpenPGP (RFC4880) packet filtering --- Copyright © 2014-2015 Clint Adams +-- Copyright © 2014-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -12,7 +12,7 @@ ) where import Control.Monad.Trans.Reader (Reader, runReader) -import Data.Conduit (Conduit) +import Data.Conduit (ConduitT) import qualified Data.Conduit.List as CL import Codec.Encryption.OpenPGP.Types @@ -22,14 +22,14 @@ RTKFilterPredicate (Reader TK Bool) -- ^ fp for transferable keys | RPFilterPredicate (Reader Pkt Bool) -- ^ fp for context-less packets -conduitPktFilter :: Monad m => FilterPredicates -> Conduit Pkt m Pkt +conduitPktFilter :: Monad m => FilterPredicates -> ConduitT Pkt Pkt m () conduitPktFilter = CL.filter . superPredicate superPredicate :: FilterPredicates -> Pkt -> Bool superPredicate (RPFilterPredicate e) p = runReader e p superPredicate _ _ = False -- do not match incorrect type of packet -conduitTKFilter :: Monad m => FilterPredicates -> Conduit TK m TK +conduitTKFilter :: Monad m => FilterPredicates -> ConduitT TK TK m () conduitTKFilter = CL.filter . superTKPredicate superTKPredicate :: FilterPredicates -> TK -> Bool diff --git a/Data/Conduit/OpenPGP/Keyring.hs b/Data/Conduit/OpenPGP/Keyring.hs --- a/Data/Conduit/OpenPGP/Keyring.hs +++ b/Data/Conduit/OpenPGP/Keyring.hs @@ -1,5 +1,5 @@ -- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing --- 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). @@ -21,13 +21,13 @@ data Phase = MainKey | Revs | Uids | UAts | Subs | SkippingBroken deriving (Eq, Ord, Show) -conduitToTKs :: Monad m => Conduit Pkt m TK +conduitToTKs :: Monad m => ConduitT Pkt TK m () conduitToTKs = conduitToTKs' True -conduitToTKsDropping :: Monad m => Conduit Pkt m TK +conduitToTKsDropping :: Monad m => ConduitT Pkt TK m () conduitToTKsDropping = conduitToTKs' False -fakecmAccum :: Monad m => (accum -> (accum, [b])) -> (a -> accum -> (accum, [b])) -> accum -> Conduit a m b +fakecmAccum :: Monad m => (accum -> (accum, [b])) -> (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m () fakecmAccum finalizer f = loop where @@ -39,10 +39,10 @@ mapM_ yield bs loop accum' -conduitToTKs' :: Monad m => Bool -> Conduit Pkt m TK -conduitToTKs' intolerant = CL.filter notTrustPacket =$= CL.map (:[]) =$= fakecmAccum finalizeParsing (parseAChunk (anyTK intolerant)) ([], Just (Nothing, anyTK intolerant)) =$= CL.catMaybes +conduitToTKs' :: Monad m => Bool -> ConduitT Pkt TK m () +conduitToTKs' intolerant = CL.filter notTrustPacket .| CL.map (:[]) .| fakecmAccum finalizeParsing (parseAChunk (anyTK intolerant)) ([], Just (Nothing, anyTK intolerant)) .| CL.catMaybes where notTrustPacket = not . isTrustPkt -sinkKeyringMap :: Monad m => Sink TK m Keyring +sinkKeyringMap :: Monad m => ConduitT TK Void m Keyring sinkKeyringMap = CL.fold (flip insert) empty diff --git a/Data/Conduit/OpenPGP/Verify.hs b/Data/Conduit/OpenPGP/Verify.hs --- a/Data/Conduit/OpenPGP/Verify.hs +++ b/Data/Conduit/OpenPGP/Verify.hs @@ -15,7 +15,7 @@ import Codec.Encryption.OpenPGP.Signatures (verifySigWith, verifyAgainstKeyring) import qualified Data.Conduit.List as CL -conduitVerify :: Monad m => Keyring -> Maybe UTCTime -> Conduit Pkt m (Either String Verification) +conduitVerify :: Monad m => Keyring -> Maybe UTCTime -> ConduitT Pkt (Either String Verification) m () conduitVerify kr mt = CL.concatMapAccum (flip push) emptyPSC where push state ld@LiteralDataPkt{} = (state { lastLD = ld }, []) diff --git a/bench/mark.hs b/bench/mark.hs --- a/bench/mark.hs +++ b/bench/mark.hs @@ -1,5 +1,5 @@ -- mark.hs: hOpenPGP benchmark suite --- Copyright © 2014-2016 Clint Adams +-- Copyright © 2014-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -9,7 +9,6 @@ import Codec.Encryption.OpenPGP.Signatures (verifyTKWith, verifySigWith, verifyAgainstKeys, verifyAgainstKeyring) -import Control.Monad.Trans.Resource (runResourceT) import Data.Conduit.Serialization.Binary (conduitGet) import Data.Conduit.OpenPGP.Keyring (conduitToTKs, sinkKeyringMap) import qualified Data.IxSet.Typed as IxSet @@ -28,8 +27,8 @@ ] ] where - loadKeys fp = runResourceT $ CB.sourceFile fp DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume - loadKeyring fp = runResourceT $ CB.sourceFile fp DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap + loadKeys fp = DC.runConduitRes $ CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume + loadKeyring fp = DC.runConduitRes $ CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap selfVerifyKeys fp = fmap (\ks -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks) (loadKeys fp) selfVerifyKeyring fp = fmap (\kr -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing) (IxSet.toList kr)) (loadKeyring fp) diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -1,13 +1,13 @@ Name: hOpenPGP -Version: 2.5.5 +Version: 2.6 Synopsis: native Haskell implementation of OpenPGP (RFC4880) -Description: native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581) -Homepage: http://floss.scru.org/hOpenPGP/ +Description: native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581), plus ECC (RFC6637) +Homepage: https://salsa.debian.org/clint/hOpenPGP License: MIT License-file: LICENSE Author: Clint Adams Maintainer: Clint Adams -Copyright: 2012-2016 Clint Adams +Copyright: 2012-2018 Clint Adams Category: Codec, Data Build-type: Simple Extra-source-files: tests/suite.hs @@ -146,7 +146,9 @@ , tests/data/sigs-with-regexes , tests/data/gnu-dummy-s2k-101-secret-key.gpg , tests/data/anibal-ed25519.gpg - + , tests/data/nist_p-256_key.gpg + , tests/data/nist_p-256_secretkey.gpg + , tests/data/ecdsa-key-without-ecdh.pubkey Cabal-version: >= 1.10 flag network-uri @@ -186,20 +188,20 @@ , Codec.Encryption.OpenPGP.Types.Internal.TK , Codec.Encryption.OpenPGP.BlockCipher Build-depends: aeson + , asn1-encoding , attoparsec , base > 4 && < 5 , base16-bytestring , base64-bytestring , bifunctors - , byteable , bytestring , bzlib , binary >= 0.6.4.0 - , binary-conduit - , conduit >= 0.5 && < 1.3 + , binary-conduit >= 1.3 + , conduit >= 1.2.8 , conduit-extra >= 1.1 , containers - , cryptonite >= 0.5 + , cryptonite >= 0.11 , crypto-cipher-types , data-default-class , errors @@ -213,18 +215,18 @@ , newtype , openpgp-asciiarmor >= 0.1 , resourcet > 0.4 - , securemem , semigroups , split , text , time >= 1.1 , time-locale-compat , transformers + , unliftio-core , unordered-containers , wl-pprint-extras , zlib if flag(network-uri) - build-depends: network-uri >= 2.6, network >= 2.6 + build-depends: network-uri >= 2.6 else build-depends: network-uri < 2.6, network < 2.6 default-language: Haskell2010 @@ -237,19 +239,19 @@ Ghc-options: -Wall -with-rtsopts=-K1K Build-depends: hOpenPGP , aeson + , asn1-encoding , attoparsec , base > 4 && < 5 , base16-bytestring , bifunctors - , byteable , bytestring , bzlib , binary >= 0.6.4.0 - , binary-conduit - , conduit + , binary-conduit >= 1.3 + , conduit >= 1.3 , conduit-extra , containers - , cryptonite >= 0.5 + , cryptonite >= 0.11 , crypto-cipher-types , data-default-class , errors @@ -261,13 +263,13 @@ , monad-loops , nettle , newtype - , securemem , semigroups , split , text , time >= 1.1 , time-locale-compat , transformers + , unliftio-core , unordered-containers , wl-pprint-extras , zlib @@ -293,15 +295,14 @@ , base16-bytestring , base64-bytestring , bifunctors - , byteable , bytestring , bzlib , binary >= 0.6.4.0 - , binary-conduit - , conduit >= 0.5 && < 1.3 + , binary-conduit >= 1.3 + , conduit >= 1.3 , conduit-extra >= 1.1 , containers - , cryptonite >= 0.5 + , cryptonite >= 0.11 , crypto-cipher-types , data-default-class , errors @@ -315,13 +316,13 @@ , newtype , openpgp-asciiarmor >= 0.1 , resourcet > 0.4 - , securemem , semigroups , split , text , time >= 1.1 , time-locale-compat , transformers + , unliftio-core , unordered-containers , wl-pprint-extras , zlib @@ -334,9 +335,9 @@ source-repository head type: git - location: git://git.debian.org/users/clint/hOpenPGP.git + location: https://salsa.debian.org/clint/hOpenPGP.git source-repository this type: git - location: git://git.debian.org/users/clint/hOpenPGP.git - tag: v2.5.5 + location: https://salsa.debian.org/clint/hOpenPGP.git + tag: v2.6 diff --git a/tests/data/ecdsa-key-without-ecdh.pubkey b/tests/data/ecdsa-key-without-ecdh.pubkey new file mode 100644 Binary files /dev/null and b/tests/data/ecdsa-key-without-ecdh.pubkey differ diff --git a/tests/data/nist_p-256_key.gpg b/tests/data/nist_p-256_key.gpg new file mode 100644 Binary files /dev/null and b/tests/data/nist_p-256_key.gpg differ diff --git a/tests/data/nist_p-256_secretkey.gpg b/tests/data/nist_p-256_secretkey.gpg new file mode 100644 Binary files /dev/null and b/tests/data/nist_p-256_secretkey.gpg differ diff --git a/tests/suite.hs b/tests/suite.hs --- a/tests/suite.hs +++ b/tests/suite.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -- suite.hs: hOpenPGP test suite --- 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). @@ -24,7 +24,8 @@ import Codec.Encryption.OpenPGP.Signatures (verifyTKWith, verifySigWith, verifyAgainstKeys) import Codec.Encryption.OpenPGP.Types import Control.Error.Util (isRight) -import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import Control.Monad.Trans.Resource (ResourceT) +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.RSA as RSA import Data.Conduit.Serialization.Binary (conduitGet) import Data.Conduit.OpenPGP.Compression (conduitCompress, conduitDecompress) @@ -76,12 +77,12 @@ else assertEqual ("for " ++ fpr) firstpass secondpass -counter :: (Monad m) => DC.Sink a m Int +counter :: (Monad m) => DC.ConduitT a DC.Void m Int counter = CL.fold (const . (1+)) 0 -testConduitOutputLength :: FilePath -> DC.Conduit B.ByteString (ResourceT IO) b -> Int -> Assertion +testConduitOutputLength :: FilePath -> DC.ConduitT B.ByteString b (ResourceT IO) () -> Int -> Assertion testConduitOutputLength fpr c target = do - len <- runResourceT $ CB.sourceFile ("tests/data/" ++ fpr) DC.$= c DC.$$ counter + len <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ fpr) DC..| c DC..| counter assertEqual ("expected length " ++ show target) target len testPKAandSizeAndKeyIDandFingerprint :: FilePath -> String -> Assertion @@ -99,26 +100,26 @@ testKeyringLookup :: FilePath -> String -> Bool -> Assertion testKeyringLookup fpr eok expected = do - kr <- runResourceT $ CB.sourceFile ("tests/data/" ++ fpr) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap + kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ fpr) DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap let key = getOne (kr @= (read eok :: EightOctetKeyId)) assertEqual (eok ++ " in " ++ fpr) expected (isJust key) testVerifyMessage :: FilePath -> FilePath -> [TwentyOctetFingerprint] -> Assertion testVerifyMessage keyring message issuers = do - kr <- runResourceT $ CB.sourceFile ("tests/data/" ++ keyring) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap - verification <- runResourceT $ CB.sourceFile ("tests/data/" ++ message) DC.$= conduitGet get DC.$= conduitDecompress DC.$= conduitVerify kr Nothing DC.$$ CL.consume + kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyring) DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap + verification <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ message) DC..| conduitGet get DC..| conduitDecompress DC..| conduitVerify kr Nothing DC..| CL.consume let verification' = map (fmap (fingerprint . _verificationSigner)) verification assertEqual (keyring ++ " for " ++ message) (map Right issuers) verification' testKeysSelfVerification :: Bool -> FilePath -> Assertion testKeysSelfVerification expectsuccess keyfile = do - ks <- runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume + 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) testKeysExpiration :: Bool -> FilePath -> Assertion testKeysExpiration expectsuccess keyfile = do - ks <- runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume + ks <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume let Right verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks tvalid = all (isTKTimeValid (posixSecondsToUTCTime (realToFrac (1400000000 :: Integer)))) verifieds assertEqual (keyfile ++ " key expiration") expectsuccess tvalid @@ -128,7 +129,7 @@ testSymmetricEncryption encfile passfile cleartext = do passphrase <- BL.readFile $ "tests/data/" ++ passfile -- get parse tree - pt <- runResourceT $ CB.sourceFile ("tests/data/" ++ encfile) DC.$= conduitGet get DC.$$ CL.consume + pt <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ encfile) DC..| conduitGet get DC..| CL.consume -- assert parse tree has exactly two packets: skesk, encdata assertEqual "wrong number of packets" 2 (length pt) let skesk = fromPkt.head $ pt @@ -138,7 +139,7 @@ -- and the type system chokes before we hit them: assertEqual "first packet should be SKESK" SKESKType (packetType skesk) assertEqual "second packet should be encrypted data" SymEncIntegrityProtectedDataType (packetType d) - decrypted <- runResourceT $ CL.sourceList pt DC.$= conduitDecrypt (fakeCallback passphrase) DC.$$ CL.consume + decrypted <- DC.runConduitRes $ CL.sourceList pt DC..| conduitDecrypt (fakeCallback passphrase) DC..| CL.consume let payload = _literalDataPayload . fromPkt . head $ decrypted assertEqual ("cleartext for " ++ encfile) cleartext payload where @@ -148,7 +149,7 @@ testSecretKeyDecryption :: FilePath -> FilePath -> Assertion testSecretKeyDecryption keyfile passfile = do passphrase <- BL.readFile $ "tests/data/" ++ passfile - kr <- runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$$ CL.consume + kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| CL.consume let SecretKey pkp ska = fromPkt . head $ kr SUUnencrypted skey _ = decryptPrivateKey (pkp, ska) passphrase doPkeyAndSkeyMatch (_pubkey pkp) skey @@ -157,8 +158,8 @@ testSecretKeyEncryption :: FilePath -> FilePath -> Assertion testSecretKeyEncryption keyfile passfile = do passphrase <- BL.readFile $ "tests/data/" ++ passfile - kr <- runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$$ CL.consume - gkr <- runResourceT $ CB.sourceFile ("tests/data/" ++ "aes256-sha512.seckey") DC.$= conduitGet get DC.$$ CL.consume + kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| CL.consume + gkr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ "aes256-sha512.seckey") DC..| conduitGet get DC..| CL.consume let SecretKey pkp ska = fromPkt . head $ kr newska = encryptPrivateKey "\226~\197\a\202#\"G" (IV "\187\219\253I\236\204\t5D\196\NAK>;\202\185\t") ska passphrase newtruck = toPkt (SecretKey pkp newska):tail kr @@ -167,7 +168,7 @@ testParsePktsUtil :: FilePath -> Assertion testParsePktsUtil fn = do let fpath = "tests/data/" ++ fn - cp <- runResourceT $ CB.sourceFile fpath DC.$= conduitGet get DC.$$ CL.consume + cp <- DC.runConduitRes $ CB.sourceFile fpath DC..| conduitGet get DC..| CL.consume pp <- parsePkts `fmap` BL.readFile fpath assertEqual "parsePkts utility function gives same results as conduit pipeline" cp pp @@ -175,7 +176,7 @@ testParseTKsUtil fn = do let fpath = "tests/data/" ++ fn lbs <- BL.readFile fpath - cp <- runResourceT $ CB.sourceLbs lbs DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume + cp <- DC.runConduitRes $ CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume let pt = parseTKs True . parsePkts $ lbs assertEqual "parsePkts utility function gives same results as conduit pipeline" cp pt @@ -276,10 +277,13 @@ , testCase "sigs-with-regexes" (testSerialization "sigs-with-regexes") , testCase "gnu-dummy-s2k-101-secret-key.gpg" (testSerialization "gnu-dummy-s2k-101-secret-key.gpg") , 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") ], 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") ], testGroup "Keyring group" [ testCase "pubring 7732CF988A63EA86" (testKeyringLookup "pubring.gpg" "7732CF988A63EA86" True) @@ -308,15 +312,18 @@ , testCase "6F87040E" (testVerifyMessage "pubring.gpg" "6F87040E.pubkey" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3 FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC"]) , testCase "6F87040E-cr" (testVerifyMessage "pubring.gpg" "6F87040E-cr.pubkey" [fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC", fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC", fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3 FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC"]) , testCase "simple RSA secret key" (testVerifyMessage "pubring.gpg" "simple.seckey" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) + , testCase "simple ECDSA public key" (testVerifyMessage "ecdsa-key-without-ecdh.pubkey" "ecdsa-key-without-ecdh.pubkey" [fp "174C CF12 C571 6D0E 527F B50E F770 8BAD D606 3224"]) ], testGroup "Key verification group" [ testCase "6F87040E pubkey" (testKeysSelfVerification True "6F87040E.pubkey") , 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") ], 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") ], testGroup "Compression group" [ testCase "compressedsig.gpg" (testCompression "compressedsig.gpg") @@ -324,11 +331,11 @@ , testCase "compressedsig-bzip2.gpg" (testCompression "compressedsig-bzip2.gpg") ], testGroup "Conduit length group" [ - testCase "conduitCompress (ZIP)" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitCompress ZIP) 1) - , testCase "conduitCompress (Zlib)" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitCompress ZLIB) 1) - , testCase "conduitCompress (BZip2)" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitCompress BZip2) 1) - , testCase "conduitToTKs" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitToTKs) 4) - , testCase "conduitToTKsDropping" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitToTKsDropping) 4) + testCase "conduitCompress (ZIP)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress ZIP) 1) + , testCase "conduitCompress (Zlib)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress ZLIB) 1) + , testCase "conduitCompress (BZip2)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress BZip2) 1) + , testCase "conduitToTKs" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitToTKs) 4) + , testCase "conduitToTKsDropping" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitToTKsDropping) 4) ], testGroup "Encrypted data" [ testCase "Symmetric Encryption simple S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des-s2k0.gpg" "symmetric-password.txt" "test\n") @@ -360,6 +367,7 @@ testCase "SUSSHA1 CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "simple.seckey" "pki-password.txt") , testCase "SUS16bit CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "16bitcksum.seckey" "pki-password.txt") , testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyDecryption "aes256-sha512.seckey" "pki-password.txt") + , testCase "SUSSHA1 AES128 IteratedSalted SHA256 ECDSA" (testSecretKeyDecryption "nist_p-256_secretkey.gpg" "pki-password.txt") ], testGroup "Encrypting secret keys" [ testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyEncryption "unencrypted.seckey" "pki-password.txt") @@ -383,7 +391,7 @@ \uid -> Right (uid :: UserId) == runGet get (runPut (put uid)) ] -cgp :: DC.Conduit B.ByteString (ResourceT IO) Pkt +cgp :: DC.ConduitT B.ByteString Pkt (ResourceT IO) () cgp = conduitGet (get :: Get Pkt) fp :: Text -> TwentyOctetFingerprint @@ -391,6 +399,7 @@ doPkeyAndSkeyMatch :: PKey -> SKey -> Assertion doPkeyAndSkeyMatch (RSAPubKey (RSA_PublicKey rpub)) (RSAPrivateKey (RSA_PrivateKey rpriv)) = assertEqual "RSA private key matches RSA public key" rpub (RSA.private_pub rpriv) +doPkeyAndSkeyMatch (ECDSAPubKey (ECDSA_PublicKey ecpub)) (ECDSAPrivateKey (ECDSA_PrivateKey ecpriv)) = assertEqual "ECDSA private key curve matches ECDSA public key curve" (ECDSA.public_curve ecpub) (ECDSA.private_curve ecpriv) doPkeyAndSkeyMatch _ _ = assertFailure "matching unimplemented" main :: IO ()