hOpenPGP 1.0.1 → 1.0.2
raw patch · 2 files changed
+44/−14 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Conduit.OpenPGP.Keyring: instance Show UidOrUat
Files
- Data/Conduit/OpenPGP/Keyring.hs +42/−12
- hOpenPGP.cabal +2/−2
Data/Conduit/OpenPGP/Keyring.hs view
@@ -9,7 +9,7 @@ , sinkKeyringMap ) where -import Control.Applicative (many, some, (<$>), (<*>), (<|>), (<*))+import Control.Applicative (many, (<$>), (<|>)) import Data.Conduit import qualified Data.Conduit.List as CL import Data.IxSet (empty, insert)@@ -47,20 +47,22 @@ notTrustPacket _ = True parseAChunk :: (Monoid s, Show s) => Parser s r -> s -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r)) -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])-parseAChunk op a ([], Nothing) = error $ "Failure before " ++ show a+parseAChunk _ a ([], Nothing) = error $ "Failure before " ++ show a parseAChunk op a (cr, Nothing) = (inspect (feed (mconcat (map snd cr) <> a) op), map fst cr)-parseAChunk _ a (cr, Just (_, p)) = (inspect (feed a p), [])+parseAChunk _ a (_, Just (_, p)) = (inspect (feed a p), []) finalizeParsing :: Monoid s => ([(r, s)], Maybe (Maybe (r -> r), Parser s r)) -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) finalizeParsing ([], Nothing) = error $ "Unexpected finalization failure" finalizeParsing (cr, Nothing) = (([], Nothing), map fst cr)-finalizeParsing (cr, Just (_, p)) = finalizeParsing (inspect (feedEof p))+finalizeParsing (_, Just (_, p)) = finalizeParsing (inspect (feedEof p)) parseTK :: Bool -> Parser [Pkt] (Maybe TK) parseTK True = publictk True <|> secrettk True parseTK False = publictk False <|> secrettk False <|> brokentk 6 <|> brokentk 5 data UidOrUat = I String | A [UserAttrSubPacket]+ deriving Show+ splitUs :: [(UidOrUat, [SignaturePayload])] -> ([(String, [SignaturePayload])], [([UserAttrSubPacket], [SignaturePayload])]) splitUs us = (is, as) where@@ -71,25 +73,43 @@ isA ((A _), _) = True isA _ = False unI ((I x), y) = (x, y)+ unI x = error $ "unI should never be called on " ++ show x unA ((A x), y) = (x, y)+ unA x = error $ "unA should never be called on " ++ show x publictk, secrettk :: Bool -> Parser [Pkt] (Maybe TK) publictk intolerant = do pkp <- pkpayload pkpsigs <- concatMany (signature intolerant [KeyRevocationSig,SignatureDirectlyOnAKey]) (uids, uats) <- fmap splitUs (many (signeduid intolerant <|> signeduat intolerant)) -- FIXME: require >=1 uid if intolerant- subs <- many (signedorrevokedpubsubkey intolerant)+ subs <- concatMany (pubsub intolerant) return $! Just (TK pkp pkpsigs uids uats subs)+ where+ pubsub True = signedorrevokedpubsubkey True+ pubsub False = signedorrevokedpubsubkey False <|> brokenpubsubkey secrettk intolerant = do skp <- skpayload skpsigs <- concatMany (signature intolerant [KeyRevocationSig,SignatureDirectlyOnAKey]) (uids, uats) <- fmap splitUs (many (signeduid intolerant <|> signeduat intolerant)) -- FIXME: require >=1 uid if intolerant?- subs <- many (raworsignedorrevokedsecsubkey intolerant)+ subs <- concatMany (secsub intolerant) return $! Just (TK skp skpsigs uids uats subs)+ where+ secsub True = raworsignedorrevokedsecsubkey True+ secsub False = raworsignedorrevokedsecsubkey False <|> brokensecsubkey brokentk :: Int -> Parser [Pkt] (Maybe TK)-brokentk 6 = const Nothing <$> broken 6 <* many (signature False [KeyRevocationSig,SignatureDirectlyOnAKey]) <* many (signeduid False) <* many (signeduat False) <* many (signedorrevokedpubsubkey False)-brokentk 5 = const Nothing <$> broken 5 <* many (signature False [KeyRevocationSig,SignatureDirectlyOnAKey]) <* many (signeduid False) <* many (signeduat False) <* many (raworsignedorrevokedsecsubkey False)+brokentk 6 = do+ _ <- broken 6+ _ <- many (signature False [KeyRevocationSig,SignatureDirectlyOnAKey])+ _ <- many (signeduid False <|> signeduat False)+ _ <- concatMany (signedorrevokedpubsubkey False <|> brokenpubsubkey)+ return Nothing+brokentk 5 = do+ _ <- broken 5+ _ <- many (signature False [KeyRevocationSig,SignatureDirectlyOnAKey])+ _ <- many (signeduid False <|> signeduat False)+ _ <- concatMany (raworsignedorrevokedsecsubkey False <|> brokensecsubkey)+ return Nothing brokentk _ = fail "Unexpected broken packet type" pkpayload :: Parser [Pkt] (PKPayload, Maybe SKAddendum)@@ -129,21 +149,31 @@ isUAt [UserAttributePkt _] = True isUAt _ = False -signedorrevokedpubsubkey :: Bool -> Parser [Pkt] (Pkt, [SignaturePayload])+signedorrevokedpubsubkey :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])] signedorrevokedpubsubkey intolerant = do [p] <- satisfy isPSKP sigs <- concatMany (signature intolerant [SubkeyBindingSig, SubkeyRevocationSig])- return (p, sigs)+ return [(p, sigs)] where isPSKP [PublicSubkeyPkt _] = True isPSKP _ = False -raworsignedorrevokedsecsubkey :: Bool -> Parser [Pkt] (Pkt, [SignaturePayload])+brokenpubsubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])]+brokenpubsubkey = do _ <- broken 14+ _ <- concatMany (signature False [SubkeyBindingSig, SubkeyRevocationSig])+ return []++raworsignedorrevokedsecsubkey :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])] raworsignedorrevokedsecsubkey intolerant = do [p] <- satisfy isSSKP sigs <- concatMany (signature intolerant [SubkeyBindingSig, SubkeyRevocationSig])- return (p, sigs)+ return [(p, sigs)] where isSSKP [SecretSubkeyPkt _ _] = True isSSKP _ = False++brokensecsubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])]+brokensecsubkey = do _ <- broken 7+ _ <- concatMany (signature False [SubkeyBindingSig, SubkeyRevocationSig])+ return [] skpayload :: Parser [Pkt] (PKPayload, Maybe SKAddendum) skpayload = do [SecretKeyPkt p ska] <- satisfy isSKP
hOpenPGP.cabal view
@@ -1,5 +1,5 @@ Name: hOpenPGP-Version: 1.0.1+Version: 1.0.2 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880) Homepage: http://floss.scru.org/hOpenPGP/@@ -244,4 +244,4 @@ source-repository this type: git location: git://git.debian.org/users/clint/hOpenPGP.git- tag: v1.0.1+ tag: v1.0.2