packages feed

hOpenPGP 2.5.2 → 2.5.3

raw patch · 6 files changed

+50/−43 lines, 6 filesdep ~bytestring

Dependency ranges changed: bytestring

Files

Codec/Encryption/OpenPGP/KeyInfo.hs view
@@ -1,5 +1,5 @@ -- KeyInfo.hs: OpenPGP (RFC4880) fingerprinting methods--- Copyright © 2012-2015  Clint Adams+-- Copyright © 2012-2016  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -10,19 +10,22 @@  import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA-import qualified Data.ByteString as B import Data.Bits (shiftR) import Data.List (unfoldr)  import Codec.Encryption.OpenPGP.Types +pubkeySize :: PKey -> Either String Int pubkeySize (RSAPubKey (RSA_PublicKey x)) = Right (RSA.public_size x * 8) pubkeySize (DSAPubKey (DSA_PublicKey x)) = Right (bitcount . DSA.params_p . DSA.public_params $ x) pubkeySize (ElGamalPubKey p _ _) = Right (bitcount p) pubkeySize x = Left $ "Unable to calculate size of " ++ show x +bitcount :: Integer -> Int bitcount = (*8) . length . unfoldr (\x -> if x == 0 then Nothing else Just (True, x `shiftR` 8)) +-- FIXME: redo these for hOpenPGP 3+pkalgoAbbrev :: PubKeyAlgorithm -> String pkalgoAbbrev RSA = "R" pkalgoAbbrev DSA = "D" pkalgoAbbrev ElgamalEncryptOnly = "g"
Codec/Encryption/OpenPGP/Types/Internal/Base.hs view
@@ -29,9 +29,11 @@ import qualified Data.Aeson.TH as ATH import Data.Byteable (Byteable) import Data.ByteArray (ByteArrayAccess)+import Data.ByteString.Builder (lazyByteStringHex, toLazyByteString) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC8 import Data.Char (toLower, toUpper) import Data.Data (Data) import Data.Hashable (Hashable(..))@@ -54,7 +56,7 @@ import Data.Typeable (Typeable) import Data.Word (Word8, Word16, Word32) import Network.URI (URI(..), uriToString, nullURI, parseURI)-import Numeric (readHex, showHex)+import Numeric (readHex) import Data.Time.Locale.Compat (defaultTimeLocale) import Text.PrettyPrint.Free (Pretty(..), (<+>), char, hsep, punctuate, space, text) @@ -153,7 +155,7 @@     pretty Camellia128 = text "Camellia-128"     pretty Camellia192 = text "Camellia-192"     pretty Camellia256 = text "Camellia-256"-    pretty (OtherSA sa) = text "unknown symmetric algorithm" <+> (text . show) sa+    pretty (OtherSA sa) = text "unknown symmetric algorithm" <+> pretty sa  $(ATH.deriveJSON ATH.defaultOptions ''SymmetricAlgorithm) @@ -291,7 +293,7 @@     pretty ECDSA = text "ECDSA"     pretty ForbiddenElgamal = text "(forbidden) Elgamal"     pretty DH = text "DH"-    pretty pka = text "unknown pubkey algorithm type" <+> (text . show) pka+    pretty (OtherPKA pka) = text "unknown pubkey algorithm type" <+> pretty pka  $(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm) @@ -309,7 +311,7 @@ instance Hashable TwentyOctetFingerprint  instance Pretty TwentyOctetFingerprint where-    pretty = text . take 40 . w8sToHex . BL.unpack . unTOF+    pretty = pretty . take 40 . bsToHexUpper . unTOF  instance A.ToJSON TwentyOctetFingerprint where     toJSON e = object [T.pack "fpr" .= (A.toJSON . show . pretty) e]@@ -325,10 +327,10 @@     unpack (SpacedFingerprint o) = o  instance Pretty SpacedFingerprint where-    pretty = hsep . punctuate space . map hsep . chunksOf 5 . map text . chunksOf 4 . take 40 . w8sToHex . BL.unpack . unTOF . unpack+    pretty = hsep . punctuate space . map hsep . chunksOf 5 . map text . chunksOf 4 . take 40 . bsToHexUpper . unTOF . unpack -w8sToHex :: [Word8] -> String-w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "")+bsToHexUpper :: ByteString -> String+bsToHexUpper = map toUpper . BLC8.unpack . toLazyByteString . lazyByteStringHex  hexToW8s :: ReadS Word8 hexToW8s = concatMap readHex . chunksOf 2 . map toLower@@ -341,7 +343,7 @@     unpack (EightOctetKeyId o) = o  instance Pretty EightOctetKeyId where-    pretty = text . w8sToHex . BL.unpack . unpack+    pretty = pretty . bsToHexUpper . unpack  -- FIXME: read-show instance Read EightOctetKeyId where@@ -350,7 +352,7 @@ instance Hashable EightOctetKeyId  instance A.ToJSON EightOctetKeyId where-    toJSON e = object [T.pack "eoki" .= (w8sToHex . BL.unpack . unpack) e]+    toJSON e = object [T.pack "eoki" .= (bsToHexUpper . unpack) e]  instance A.FromJSON EightOctetKeyId where     parseJSON (A.Object v) = EightOctetKeyId . read <$>@@ -429,7 +431,7 @@     pretty SHA384 = text "SHA-384"     pretty SHA512 = text "SHA-512"     pretty SHA224 = text "SHA-224"-    pretty (OtherHA ha) = text "unknown hash algorithm type" <+> (text . show) ha+    pretty (OtherHA ha) = text "unknown hash algorithm type" <+> pretty ha  $(ATH.deriveJSON ATH.defaultOptions ''HashAlgorithm) @@ -465,7 +467,7 @@     pretty ZIP = text "ZIP"     pretty ZLIB = text "zlib"     pretty BZip2 = text "bzip2"-    pretty (OtherCA ca) = text "unknown compression algorithm type" <+> (text . show) ca+    pretty (OtherCA ca) = text "unknown compression algorithm type" <+> pretty ca  $(ATH.deriveJSON ATH.defaultOptions ''CompressionAlgorithm) @@ -733,8 +735,8 @@ instance Hashable SignaturePayload  instance Pretty SignaturePayload where-    pretty (SigV3 st ts eoki pka ha w16 mpis) = text "signature v3" <> char ':' <+> pretty st <+> pretty ts <+> pretty eoki <+> pretty pka <+> pretty ha <+> pretty w16 <+> (prettyList . NE.toList) mpis-    pretty (SigV4 st pka ha hsps usps w16 mpis) = text "signature v4" <> char ':' <+> pretty st <+> pretty pka <+> pretty ha <+> prettyList hsps <+> prettyList usps <+> pretty w16 <+> (prettyList . NE.toList) mpis+    pretty (SigV3 st ts eoki pka ha w16 mpis) = text "signature v3" <> char ':' <+> pretty st <+> pretty ts <+> pretty eoki <+> pretty pka <+> pretty ha <+> pretty w16 <+> (pretty . NE.toList) mpis+    pretty (SigV4 st pka ha hsps usps w16 mpis) = text "signature v4" <> char ':' <+> pretty st <+> pretty pka <+> pretty ha <+> pretty hsps <+> pretty usps <+> pretty w16 <+> (pretty . NE.toList) mpis     pretty (SigVOther t bs) = text "unknown signature v" <> pretty t <> char ':' <+> pretty (BL.unpack bs)  instance A.ToJSON SignaturePayload where@@ -779,20 +781,20 @@     pretty (RegularExpression apdre) = text "regular expression" <+> pretty apdre     pretty (Revocable r) = text "revocable" <+> pretty r     pretty (KeyExpirationTime d) = text "key expiration time" <+> pretty d-    pretty (PreferredSymmetricAlgorithms sas) = text "preferred symmetric algorithms" <+> prettyList sas-    pretty (RevocationKey rcs pka tof) = text "revocation key" <+> prettyList (Set.toList rcs) <+> pretty pka <+> pretty tof+    pretty (PreferredSymmetricAlgorithms sas) = text "preferred symmetric algorithms" <+> pretty sas+    pretty (RevocationKey rcs pka tof) = text "revocation key" <+> pretty (Set.toList rcs) <+> pretty pka <+> pretty tof     pretty (Issuer eoki) = text "issuer" <+> pretty eoki-    pretty (NotationData nfs nn nv) = text "notation data" <+> prettyList (Set.toList nfs) <+> pretty nn <+> pretty nv-    pretty (PreferredHashAlgorithms phas) = text "preferred hash algorithms" <+> prettyList phas+    pretty (NotationData nfs nn nv) = text "notation data" <+> pretty (Set.toList nfs) <+> pretty nn <+> pretty nv+    pretty (PreferredHashAlgorithms phas) = text "preferred hash algorithms" <+> pretty phas     pretty (PreferredCompressionAlgorithms pcas) = text "preferred compression algorithms" <+> pretty pcas-    pretty (KeyServerPreferences kspfs) = text "keyserver preferences" <+> prettyList (Set.toList kspfs)+    pretty (KeyServerPreferences kspfs) = text "keyserver preferences" <+> pretty (Set.toList kspfs)     pretty (PreferredKeyServer ks) = text "preferred keyserver" <+> pretty ks     pretty (PrimaryUserId p) = (if p then mempty else text "NOT ") <> text "primary user-ID"     pretty (PolicyURL u) = text "policy URL" <+> pretty u-    pretty (KeyFlags kfs) = text "key flags" <+> prettyList (Set.toList kfs)+    pretty (KeyFlags kfs) = text "key flags" <+> pretty (Set.toList kfs)     pretty (SignersUserId u) = text "signer's user-ID" <+> pretty u     pretty (ReasonForRevocation rc rr) = text "reason for revocation" <+> pretty rc <+> pretty rr-    pretty (Features ffs) = text "features" <+> prettyList (Set.toList ffs)+    pretty (Features ffs) = text "features" <+> pretty (Set.toList ffs)     pretty (SignatureTarget pka ha sh) = text "signature target" <+> pretty pka <+> pretty ha <+> pretty sh     pretty (EmbeddedSignature sp) = text "embedded signature" <+> pretty sp     pretty (UserDefinedSigSub t bs) = text "user-defined signature subpacket type" <+> pretty t <+> pretty (BL.unpack bs)@@ -908,7 +910,7 @@     pretty BinaryData = text "binary"     pretty TextData = text "text"     pretty UTF8Data = text "UTF-8"-    pretty (OtherData o) = text "other data type " <+> (text . show) o+    pretty (OtherData o) = text "other data type " <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''DataType) @@ -1009,7 +1011,7 @@  instance Pretty UserAttrSubPacket where     pretty (ImageAttribute ih d) = text "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)-    pretty (OtherUASub t bs) = text "unknown attribute type" <> (text . show) t <+> pretty (BL.unpack bs)+    pretty (OtherUASub t bs) = text "unknown attribute type" <> pretty t <+> pretty (BL.unpack bs)  instance A.ToJSON UserAttrSubPacket where     toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)
Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs view
@@ -44,7 +44,7 @@     pretty (ElGamalPubKey p g y) = text "Elgamal" <+> pretty p <+> pretty g <+> pretty y     pretty (ECDHPubKey p ha sa) = text "ECDH" <+> pretty p <+> pretty ha <+> pretty sa     pretty (ECDSAPubKey p) = text "ECDSA" <+> pretty p-    pretty (UnknownPKey bs) = text "unknown" <+> pretty bs+    pretty (UnknownPKey bs) = text "<unknown>" <+> pretty (bsToHexUpper bs)  instance A.ToJSON PKey where     toJSON (RSAPubKey p) = A.toJSON p@@ -70,7 +70,7 @@     pretty (ElGamalPrivateKey p) = text "Elgamal" <+> pretty p     pretty (ECDHPrivateKey p) = text "ECDH" <+> pretty p     pretty (ECDSAPrivateKey p) = text "ECDSA" <+> pretty p-    pretty (UnknownSKey bs) = text "unknown" <+> pretty bs+    pretty (UnknownSKey bs) = text "<unknown>" <+> pretty (bsToHexUpper bs)  instance A.ToJSON SKey where     toJSON (RSAPrivateKey k) = A.toJSON k
Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs view
@@ -67,10 +67,10 @@     compare = comparing pktTag <> comparing hash -- FIXME: is there something saner?  instance Pretty Pkt where-    pretty (PKESKPkt pv eoki pka mpis) = text "PKESK v" <> (text . show) pv <> char ':' <+> pretty eoki <+> pretty pka <+> (prettyList . NE.toList) mpis+    pretty (PKESKPkt pv eoki pka mpis) = text "PKESK v" <> pretty pv <> char ':' <+> pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis     pretty (SignaturePkt sp) = pretty sp-    pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> (text . show) pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty mbs-    pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = text "one-pass signature v" <> (text . show) pv <> char ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag+    pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> pretty pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty mbs+    pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = text "one-pass signature v" <> pretty pv <> char ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag     pretty (SecretKeyPkt pkp ska) = text "secret key:" <+> pretty pkp <+> pretty ska     pretty (PublicKeyPkt pkp) = text "public key:" <+> pretty pkp     pretty (SecretSubkeyPkt pkp ska) = text "secret subkey:" <+> pretty pkp <+> pretty ska@@ -81,8 +81,8 @@     pretty (TrustPkt bs) = text "trust:" <+> pretty (BL.unpack bs)     pretty (UserIdPkt u) = text "user-ID:" <+> pretty u     pretty (PublicSubkeyPkt pkp) = text "public subkey:" <+> pretty pkp-    pretty (UserAttributePkt us) = text "user-attribute:" <+> prettyList us-    pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> (text . show) pv <> char ':' <+> pretty bs+    pretty (UserAttributePkt us) = text "user-attribute:" <+> pretty us+    pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <> char ':' <+> pretty bs     pretty (ModificationDetectionCodePkt bs) = text "MDC:" <+> pretty bs     pretty (OtherPacketPkt t bs) = text "unknown packet type" <+> pretty t <> char ':' <+> pretty bs     pretty (BrokenPacketPkt s t bs) = text "BROKEN packet (" <> pretty s <> char ')' <+> pretty t <> char ':' <+> pretty bs
hOpenPGP.cabal view
@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             2.5.2+Version:             2.5.3 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581) Homepage:            http://floss.scru.org/hOpenPGP/@@ -191,7 +191,7 @@                , base64-bytestring                , bifunctors                , byteable-               , bytestring+               , bytestring            >= 0.10.0.0                , bzlib                , binary                >= 0.6.4.0                , binary-conduit@@ -240,7 +240,7 @@                , base                  > 4       && < 5                , bifunctors                , byteable-               , bytestring+               , bytestring            >= 0.10.0.0                , bzlib                , binary                >= 0.6.4.0                , binary-conduit@@ -291,7 +291,7 @@                , base64-bytestring                , bifunctors                , byteable-               , bytestring+               , bytestring            >= 0.10.0.0                , bzlib                , binary                >= 0.6.4.0                , binary-conduit@@ -336,4 +336,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v2.5.2+  tag:      v2.5.3
tests/suite.hs view
@@ -16,6 +16,7 @@ import Codec.Encryption.OpenPGP.Compression (decompressPkt, compressPkts) import Codec.Encryption.OpenPGP.Expirations (isTKTimeValid) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)+import Codec.Encryption.OpenPGP.KeyInfo (pkalgoAbbrev, pubkeySize) import Codec.Encryption.OpenPGP.KeyringParser (parseTKs) import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint) import Codec.Encryption.OpenPGP.SecretKey (decryptPrivateKey, encryptPrivateKey)@@ -83,14 +84,15 @@     len <- runResourceT $ CB.sourceFile ("tests/data/" ++ fpr) DC.$= c DC.$$ counter     assertEqual ("expected length " ++ show target) target len -testKeyIDandFingerprint :: FilePath -> String -> Assertion-testKeyIDandFingerprint fpr kf = do+testPKAandSizeAndKeyIDandFingerprint :: FilePath -> String -> Assertion+testPKAandSizeAndKeyIDandFingerprint fpr kf = do     bs <- BL.readFile $ "tests/data/" ++ fpr     case runGet (get :: Get Pkt) bs of         Left _ -> assertFailure $ "Decoding of " ++ fpr ++ " broke."         Right (PublicKeyPkt pkp) -> do-                                       assertEqual ("for " ++ fpr ++ " (spaceless)") (spaceless kf) (either (const "unknown") (show . pretty) (eightOctetKeyID pkp) ++ "/" ++ show (pretty (fingerprint pkp)))-                                       assertEqual ("for " ++ fpr ++ " (spaced)") kf (either (const "unknown") (show . pretty) (eightOctetKeyID pkp) ++ "/" ++ show (pretty (SpacedFingerprint (fingerprint pkp))))+                                       let pref = concat [pkalgoAbbrev (_pkalgo pkp), either (const "unknown") show (pubkeySize (_pubkey pkp)), ":", either (const "unknown") (show . pretty) (eightOctetKeyID pkp), "/"]+                                       assertEqual ("for " ++ fpr ++ " (spaceless)") (spaceless kf) (pref ++ show (pretty (fingerprint pkp)))+                                       assertEqual ("for " ++ fpr ++ " (spaced)") kf (pref ++ show (pretty (SpacedFingerprint (fingerprint pkp))))         _ -> assertFailure "Expected public key, got something else."     where         spaceless = filter (/=' ')@@ -276,9 +278,9 @@    , testCase "gnu-dummy-s2k-101-secret-key.gpg" (testSerialization "gnu-dummy-s2k-101-secret-key.gpg")    , testCase "anibal-ed25519.gpg" (testSerialization "anibal-ed25519.gpg")    ],-  testGroup "KeyID/fingerprint group" [-     testCase "v3 key" (testKeyIDandFingerprint "v3.key" "C7261095/CBD9 F412 6807 E405 CC2D  2712 1DF5 E86E")-   , testCase "v4 key" (testKeyIDandFingerprint "000001-006.public_key" "D4D54EA16F87040E/421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E")+  testGroup "PKA/Size/KeyID/fingerprint group" [+     testCase "v3 key" (testPKAandSizeAndKeyIDandFingerprint "v3.key" "R1024:C7261095/CBD9 F412 6807 E405 CC2D  2712 1DF5 E86E")+   , testCase "v4 key" (testPKAandSizeAndKeyIDandFingerprint "000001-006.public_key" "R1248:D4D54EA16F87040E/421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E")    ],   testGroup "Keyring group" [      testCase "pubring 7732CF988A63EA86" (testKeyringLookup "pubring.gpg" "7732CF988A63EA86" True)