hOpenPGP 1.9 → 1.10

raw patch · 6 files changed

+90/−37 lines, 6 filesdep +ansi-wl-pprintbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-wl-pprint

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Serialize.hs +22/−12
• Codec/Encryption/OpenPGP/Types.hs +11/−1
• Data/Conduit/OpenPGP/Filter.hs +45/−20
• hOpenPGP.cabal +6/−3
• tests/data/gnu-dummy-s2k-101-secret-key.gpg binary
• tests/suite.hs +6/−1

@@ -185,8 +185,8 @@                        return $ SigSubPacket crit (TrustSignature tl ta)             | pt == 6 = do                        apdre <- getByteString (l - 2)-		       nul <- getWord8-		       guard (nul == 0)+                       nul <- getWord8+                       guard (nul == 0)                        return $ SigSubPacket crit (RegularExpression (B.copy apdre))             | pt == 7 = do                        r <- get@@ -250,7 +250,7 @@                        hash <- getByteString (l - 3)                        return $ SigSubPacket crit (SignatureTarget pka ha hash)             | pt == 32 = do-		       sp <- get :: Get SignaturePayload+                       sp <- get :: Get SignaturePayload                        return $ SigSubPacket crit (EmbeddedSignature sp)             | pt > 99 && pt < 111 = do                        payload <- getByteString (l - 1)@@ -472,7 +472,10 @@                           salt <- getByteString 8                           count <- getWord8                           return $ IteratedSalted (toFVal ha) salt (decodeIterationCount count)-            | otherwise = error "Unknown S2K"+            | otherwise = do+                          len <- remaining+                          bs <- getByteString len+                          return $ OtherS2K t bs  putS2K :: S2K -> Put putS2K (Simple hashalgo) = error ("confused by simple" ++ show hashalgo)@@ -482,6 +485,7 @@     put ha     putByteString salt     putWord8 $ encodeIterationCount count+putS2K (OtherS2K t bs) = putWord8 t >> putByteString bs  getPacketTypeAndPayload :: Get (Word8, ByteString) getPacketTypeAndPayload = do@@ -846,16 +850,22 @@                 return $ SUUnencrypted sk checksum         255 -> do symenc <- getWord8                   s2k <- getS2K-                  iv <- getByteString (symEncBlockSize . toFVal $ symenc)-                  remainder <- remaining-                  encryptedblock <- getByteString remainder-                  return $ SUS16bit (toFVal symenc) s2k iv encryptedblock+                  case s2k of      -- FIXME: this is a mess+                      OtherS2K _ _ -> return $ SUS16bit (toFVal symenc) s2k B.empty B.empty+                      _ -> do+                              iv <- getByteString (symEncBlockSize . toFVal $ symenc)+                              remainder <- remaining+                              encryptedblock <- getByteString remainder+                              return $ SUS16bit (toFVal symenc) s2k iv encryptedblock         254 -> do symenc <- getWord8                   s2k <- getS2K-                  iv <- getByteString (symEncBlockSize . toFVal $ symenc)-                  remainder <- remaining-                  encryptedblock <- getByteString remainder-                  return $ SUSSHA1 (toFVal symenc) s2k iv encryptedblock+                  case s2k of      -- FIXME: this is a mess+                      OtherS2K _ _ -> return $ SUSSHA1 (toFVal symenc) s2k B.empty B.empty+                      _ -> do+                              iv <- getByteString (symEncBlockSize . toFVal $ symenc)+                              remainder <- remaining+                              encryptedblock <- getByteString remainder+                              return $ SUSSHA1 (toFVal symenc) s2k iv encryptedblock         symenc -> do iv <- getByteString (symEncBlockSize . toFVal $ symenc)                      remainder <- remaining                      encryptedblock <- getByteString remainder

@@ -19,6 +19,7 @@ import Data.Data (Data) import Data.Hashable (Hashable(..)) import Data.IxSet (IxSet)+import Data.List (intercalate) import Data.List.Split (chunksOf) import Data.Monoid ((<>)) import Data.Ord (comparing)@@ -27,6 +28,7 @@ import Data.Typeable (Typeable) import Data.Word (Word8, Word16, Word32) import Numeric (readHex, showHex)+import Text.PrettyPrint.ANSI.Leijen (Pretty(..), (<+>), hsep, space, text)  type TimeStamp = Word32 type Exportability = Bool@@ -619,12 +621,20 @@     deriving (Data, Eq, Generic, Ord, Typeable)  instance Show TwentyOctetFingerprint where-    show = take 50 . concatMap (++" ") . concatMap (++[""]) . chunksOf 5 . chunksOf 4 . w8sToHex . B.unpack . unTOF+    show = w8sToHex . B.unpack . unTOF  instance Read TwentyOctetFingerprint where     readsPrec _ = map ((TwentyOctetFingerprint . B.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ')  instance Hashable TwentyOctetFingerprint++instance Pretty TwentyOctetFingerprint where+    pretty = hsep . intercalate [space] . chunksOf 5 . map text . chunksOf 4 . take 40 . w8sToHex . B.unpack . unTOF++newtype SpacedFingerprint = SpacedFingerprint { unSpacedFingerprint :: TwentyOctetFingerprint }++instance Show SpacedFingerprint where+    show = take 50 . concatMap (++" ") . concatMap (++[""]) . chunksOf 5 . chunksOf 4 . show . unSpacedFingerprint  w8sToHex :: [Word8] -> String w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "")

@@ -3,31 +3,34 @@ -- This software is released under the terms of the Expat license. -- (See the LICENSE file). -{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GADTs, RecordWildCards #-}  module Data.Conduit.OpenPGP.Filter (-   conduitFilter- , conduitPktFilter+   conduitPktFilter  , conduitTKFilter  , FilterPredicates(..)  , Expr(..)- , PKPPredicate(..)  , PKPVar(..)  , PKPOp(..)  , PKPValue(..)- , SPPredicate(..)  , SPVar(..)  , SPOp(..)  , SPValue(..)- , OPredicate(..)  , OVar(..)  , OOp(..)  , OValue(..)  , UPredicate(..)  , UOp(..)+ , Exp(..)+ , unop+ , binop ) where +import Control.Applicative (Applicative, (<$>), (<*>), pure) import Control.Error.Util (hush)+import Control.Monad ((>=>))+import Control.Monad.Loops (allM, anyM)+import Control.Monad.Reader (ask, reader, runReader, Reader) import Control.Monad.Trans.Resource (MonadResource) import qualified Data.ByteString as B import Data.Conduit@@ -40,14 +43,11 @@ import Codec.Encryption.OpenPGP.KeyInfo (pubkeySize) import Codec.Encryption.OpenPGP.Types -{-# DEPRECATED conduitFilter "Use conduitPktFilter instead" #-}-{-# DEPRECATED PKPPredicate, SPPredicate, OPredicate "Use UPredicate instead" #-} -data FilterPredicates = FilterPredicates {-    _pubKeyPktPredicate :: Expr PKPPredicate-  , _sigPktPredicate :: Expr SPPredicate-  , _otherPredicate :: Expr OPredicate-} | UnifiedFilterPredicate (Expr UPredicate)+data FilterPredicates =+    UnifiedFilterPredicate (Expr UPredicate)  -- ^ "old"-style filter predicate, hopefully to be deprecated+  | TransitionalTKFP (Exp (Reader TK) Bool)   -- ^ a more flexible fp for transferable keys+  | TransitionalUFP (Exp (Reader Pkt) Bool)   -- ^ a more flexible fp for context-less packets  data Expr a = EAny             | E a@@ -134,26 +134,25 @@                 | USPP SPVar UOp SPValue                 | UOP OVar UOp OValue -data UOp = UEquals | ULessThan | UGreaterThan+data UOp = UEquals       -- ^ (==)+         | ULessThan     -- ^ (<)+         | UGreaterThan  -- ^ (>)     deriving Enum -conduitFilter :: Monad m => FilterPredicates -> Conduit Pkt m Pkt-conduitFilter = conduitPktFilter- conduitPktFilter :: Monad m => FilterPredicates -> Conduit Pkt m Pkt conduitPktFilter = CL.filter . superPredicate  superPredicate :: FilterPredicates -> Pkt -> Bool-superPredicate fp@FilterPredicates{..} (PublicKeyPkt pkp) = eval pkpEval _pubKeyPktPredicate pkp-superPredicate fp@FilterPredicates{..} (SignaturePkt sp) = eval spEval _sigPktPredicate sp-superPredicate fp@FilterPredicates{..} p = eval oEval _otherPredicate p superPredicate (UnifiedFilterPredicate ufp) p = eval uEval ufp p+superPredicate (TransitionalUFP e) p = runReader (evalM e) p+superPredicate _ _ = False   -- do not match incorrect type of packet  conduitTKFilter :: Monad m => FilterPredicates -> Conduit TK m TK conduitTKFilter = CL.filter . superTKPredicate  superTKPredicate :: FilterPredicates -> TK -> Bool superTKPredicate (UnifiedFilterPredicate ufp) p = eval uEval ufp (PublicKeyPkt (fst (_tkKey p)))  -- FIXME: should operate on more than just the pkp+superTKPredicate (TransitionalTKFP e) k = runReader (evalM e) k  pkpEval :: PKPPredicate -> PKPayload -> Bool pkpEval (PKPPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs)@@ -200,3 +199,29 @@ uEval (USPP l o r) (SignaturePkt s) = spEval (SPPredicate l (toEnum . fromEnum $ o) r)  s uEval (UOP l o r) pkt = oEval (OPredicate l (toEnum . fromEnum $ o) r) pkt uEval _ _ = False  -- do not match packets of wrong type++--++data Exp m a where+    I       :: Integer -> Exp m Integer+    B       :: Bool -> Exp m Bool+    S       :: String -> Exp m String+    Lift    :: b -> Exp m b+    Ap      :: Exp m (b -> c) -> Exp m b -> Exp m c+    AnyAll  :: ((b -> m Bool) -> [b] -> m Bool) -> (b -> Exp m Bool) -> Exp m [b] -> Exp m Bool+    MA      :: m b -> Exp m b++evalM :: (Functor m, Applicative m, Monad m) => Exp m a -> m a+evalM (I n) = return n+evalM (B b) = return b+evalM (S s) = return s+evalM (Lift l) = return l+evalM (MA a) = a+evalM (Ap f a) = evalM f <*> evalM a+evalM (AnyAll aa f l) = evalM l >>= (aa (evalM . f) >=> return)++unop :: (a -> b) -> Exp m a -> Exp m b+unop = Ap . Lift++binop :: (a -> a -> b) -> Exp m a -> Exp m a -> Exp m b+binop = (Ap .) . Ap . Lift

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             1.9+Version:             1.10 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -140,6 +140,7 @@   , tests/data/revoked.pubkey   , tests/data/expired.pubkey   , tests/data/sigs-with-regexes+  , tests/data/gnu-dummy-s2k-101-secret-key.gpg  Cabal-version:       >= 1.10 @@ -167,6 +168,7 @@                , Codec.Encryption.OpenPGP.SerializeForSigs                , Codec.Encryption.OpenPGP.BlockCipher   Build-depends: attoparsec+               , ansi-wl-pprint        >= 0.6.7                , base                  > 4       && < 5                , base64-bytestring                , bytestring@@ -209,8 +211,9 @@   other-modules: Codec.Encryption.OpenPGP.Arbitrary   Ghc-options: -Wall   Build-depends: hOpenPGP-               , base                  > 4       && < 5+               , ansi-wl-pprint        >= 0.6.7                , attoparsec+               , base                  > 4       && < 5                , bytestring                , bzlib                , cereal@@ -255,4 +258,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v1.9+  tag:      v1.10

binary file changed (absent → 280 bytes)

@@ -81,8 +81,12 @@     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 (either (const "unknown") show (eightOctetKeyID pkp) ++ "/" ++ show (fingerprint pkp))+        Right (PublicKeyPkt pkp) -> do+	                               assertEqual ("for " ++ fpr ++ " (spaceless)") (spaceless kf) (either (const "unknown") show (eightOctetKeyID pkp) ++ "/" ++ show (fingerprint pkp))+	                               assertEqual ("for " ++ fpr ++ " (spaced)") kf (either (const "unknown") show (eightOctetKeyID pkp) ++ "/" ++ show (SpacedFingerprint (fingerprint pkp)))         _ -> assertFailure "Expected public key, got something else."+    where+        spaceless = filter (/=' ')  testKeyringLookup :: FilePath -> String -> Bool -> Assertion testKeyringLookup fpr eok expected = do@@ -248,6 +252,7 @@    , testCase "simple.seckey" (testSerialization "simple.seckey")    , testCase "v3-genericcert.sig" (testSerialization "v3-genericcert.sig")    , testCase "sigs-with-regexes" (testSerialization "sigs-with-regexes")+   , testCase "gnu-dummy-s2k-101-secret-key.gpg" (testSerialization "gnu-dummy-s2k-101-secret-key.gpg")    ],   testGroup "KeyID/fingerprint group" [      testCase "v3 key" (testKeyIDandFingerprint "v3.key" "C7261095/CBD9 F412 6807 E405 CC2D  2712 1DF5 E86E  ")