hOpenPGP 1.1 → 1.2

raw patch · 9 files changed

+49/−28 lines, 9 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Arbitrary.hs +26/−13
• Codec/Encryption/OpenPGP/Fingerprint.hs +6/−6
• Codec/Encryption/OpenPGP/Serialize.hs +2/−0
• Codec/Encryption/OpenPGP/Signatures.hs +6/−3
• Codec/Encryption/OpenPGP/Types.hs +2/−2
• Data/Conduit/OpenPGP/Keyring/Instances.hs +2/−1
• hOpenPGP.cabal +3/−2
• tests/data/sigs-with-regexes binary
• tests/suite.hs +2/−1

@@ -58,27 +58,31 @@         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]+    arbitrary = oneof [sct, set, ec, ts, re, ket, psa, rk, i, nd, phas, pcas, ksps, pks, puid, purl, kfs, suid, rfr, fs, st {-, es -}]         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+            re = arbitrary >>= return . RegularExpression             ket = arbitrary >>= return . KeyExpirationTime             psa = arbitrary >>= return . PreferredSymmetricAlgorithms-            rk = arbitrary >>= \rcs -> arbitrary >>= \pka -> arbitrary >>= \tof -> return (RevocationKey rcs pka tof) -- FIXME: figure out why RevocationClass fails to serialize properly+            rk = arbitrary >>= \rcs -> arbitrary >>= \pka -> arbitrary >>= \tof -> return (RevocationKey rcs pka tof)             i = arbitrary >>= return . Issuer-            nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv) -- FIXME: figure out why NotationData fails to serialize properly+            nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv)             phas = arbitrary >>= return . PreferredHashAlgorithms             pcas = arbitrary >>= return . PreferredCompressionAlgorithms-            ksps = arbitrary >>= return . KeyServerPreferences -- FIXME: figure out why KeyServerPreferences fails to serialize properly+            ksps = arbitrary >>= return . KeyServerPreferences             pks = arbitrary >>= return . PreferredKeyServer-	    puid = arbitrary >>= return . PrimaryUserId-	    purl = arbitrary >>= return . PolicyURL-	    kfs = arbitrary >>= return . KeyFlags-	    suid = arbitrary >>= return . SignersUserId-	    -- FIXME: finish this+            puid = arbitrary >>= return . PrimaryUserId+            purl = arbitrary >>= return . PolicyURL+            kfs = arbitrary >>= return . KeyFlags+            suid = arbitrary >>= return . SignersUserId+            rfr = arbitrary >>= \rc -> arbitrary >>= \rr -> return (ReasonForRevocation rc rr)+            fs = arbitrary >>= return . Features+            st = arbitrary >>= \pka -> arbitrary >>= \ha -> arbitrary >>= \sh -> return (SignatureTarget pka ha sh)+            es = arbitrary >>= return . EmbeddedSignature -- FIXME: figure out why EmbeddedSignature fails to serialize properly+            -- FIXME: finish this  -- @@ -107,13 +111,13 @@     arbitrary = frequency [(9,srk),(1,rco)]         where             srk = return SensitiveRK-            rco = arbitrary >>= return . RClOther+            rco = choose (2,7) >>= return . RClOther  instance Arbitrary NotationFlag where     arbitrary = frequency [(9,hr),(1,onf)]         where             hr = return HumanReadable-            onf = arbitrary >>= return . OtherNF+            onf = choose (1,31) >>= return . OtherNF  instance Arbitrary CompressionAlgorithm where     arbitrary = elements [Uncompressed,ZIP,ZLIB,BZip2]@@ -122,7 +126,16 @@     arbitrary = frequency [(9,nm),(1,kspo)]         where             nm = return NoModify-            kspo = arbitrary >>= return . KSPOther+            kspo = choose (2,63) >>= return . KSPOther  instance Arbitrary KeyFlag where     arbitrary = elements [GroupKey, AuthKey, SplitKey, EncryptStorageKey, EncryptCommunicationsKey, SignDataKey, CertifyKeysKey]++instance Arbitrary RevocationCode where+    arbitrary = elements [NoReason, KeySuperseded, KeyMaterialCompromised, KeyRetiredAndNoLongerUsed, UserIdInfoNoLongerValid]++instance Arbitrary FeatureFlag where+    arbitrary = frequency [(9,md),(1,fo)]+        where+            md = return ModificationDetection+            fo = choose (8,63) >>= return . FeatureOther

@@ -18,12 +18,12 @@ import Codec.Encryption.OpenPGP.Internal (integerToBEBS) import Codec.Encryption.OpenPGP.Types -eightOctetKeyID :: PKPayload -> EightOctetKeyId-eightOctetKeyID (PKPayload DeprecatedV3 _ _ RSA (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp-eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSAEncryptOnly (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp-eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSASignOnly (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp-eightOctetKeyID p4@(PKPayload V4 _ _ _ _) = (EightOctetKeyId . B.drop 12 . unTOF . fingerprint) p4-eightOctetKeyID _ = error "This should never happen (eightOctetKeyID)."+eightOctetKeyID :: PKPayload -> Either String EightOctetKeyId+eightOctetKeyID (PKPayload DeprecatedV3 _ _ RSA (RSAPubKey rp)) = (Right . EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp+eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSAEncryptOnly (RSAPubKey rp)) = (Right . EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp+eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSASignOnly (RSAPubKey rp)) = (Right . EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp+eightOctetKeyID (PKPayload DeprecatedV3 _ _ _ _) = Left "Cannot calculate the key ID of a non-RSA V3 key"+eightOctetKeyID p4@(PKPayload V4 _ _ _ _) = (Right . EightOctetKeyId . B.drop 12 . unTOF . fingerprint) p4  fingerprint :: PKPayload -> TwentyOctetFingerprint fingerprint p3@(PKPayload DeprecatedV3 _ _ _ _) = (TwentyOctetFingerprint . MD5.hash) (runPut $ putPKPforFingerprinting (PublicKeyPkt p3))

@@ -181,6 +181,8 @@                        return $ SigSubPacket crit (TrustSignature tl ta)             | pt == 6 = do                        apdre <- getByteString (l - 2)+		       nul <- getWord8+		       guard (nul == 0)                        return $ SigSubPacket crit (RegularExpression (B.copy apdre))             | pt == 7 = do                        r <- get

@@ -10,6 +10,8 @@  , verifyTKWith ) where +import Control.Applicative ((<$>),(<*>))+import Control.Error.Util (hush) import Control.Lens ((^.), _1) import Control.Monad (liftM2) @@ -38,8 +40,9 @@     _ <- mapM_ (checkIssuer (eightOctetKeyID (v^.verificationSigner)) . _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 :: Either String EightOctetKeyId -> SigSubPacketPayload -> Either String Bool+        checkIssuer (Right signer) (Issuer i) = if signer == i then Right True else Left "issuer subpacket does not match"+        checkIssuer (Left err) (Issuer _) = Left $ "issuer subpacket cannot be checked (" ++ err ++ ")"         checkIssuer _ _ = Right True verifySigWith _ _ _ _ = Left "This should never happen (verifySigWith)." @@ -108,7 +111,7 @@  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 -> (x ^. tkKey._1):map subPKP (_tkSubs x)) ks)+    let allrelevantpkps = filter (\x -> ((==) <$> issuer sig <*> hush (eightOctetKeyID x)) == Just True) (concatMap (\x -> (x ^. tkKey._1):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))

@@ -94,7 +94,7 @@     toFVal o = OtherSA o  data NotationFlag = HumanReadable-                  | OtherNF Word32+                  | OtherNF Word8 -- FIXME: this should be constrained to 4 bits?      deriving (Data, Show, Typeable)  instance Eq NotationFlag where@@ -305,7 +305,7 @@     toFFlag i = KFOther (fromIntegral i)  data RevocationClass = SensitiveRK-                     | RClOther Word8+                     | RClOther Word8 -- FIXME: this should be constrained to 3 bits     deriving (Data, Show, Typeable)  instance Eq RevocationClass where

@@ -13,6 +13,7 @@  import Control.Lens ((^.), (^..), _1, folded) import Data.Data.Lens (biplate)+import Data.Either (rights)  instance Indexable TK where     empty = ixSet@@ -23,7 +24,7 @@                 ]  getEOKIs :: TK -> [EightOctetKeyId]-getEOKIs tk = map eightOctetKeyID (tk ^.. biplate :: [PKPayload])+getEOKIs tk = rights (map eightOctetKeyID (tk ^.. biplate :: [PKPayload])) getTOFs :: TK -> [TwentyOctetFingerprint] getTOFs tk = map fingerprint (tk ^.. biplate :: [PKPayload]) getUIDs :: TK -> [String]

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             1.1+Version:             1.2 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -139,6 +139,7 @@   , tests/data/v3-genericcert.sig   , tests/data/revoked.pubkey   , tests/data/expired.pubkey+  , tests/data/sigs-with-regexes  Cabal-version:       >= 1.10 @@ -244,4 +245,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v1.1+  tag:      v1.2

binary file changed (absent → 256 bytes)

@@ -80,7 +80,7 @@     bs <- B.readFile $ "tests/data/" ++ fpr     case runGet (get :: Get Pkt) bs of         Left _ -> assertFailure $ "Decoding of " ++ fpr ++ " broke."-        Right (PublicKeyPkt pkp) -> assertEqual ("for " ++ fpr) kf (show (eightOctetKeyID pkp) ++ "/" ++ show (fingerprint pkp))+        Right (PublicKeyPkt pkp) -> assertEqual ("for " ++ fpr) kf (either (const "unknown") show (eightOctetKeyID pkp) ++ "/" ++ show (fingerprint pkp))         _ -> assertFailure "Expected public key, got something else."  testKeyringLookup :: FilePath -> String -> Bool -> Assertion@@ -246,6 +246,7 @@    , testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg")    , testCase "simple.seckey" (testSerialization "simple.seckey")    , testCase "v3-genericcert.sig" (testSerialization "v3-genericcert.sig")+   , testCase "sigs-with-regexes" (testSerialization "sigs-with-regexes")    ],   testGroup "KeyID/fingerprint group" [      testCase "v3 key" (testKeyIDandFingerprint "v3.key" "C7261095/CBD9 F412 6807 E405 CC2D  2712 1DF5 E86E  ")