hOpenPGP 0.10.2 → 0.11

raw patch · 6 files changed

+199/−10 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Internal.hs +19/−1
• Codec/Encryption/OpenPGP/Serialize.hs +1/−1
• Codec/Encryption/OpenPGP/Types.hs +20/−0
• Data/Conduit/OpenPGP/Filter.hs +152/−0
• Data/Conduit/OpenPGP/Keyring.hs +4/−6
• hOpenPGP.cabal +3/−2

@@ -1,5 +1,5 @@ -- Internal.hs: private utility functions--- 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). @@ -13,6 +13,9 @@  , emptyPSC  , pubkeyToMPIs  , multiplicativeInverse+ , sigType+ , sigPKA+ , sigHA ) where  import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512, hashDescrRIPEMD160)@@ -83,3 +86,18 @@ multiplicativeInverse _ 1 = 1 multiplicativeInverse q p = (n * q + 1) `div` p     where n = p - multiplicativeInverse p (q `mod` p)++sigType :: SignaturePayload -> Maybe SigType+sigType (SigV3 st _ _ _ _ _ _) = Just st+sigType (SigV4 st _ _ _ _ _ _) = Just st+sigType _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild++sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm+sigPKA (SigV3 _ _ _ pka _ _ _) = Just pka+sigPKA (SigV4 _ pka _ _ _ _ _) = Just pka+sigPKA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild++sigHA :: SignaturePayload -> Maybe HashAlgorithm+sigHA (SigV3 _ _ _ _ ha _ _) = Just ha+sigHA (SigV4 _ _ ha _ _ _ _) = Just ha+sigHA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild

@@ -1,5 +1,5 @@ -- Serialize.hs: OpenPGP (RFC4880) serialization (using cereal)--- 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). 

@@ -584,6 +584,26 @@          | OtherPacketPkt Word8 ByteString     deriving (Show, Eq, Data, Typeable) -- FIXME +pktTag :: Pkt -> Word8+pktTag (PKESKPkt {}) = 1+pktTag (SignaturePkt _) = 2+pktTag (SKESKPkt {}) = 3+pktTag (OnePassSignaturePkt {}) = 4+pktTag (SecretKeyPkt {}) = 5+pktTag (PublicKeyPkt _) = 6+pktTag (SecretSubkeyPkt {}) = 7+pktTag (CompressedDataPkt {}) = 8+pktTag (SymEncDataPkt _) = 9+pktTag (MarkerPkt _) = 10+pktTag (LiteralDataPkt {}) = 11+pktTag (TrustPkt _) = 12+pktTag (UserIdPkt _) = 13+pktTag (PublicSubkeyPkt _) = 14+pktTag (UserAttributePkt _) = 17+pktTag (SymEncIntegrityProtectedDataPkt {}) = 18+pktTag (ModificationDetectionCodePkt _) = 19+pktTag (OtherPacketPkt t _) = t+ data PKESK = PKESK     { _pkeskPacketVersion :: PacketVersion     , _pkeskEightOctetKeyId :: EightOctetKeyId

@@ -0,0 +1,152 @@+-- Filter.hs: OpenPGP (RFC4880) packet filtering+-- Copyright © 2014  Clint Adams+-- This software is released under the terms of the Expat license.+-- (See the LICENSE file).++module Data.Conduit.OpenPGP.Filter (+   conduitFilter+ , FilterPredicates(..)+ , Expr(..)+ , PKPPredicate(..)+ , PKPVar(..)+ , PKPOp(..)+ , PKPValue(..)+ , SPPredicate(..)+ , SPVar(..)+ , SPOp(..)+ , SPValue(..)+ , OPredicate(..)+ , OVar(..)+ , OOp(..)+ , OValue(..)+) where++import qualified Data.ByteString as B+import Data.Conduit+import qualified Data.Conduit.List as CL++import Codec.Encryption.OpenPGP.Internal (sigType, sigPKA, sigHA)+import Codec.Encryption.OpenPGP.KeyInfo (keySize)+import Codec.Encryption.OpenPGP.Types++data FilterPredicates = FilterPredicates {+    _pubKeyPktPredicate :: Expr PKPPredicate+  , _sigPktPredicate :: Expr SPPredicate+  , _otherPredicate :: Expr OPredicate+}++data Expr a = EAny+            | E a+            | EAnd (Expr a) (Expr a)+            | EOr (Expr a) (Expr a)+            | ENot (Expr a)++eval :: (a -> v -> Bool) -> Expr a -> v -> Bool+eval t e v = ev e+  where+        ev EAny = True+        ev (EAnd e1 e2) = ev e1 && ev e2+        ev (EOr e1 e2) =  ev e1 || ev e2+        ev (ENot e1) = (not . ev) e1+        ev (E e') = t e' v++data PKPOp = PKEquals | PKLessThan | PKGreaterThan++data PKPPredicate = PKPPredicate PKPVar PKPOp PKPValue++data PKPVar = PKPVVersion+            | PKPVPKA+            | PKPVKeysize+            | PKPVTimestamp++data PKPValue = PKPInt Int+              | PKPPKA PubKeyAlgorithm+    deriving Eq++instance Ord PKPValue where+    compare i j = compare (pkvToInt i) (pkvToInt j)++pkvToInt (PKPInt i) = i+pkvToInt (PKPPKA i) = fromIntegral (fromFVal i)++data SPOp = SPEquals | SPLessThan | SPGreaterThan++data SPPredicate = SPPredicate SPVar SPOp SPValue++data SPVar = SPVVersion+           | SPVSigType+           | SPVPKA+           | SPVHA++data SPValue = SPInt Int+             | SPSigType SigType+             | SPPKA PubKeyAlgorithm+             | SPHA HashAlgorithm+    deriving Eq++instance Ord SPValue where+    compare i j = compare (spvToInt i) (spvToInt j)++spvToInt (SPInt i) = i+spvToInt (SPSigType i) = fromIntegral (fromFVal i)+spvToInt (SPPKA i) = fromIntegral (fromFVal i)+spvToInt (SPHA i) = fromIntegral (fromFVal i)++data OOp = OEquals | OLessThan | OGreaterThan++data OPredicate = OPredicate OVar OOp OValue++data OVar = OVTag++data OValue = OInt Int+    deriving Eq++instance Ord OValue where+    compare i j = compare (ovToInt i) (ovToInt j)++ovToInt (OInt i) = i++conduitFilter :: MonadResource m => FilterPredicates -> Conduit Pkt m Pkt+conduitFilter = CL.filter . superPredicate++superPredicate :: FilterPredicates -> Pkt -> Bool+superPredicate fp (PublicKeyPkt pkp) = eval pkpEval (_pubKeyPktPredicate fp) pkp+superPredicate fp (SignaturePkt sp) = eval spEval (_sigPktPredicate fp) sp+superPredicate fp p = eval oEval (_otherPredicate fp) p++pkpEval :: PKPPredicate -> PKPayload -> Bool+pkpEval (PKPPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs)+    where+        opreduce PKEquals = (==)+        opreduce PKLessThan = (<)+        opreduce PKGreaterThan = (>)+        vreduce (PKPVVersion, p) = PKPInt (kv (_keyVersion p))+        vreduce (PKPVPKA, p) = PKPPKA (_pkalgo p)+        vreduce (PKPVKeysize, p) = PKPInt (keySize . _pubkey $ p)+        vreduce (PKPVTimestamp, p) = PKPInt (fromIntegral (_timestamp p))+	kv DeprecatedV3 = 3+	kv V4 = 4++spEval :: SPPredicate -> SignaturePayload -> Bool+spEval (SPPredicate lhs o rhs) pkp = case (vreduce (lhs, pkp) >>= \x -> return (uncurry (opreduce o) (x,rhs))) of+                                         Just True -> True+                                         _ -> False+    where+        opreduce SPEquals = (==)+        opreduce SPLessThan = (<)+        opreduce SPGreaterThan = (>)+        vreduce (SPVVersion, s) = Just (SPInt (sigVersion s))+        vreduce (SPVSigType, s) = fmap SPSigType (sigType s)+        vreduce (SPVPKA, s) = fmap SPPKA (sigPKA s)+        vreduce (SPVHA, s) = fmap SPHA (sigHA s)+	sigVersion (SigV3 {}) = 3+	sigVersion (SigV4 {}) = 4+	sigVersion (SigVOther v _) = fromIntegral v++oEval :: OPredicate -> Pkt -> Bool+oEval (OPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs)+    where+        opreduce OEquals = (==)+        opreduce OLessThan = (<)+        opreduce OGreaterThan = (>)+        vreduce (OVTag, p) = OInt (fromIntegral (pktTag p))

@@ -1,5 +1,5 @@ -- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing--- 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). @@ -14,6 +14,7 @@ import qualified Data.Conduit.List as CL import Data.IxSet (empty, insert) +import Codec.Encryption.OpenPGP.Internal (sigType) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () @@ -58,7 +59,7 @@                        ((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])                        ((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 sType sp of+                       ((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@@ -76,7 +77,7 @@                        ((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])                        ((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 sType sp of+                       ((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@@ -87,9 +88,6 @@         addUAtSig s uats = init uats ++ [(\(u, us) -> (u, us ++ [s])) (last uats)]         setBSig s subs = init subs ++ [(\(p, _, r) -> (p, s, r)) (last subs)]         setRSig s subs = init subs ++ [(\(p, b, _) -> (p, b, Just s)) (last subs)]-        sType (SigV3 st _ _ _ _ _ _) = Just st-        sType (SigV4 st _ _ _ _ _ _) = Just st-        sType _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild         dropOrError :: Bool -> (Phase, Maybe TK) -> String -> ((Phase, Maybe TK), [TK])         dropOrError True _ e = error e         dropOrError False s _ = (s, [])

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.10.2+Version:             0.11 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -153,6 +153,7 @@                      , Codec.Encryption.OpenPGP.Signatures                      , Data.Conduit.OpenPGP.Compression                      , Data.Conduit.OpenPGP.Decrypt+                     , Data.Conduit.OpenPGP.Filter                      , Data.Conduit.OpenPGP.Keyring                      , Data.Conduit.OpenPGP.Keyring.Instances                      , Data.Conduit.OpenPGP.Verify@@ -233,4 +234,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v0.10.2+  tag:      v0.11