hOpenPGP 0.13.1 → 0.14

raw patch · 4 files changed

+54/−22 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Serialize.hs +14/−12
• Codec/Encryption/OpenPGP/Types.hs +25/−6
• Data/Conduit/OpenPGP/Keyring.hs +13/−2
• hOpenPGP.cabal +2/−2

@@ -507,7 +507,7 @@ getPkt = do     (t, pl) <- getPacketTypeAndPayload     case runGet (getPkt' t (B.length pl)) pl of-        Left e -> fail e+        Left e -> return $! BrokenPacketPkt e t pl         Right p -> return p     where         getPkt' :: Word8 -> Int -> Get Pkt@@ -519,13 +519,13 @@                           remainder <- remaining                           mpib <- getBytes remainder                           case runGet (many getMPI) mpib of-                              Left e -> error e+                              Left e -> fail ("PKESK MPIs " ++ e)                               Right sk -> return $ PKESKPkt pv (EightOctetKeyId eokeyid) (toFVal pkalgo) sk             | t == 2 = do                           remainder <- remaining                           bs <- getBytes remainder                           case runGet get bs of-                              Left e -> error e+                              Left e -> fail ("signature packet " ++ e)                               Right sp -> return $ SignaturePkt sp             | t == 3 = do                           pv <- getWord8@@ -548,7 +548,7 @@                                                        ska <- getSKAddendum pkp                                                        return $ SecretKeyPkt pkp ska                           case ps of-                              Left err -> error err+                              Left err -> fail ("secret key " ++ err)                               Right key -> return key             | t == 6 = do                           pkp <- getPKPayload@@ -559,7 +559,7 @@                                                        ska <- getSKAddendum pkp                                                        return $ SecretSubkeyPkt pkp ska                           case ps of-                              Left err -> error err+                              Left err -> fail ("secret subkey " ++ err)                               Right key -> return key             | t == 8 = do                           ca <- getWord8@@ -590,7 +590,7 @@             | t == 17 = do                         bs <- getBytes len                         case runGet (many getUserAttrSubPacket) bs of-                            Left err -> error err+                            Left err -> fail ("user attribute " ++ err)                             Right uas -> return $ UserAttributePkt uas             | t == 18 = do                           pv <- getWord8 -- should be 1@@ -745,10 +745,11 @@     putWord8 (0xc0 .|. t) -- FIXME: restrict t     putPacketLength . fromIntegral . B.length $ payload     putByteString payload+putPkt (BrokenPacketPkt _ t payload) = putPkt (OtherPacketPkt t payload)  getMPI :: Get MPI getMPI = do mpilen <- getWord16be-            bs <- getByteString ((fromIntegral (mpilen - 1) `div` 8) + 1)+            bs <- getByteString (fromIntegral (mpilen + 7) `div` 8)             return $ MPI (beBSToInteger bs)  getPubkey :: PubKeyAlgorithm -> Get PKey@@ -767,9 +768,10 @@                                 MPI g <- get                                 MPI y <- get                                 return $ ElGamalPubKey [p,g,y]-getPubkey t = fail ("Unsupported pubkey type " ++ show t)+getPubkey _ = UnknownPKey <$> (getByteString =<< remaining)  putPubkey :: PKey -> Put+putPubkey (UnknownPKey bs) = put bs putPubkey p = mapM_ put (pubkeyToMPIs p)  getSecretKey :: PKPayload -> Get SKey@@ -1155,7 +1157,7 @@             remainder <- remaining             mpib <- getBytes remainder             case runGet (many getMPI) mpib of-                Left e -> error e+                Left e -> fail ("v3 sig MPIs " ++ e)                 Right mpis -> return $ SigV3 (toFVal st) ctime (EightOctetKeyId eok) (toFVal pka) (toFVal ha) left16 mpis         4 -> do             st <- getWord8@@ -1164,18 +1166,18 @@             hlen <- getWord16be             hb <- getBytes (fromIntegral hlen)             let hashed = case runGet (many getSigSubPacket) hb of-                            Left err -> error err+                            Left err -> fail ("v4 sig hasheds " ++ err)                             Right h -> h             ulen <- getWord16be             ub <- getBytes (fromIntegral ulen)             let unhashed = case runGet (many getSigSubPacket) ub of-                            Left err -> error err+                            Left err -> fail ("v4 sig unhasheds " ++ err)                             Right u -> u             left16 <- getWord16be             remainder <- remaining             mpib <- getBytes remainder             case runGet (many getMPI) mpib of-                    Left e -> error e+                    Left e -> fail ("v4 sig MPIs " ++ e)                     Right mpis -> return $ SigV4 (toFVal st) (toFVal pka) (toFVal ha) hashed unhashed left16 mpis         _ -> do             remainder <- remaining

@@ -1,5 +1,5 @@ -- Types.hs: OpenPGP (RFC4880) data types--- 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). @@ -18,6 +18,8 @@ import Data.Data (Data) import Data.IxSet (IxSet) import Data.List.Split (chunksOf)+import Data.Monoid ((<>))+import Data.Ord (comparing) import Data.Set (Set) import Data.Typeable (Typeable) import Data.Word (Word8, Word16, Word32)@@ -381,8 +383,7 @@     , _v3exp :: V3Expiration     , _pkalgo :: PubKeyAlgorithm     , _pubkey :: PKey-    }-    deriving (Data, Eq, Show, Typeable)+    } deriving (Data, Eq, Show, Typeable)  instance Ord PKPayload where     compare a b = show a `compare` show b -- FIXME: this is ridiculous@@ -505,14 +506,19 @@     toFVal 0x50 = ThirdPartyConfirmationSig     toFVal o = OtherSig o +instance Ord DSA.PublicKey+instance Ord RSA.PublicKey+ data PKey = RSAPubKey RSA.PublicKey           | DSAPubKey DSA.PublicKey           | ElGamalPubKey [Integer]-    deriving (Data, Eq, Show, Typeable)+	  | UnknownPKey ByteString+    deriving (Data, Eq, Ord, Show, Typeable)  data SKey = RSAPrivateKey RSA.PrivateKey           | DSAPrivateKey DSA.PrivateKey           | ElGamalPrivateKey [Integer]+	  | UnknownSKey ByteString     deriving (Data, Eq, Show, Typeable)  newtype Block a = Block {unBlock :: [a]} -- so we can override cereal instance@@ -552,7 +558,7 @@   } deriving (Data, Eq, Show, Typeable)  instance Ord TK where-    compare a b = show a `compare` show b -- FIXME: this is ridiculous+    compare = comparing _tkPKP -- FIXME: is this ridiculous?  type Keyring = IxSet TK @@ -582,7 +588,8 @@          | SymEncIntegrityProtectedDataPkt PacketVersion ByteString          | ModificationDetectionCodePkt ByteString          | OtherPacketPkt Word8 ByteString-    deriving (Show, Eq, Data, Typeable) -- FIXME+         | BrokenPacketPkt String Word8 ByteString+    deriving (Data, Eq, Show, Typeable) -- FIXME  pktTag :: Pkt -> Word8 pktTag (PKESKPkt {}) = 1@@ -802,6 +809,18 @@     packetCode _ = undefined -- FIXME     toPkt (OtherPacket a b) = OtherPacketPkt a b     fromPkt (OtherPacketPkt a b) = OtherPacket a b++data BrokenPacket = BrokenPacket+    { _brokenPacketParseError :: String+    , _brokenPacketType :: Word8+    , _brokenPacketPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet BrokenPacket where+    data PacketType BrokenPacket = BrokenPacketType deriving (Show, Eq)+    packetType _ = BrokenPacketType+    packetCode _ = undefined+    toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c+    fromPkt (BrokenPacketPkt a b c) = BrokenPacket a b c  data Verification = Verification {       _verificationSigner :: PKPayload

@@ -19,7 +19,7 @@ import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () -data Phase = MainKey | Revs | Uids | UAts | Subs+data Phase = MainKey | Revs | Uids | UAts | Subs | SkippingBroken     deriving (Eq, Ord, Show)  conduitToTKs :: MonadResource m => Conduit Pkt m TK@@ -47,6 +47,8 @@         push i s = case (s, i) of                        ((MainKey, _), PublicKeyPkt pkp) -> ((Revs, Just (TK pkp Nothing [] [] [] [])), [])                        ((MainKey, _), SecretKeyPkt pkp ska) -> ((Revs, Just (TK pkp (Just ska) [] [] [] [])), [])+                       ((MainKey, _), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), [])+                       ((MainKey, _), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), [])                        ((Revs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((Revs, Just (TK pkp Nothing (revs ++ [sp]) uids uats subs)), [])                        ((Revs, Just (TK pkp Nothing revs _ uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs [(u, [])] uats subs)), [])                        ((Uids, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((Uids, Just (TK pkp Nothing revs (addUidSig sp uids) uats subs)), [])@@ -54,17 +56,20 @@                        ((Uids, Just (TK pkp Nothing revs uids _ subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp Nothing revs uids [(u, [])] subs)), [])                        ((Uids, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])), [])                        ((Uids, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs])+                       ((Uids, Just (TK pkp Nothing revs uids uats subs)), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), [TK pkp Nothing revs uids uats subs])                        ((UAts, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((UAts, Just (TK pkp Nothing revs uids (addUAtSig sp uats) subs)), [])                        ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp Nothing revs uids (uats ++ [(u, [])]) subs)), [])                        ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs (uids ++ [(u, [])]) uats subs)), [])                        ((UAts, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])), [])                        ((UAts, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs])+                       ((UAts, Just (TK pkp Nothing revs uids uats subs)), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), [TK pkp Nothing revs uids uats subs])                        ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats (subs ++ [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)]))), [])                        ((Subs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> case sigType sp of                                                                                 Just SubkeyBindingSig -> ((Subs, Just (TK pkp Nothing revs uids uats (setBSig sp subs))), [])                                                                                 Just SubkeyRevocationSig -> ((Subs, Just (TK pkp Nothing revs uids uats (setRSig sp subs))), [])                                                                                 _ -> dropOrError intolerant s $ "Unexpected subkey sig: " ++ show (fst s) ++ "/" ++ show i                        ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs])+                       ((Subs, Just (TK pkp Nothing revs uids uats subs)), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), [TK pkp Nothing revs uids uats subs])                        ((Revs, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((Revs, Just (TK pkp mska (revs ++ [sp]) uids uats subs)), [])                        ((Revs, Just (TK pkp mska revs _ uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs [(u, [])] uats subs)), [])                        ((Uids, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((Uids, Just (TK pkp mska revs (addUidSig sp uids) uats subs)), [])@@ -72,17 +77,23 @@                        ((Uids, Just (TK pkp mska revs uids _ subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp mska revs uids [(u, [])] subs)), [])                        ((Uids, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)])), [])                        ((Uids, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p sk) -> ((Revs, Just (TK p (Just sk) [] [] [] [])), [TK pkp mska revs uids uats subs])+                       ((Uids, Just (TK pkp mska revs uids uats subs)), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), [TK pkp mska revs uids uats subs])                        ((UAts, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((UAts, Just (TK pkp mska revs uids (addUAtSig sp uats) subs)), [])                        ((UAts, Just (TK pkp mska revs uids uats subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp mska revs uids (uats ++ [(u, [])]) subs)), [])                        ((UAts, Just (TK pkp mska revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs (uids ++ [(u, [])]) uats subs)), [])                        ((UAts, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)])), [])                        ((UAts, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p ss) -> ((Revs, Just (TK p (Just ss) [] [] [] [])), [TK pkp mska revs uids uats subs])+                       ((UAts, Just (TK pkp mska revs uids uats subs)), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), [TK pkp mska revs uids uats subs])                        ((Subs, Just (TK pkp mska revs uids uats subs)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats (subs ++ [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)]))), [])                        ((Subs, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> case sigType sp of                                                                                 Just SubkeyBindingSig -> ((Subs, Just (TK pkp mska revs uids uats (setBSig sp subs))), [])                                                                                 Just SubkeyRevocationSig -> ((Subs, Just (TK pkp mska revs uids uats (setRSig sp subs))), [])                                                                                 _ -> dropOrError intolerant s $ "Unexpected subkey sig: " ++ show (fst s) ++ "/" ++ show i-                       ((Subs, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p sk) -> ((Revs, Just (TK p (Just sk) [] [] [] [])), [TK pkp mska revs uids uats subs])+                       ((Subs, Just tk), SecretKeyPkt p sk) -> ((Revs, Just (TK p (Just sk) [] [] [] [])), [tk])+                       ((Subs, Just tk), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), [tk])+                       ((SkippingBroken, _), PublicKeyPkt pkp) -> ((Revs, Just (TK pkp Nothing [] [] [] [])), [])+                       ((SkippingBroken, _), SecretKeyPkt pkp ska) -> ((Revs, Just (TK pkp (Just ska) [] [] [] [])), [])+                       ((SkippingBroken, _), _) -> (s, [])                        ((_,_), TrustPkt _) -> (s, [])                        _ -> dropOrError intolerant s $ "Unexpected packet: " ++ show (fst s) ++ "/" ++ show i         addUidSig s uids = init uids ++ [(\(u, us) -> (u, us ++ [s])) (last uids)]

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.13.1+Version:             0.14 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -242,4 +242,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v0.13.1+  tag:      v0.14