hOpenPGP 0.11.2 → 0.12

raw patch · 5 files changed

+160/−29 lines, 5 filesdep +QuickCheckdep +quickcheck-instancesdep +tasty-quickcheckPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, quickcheck-instances, tasty-quickcheck

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Arbitrary.hs +90/−0
• Codec/Encryption/OpenPGP/Signatures.hs +41/−22
• Data/Conduit/OpenPGP/Verify.hs +3/−3
• hOpenPGP.cabal +6/−2
• tests/suite.hs +20/−2

@@ -0,0 +1,90 @@+-- Arbitrary.hs: QuickCheck instances+-- Copyright © 2014  Clint Adams+-- This software is released under the terms of the Expat license.+-- (See the LICENSE file).++module Codec.Encryption.OpenPGP.Arbitrary () where++import Codec.Encryption.OpenPGP.Types+import qualified Data.ByteString as B+import Test.QuickCheck (Arbitrary(..), choose, elements, frequency, getPositive, oneof, vector)+import Test.QuickCheck.Instances ()++instance Arbitrary PKESK where+    arbitrary = do pv <- arbitrary+                   eoki <- arbitrary+                   pka <- arbitrary+                   mpis <- arbitrary+                   return $ PKESK pv eoki pka mpis++instance Arbitrary Signature where+    arbitrary = arbitrary >>= return . Signature++instance Arbitrary UserId where+    arbitrary = arbitrary >>= return . UserId++--++instance Arbitrary SignaturePayload where+    arbitrary = frequency [(2,three),(3,four),(1,other)]+        where+            three = do+                st <- arbitrary+                w32 <- arbitrary+                eoki <- arbitrary+                pka <- arbitrary+                ha <- arbitrary+                w16 <- arbitrary+                mpis <- arbitrary+                return (SigV3 st w32 eoki pka ha w16 mpis)+            four = do+                st <- arbitrary+                pka <- arbitrary+                ha <- arbitrary+                has <- arbitrary+                uhas <- arbitrary+                w16 <- arbitrary+                mpis <- arbitrary+                return (SigV4 st pka ha has uhas w16 mpis)+            other = do+                v <- choose (5, maxBound)+                bs <- arbitrary+                return (SigVOther v bs)++instance Arbitrary SigSubPacket where+    arbitrary = do+        crit <- arbitrary+        pl <- arbitrary+        return (SigSubPacket crit pl)++instance Arbitrary SigSubPacketPayload where+    arbitrary = oneof [sct, set, ec, ts, {- re, -} ket, psa]+        where+            sct = arbitrary >>= return . SigCreationTime+            set = arbitrary >>= return . SigExpirationTime+            ec = arbitrary >>= return . ExportableCertification+            ts = arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta)+            re = arbitrary >>= return . RegularExpression -- FIXME: figure out why RegularExpression fails to serialize properly+            ket = arbitrary >>= return . KeyExpirationTime+            psa = arbitrary >>= return . PreferredSymmetricAlgorithms+	    -- FIXME: finish this++--++instance Arbitrary PubKeyAlgorithm where+    arbitrary = elements [RSA, DSA, EC, ECDSA, DH]++instance Arbitrary EightOctetKeyId where+    arbitrary = vector 8 >>= return . EightOctetKeyId . B.pack++instance Arbitrary MPI where+    arbitrary = arbitrary >>= return . MPI . getPositive++instance Arbitrary SigType where+    arbitrary = elements [BinarySig, CanonicalTextSig, StandaloneSig, GenericCert, PersonaCert, CasualCert, PositiveCert, SubkeyBindingSig, PrimaryKeyBindingSig, SignatureDirectlyOnAKey, KeyRevocationSig, SubkeyRevocationSig, CertRevocationSig, TimestampSig, ThirdPartyConfirmationSig]++instance Arbitrary HashAlgorithm where+    arbitrary = elements [DeprecatedMD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224]++instance Arbitrary SymmetricAlgorithm where+    arbitrary = elements [Plaintext, IDEA, TripleDES, CAST5, Blowfish, ReservedSAFER, ReservedDES, AES128, AES192, AES256, Twofish]

@@ -1,12 +1,16 @@ -- Verify.hs: OpenPGP (RFC4880) signature verification--- Copyright © 2012-2013  Clint Adams+-- Copyright © 2012-2014  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).  module Codec.Encryption.OpenPGP.Signatures (    verifySig+ , verifySigWith  , verify+ , verifyAgainstKeyring+ , verifyAgainstKeys  , verifyTK+ , verifyTKWith ) where  import Control.Monad (guard, liftM2)@@ -15,7 +19,6 @@ import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.RSA.PKCS15 as P15 -import Control.Lens ((^.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Either (lefts, rights)@@ -31,19 +34,27 @@ import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () +{-# DEPRECATED verifySig "This function will be removed in favor of verifySigWith verifyAgainstKeyring" #-} verifySig :: Keyring -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here?-verifySig kr sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do-    v <- verify kr sig mt (payloadForSig st state)+verifySig = verifySigWith . verifyAgainstKeyring++verifySigWith :: (Pkt -> Maybe UTCTime -> ByteString -> Either String Verification) -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here?+verifySigWith vf sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do+    v <- vf sig mt (payloadForSig st state)     _ <- mapM_ (checkIssuer (eightOctetKeyID (_verificationSigner v)) . _sspPayload) hs     return v     where         checkIssuer :: EightOctetKeyId -> SigSubPacketPayload -> Either String Bool         checkIssuer signer (Issuer i) = if signer == i then Right True else Left "issuer subpacket does not match"         checkIssuer _ _ = Right True-verifySig _ _ _ _ = Left "This should never happen."+verifySigWith _ _ _ _ = Left "This should never happen." +{-# DEPRECATED verifyTK "This function will be removed in favor of verifyTKWith verifyAgainstKeyring" #-} verifyTK :: Keyring -> Maybe UTCTime -> TK -> Either String TK-verifyTK kr mt key = do+verifyTK = verifyTKWith . verifySigWith . verifyAgainstKeyring++verifyTKWith :: (Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification) -> Maybe UTCTime -> TK -> Either String TK+verifyTKWith vsf mt key = do     revokers <- checkRevokers key     revs <- checkKeyRevocations revokers key     let uids = filter (\(_, sps) -> sps /= []) . checkUidSigs $ _tkUIDs key -- FIXME: check revocations here?@@ -53,18 +64,18 @@     where         checkRevokers = Right . concat . rights . map verifyRevoker . filter isRevokerP . _tkRevs         checkKeyRevocations :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> TK -> Either String [SignaturePayload]-        checkKeyRevocations rs k = Prelude.sequence . concatMap (filterRevs rs) . rights . map (liftM2 fmap (,) (vSig kr)) . _tkRevs $ k+        checkKeyRevocations rs k = Prelude.sequence . concatMap (filterRevs rs) . rights . map (liftM2 fmap (,) vSig) . _tkRevs $ k         checkUidSigs :: [(String, [SignaturePayload])] -> [(String, [SignaturePayload])]-        checkUidSigs = map (\(uid, sps) -> (uid, (rights . map (\sp -> fmap (const sp) (vUid kr (uid, sp)))) sps))+        checkUidSigs = map (\(uid, sps) -> (uid, (rights . map (\sp -> fmap (const sp) (vUid (uid, sp)))) sps))         checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])] -> [([UserAttrSubPacket], [SignaturePayload])]-        checkUAtSigs = map (\(uat, sps) -> (uat, (rights . map (\sp -> fmap (const sp) (vUAt kr (uat, sp)))) sps))+        checkUAtSigs = map (\(uat, sps) -> (uat, (rights . map (\sp -> fmap (const sp) (vUAt (uat, sp)))) sps))         checkSub :: (Pkt, SignaturePayload, Maybe SignaturePayload) -> [(Pkt, SignaturePayload, Maybe SignaturePayload)]         checkSub (pkt, sp, mrp) = if revokedSub pkt mrp then [] else checkSub' pkt sp         revokedSub :: Pkt -> Maybe SignaturePayload -> Bool         revokedSub _ Nothing = False-        revokedSub p (Just rp) = vSubSig kr p rp+        revokedSub p (Just rp) = vSubSig p rp         checkSub' :: Pkt -> SignaturePayload -> [(Pkt, SignaturePayload, Maybe SignaturePayload)]-        checkSub' p sp = guard (vSubSig kr p sp) >> return (p, sp, Nothing)+        checkSub' p sp = guard (vSubSig p sp) >> return (p, sp, Nothing)         getHasheds (SigV4 _ _ _ ha _ _ _) = ha         getHasheds _ = [] 	filterRevs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> (SignaturePayload, Verification) -> [Either String SignaturePayload]@@ -80,26 +91,34 @@         isRevocationKeySSP _ = False         isIssuerSSP (SigSubPacket _ (Issuer _)) = True         isIssuerSSP _ = False-        vUid :: Keyring -> (String, SignaturePayload) -> Either String Verification-        vUid keyring (uid, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserIdPkt uid } mt-        vUAt :: Keyring -> ([UserAttrSubPacket], SignaturePayload) -> Either String Verification-        vUAt keyring (uat, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserAttributePkt uat } mt-        vSig :: Keyring -> SignaturePayload -> Either String Verification-        vSig keyring sp = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key) } mt-        vSubSig :: Keyring -> Pkt -> SignaturePayload -> Bool-        vSubSig keyring sk sp = case verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastSubkey = sk} mt of+        vUid :: (String, SignaturePayload) -> Either String Verification+        vUid (uid, sp) = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserIdPkt uid } mt+        vUAt :: ([UserAttrSubPacket], SignaturePayload) -> Either String Verification+        vUAt (uat, sp) = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserAttributePkt uat } mt+        vSig :: SignaturePayload -> Either String Verification+        vSig sp = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key) } mt+        vSubSig :: Pkt -> SignaturePayload -> Bool+        vSubSig sk sp = case vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastSubkey = sk} mt of                                 Left _ -> False 				Right _ -> True         verifyRevoker :: SignaturePayload -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]         verifyRevoker sp = do-            _ <- vSig kr sp+            _ <- vSig sp             return (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) . filter isRevocationKeySSP $ getHasheds sp) +{-# DEPRECATED verify "This function will be removed in favor of verifyAgainstKeyring" #-} verify :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification-verify kr sig mt payload = do+verify = verifyAgainstKeyring++verifyAgainstKeyring :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification+verifyAgainstKeyring kr sig mt payload = do     i <- maybe (Left "issuer not found") Right (issuer sig)     potentialmatches <- if IxSet.null (kr @= i) then Left "pubkey not found" else Right (kr @= i)-    let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> _tkPKP x:map subPKP (_tkSubs x)) (IxSet.toList potentialmatches))+    verifyAgainstKeys (IxSet.toList potentialmatches) sig mt payload++verifyAgainstKeys :: [TK] -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification+verifyAgainstKeys ks sig mt payload = do+    let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> _tkPKP x:map subPKP (_tkSubs x)) ks)     let results = map (\pkp -> verify' sig pkp (hashalgo sig) (finalPayload sig payload)) allrelevantpkps     case rights results of         [] -> Left (concatMap (++"/") (lefts results))

@@ -1,5 +1,5 @@ -- Verify.hs: OpenPGP (RFC4880) signature verification--- Copyright © 2012-2013  Clint Adams+-- Copyright © 2012-2014  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -12,7 +12,7 @@  import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), emptyPSC) import Codec.Encryption.OpenPGP.Types-import Codec.Encryption.OpenPGP.Signatures (verifySig)+import Codec.Encryption.OpenPGP.Signatures (verifySigWith, verifyAgainstKeyring) import qualified Data.Conduit.List as CL  conduitVerify :: MonadResource m => Keyring -> Maybe UTCTime -> Conduit Pkt m (Either String Verification)@@ -25,7 +25,7 @@         push state pk@(PublicSubkeyPkt _) = (state { lastSubkey = pk }, [])         push state sk@(SecretKeyPkt _ _) = (state { lastPrimaryKey = sk }, [])         push state sk@(SecretSubkeyPkt _ _) = (state { lastSubkey = sk }, [])-        push state sig@(SignaturePkt (SigV4 {})) = (state { lastSig = sig }, [verifySig kr sig state mt])+        push state sig@(SignaturePkt (SigV4 {})) = (state { lastSig = sig }, [verifySigWith (verifyAgainstKeyring kr) sig state mt])         push state (OnePassSignaturePkt _ _ _ _ _ False) = (state, [])         push state _ = (state, [])         normLineEndings = id  -- FIXME

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.11.2+Version:             0.12 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -195,6 +195,7 @@ Test-Suite tests   type:       exitcode-stdio-1.0   main-is:    tests/suite.hs+  other-modules: Codec.Encryption.OpenPGP.Arbitrary   Ghc-options: -Wall   Build-depends: hOpenPGP                , base                  > 4       && < 5@@ -225,6 +226,9 @@                , zlib                , tasty                , tasty-hunit+               , tasty-quickcheck+               , QuickCheck+               , quickcheck-instances                , resourcet              > 0.4 && < 0.5   default-language: Haskell2010 @@ -235,4 +239,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v0.11.2+  tag:      v0.12

@@ -7,12 +7,14 @@  import Test.Tasty (defaultMain, testGroup, TestTree) import Test.Tasty.HUnit (testCase, Assertion, assertFailure, assertEqual)+import Test.Tasty.QuickCheck as QC -import Codec.Encryption.OpenPGP.Serialize ()+import Codec.Encryption.OpenPGP.Arbitrary () import Codec.Encryption.OpenPGP.Compression (decompressPkt, compressPkts) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint) import Codec.Encryption.OpenPGP.SecretKey (decryptPrivateKey, encryptPrivateKey)+import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types import Crypto.PubKey.RSA (PrivateKey(private_pub)) import Data.Conduit.Cereal (conduitGet)@@ -136,7 +138,10 @@   tests :: TestTree-tests = testGroup "unit tests" [+tests = testGroup "Tests" [properties, unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit Tests" [   testGroup "Serialization group" [      testCase "000001-006.public_key" (testSerialization "000001-006.public_key")    , testCase "000002-013.user_id" (testSerialization "000002-013.user_id")@@ -302,6 +307,19 @@      testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyEncryption "unencrypted.seckey" "pki-password.txt")    ]  ]++properties :: TestTree+properties = testGroup "Properties" [qcProps]++qcProps :: TestTree+qcProps = testGroup "(checked by QuickCheck)"+  [ QC.testProperty "PKESK packet serialization-deserialization" $+    \pkesk -> Right (pkesk :: PKESK) == runGet get (runPut (put pkesk))+  , QC.testProperty "Signature packet serialization-deserialization" $+    \sig -> Right (sig :: Signature) == runGet get (runPut (put sig))+  , QC.testProperty "UserId packet serialization-deserialization" $+    \uid -> Right (uid :: UserId) == runGet get (runPut (put uid))+  ]  cgp :: DC.Conduit B.ByteString (DC.ResourceT IO) Pkt cgp = conduitGet (get :: Get Pkt)