packages feed

hOpenPGP 2.6.2 → 2.7

raw patch · 9 files changed

+196/−171 lines, 9 filesdep +prettyprinterdep −wl-pprint-extras

Dependencies added: prettyprinter

Dependencies removed: wl-pprint-extras

Files

Codec/Encryption/OpenPGP/Types/Internal/Base.hs view
@@ -58,8 +58,10 @@ import Network.URI (URI(..), uriToString, nullURI, parseURI) import Numeric (readHex) import Data.Time.Locale.Compat (defaultTimeLocale)-import Text.PrettyPrint.Free (Pretty(..), (<+>), char, hsep, punctuate, space, text)+import Data.Text.Prettyprint.Doc (Pretty(..), (<+>), hsep, punctuate, space)+import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS) + type Exportability = Bool type TrustLevel = Word8 type TrustAmount = Word8@@ -141,21 +143,21 @@ instance Hashable SymmetricAlgorithm  instance Pretty SymmetricAlgorithm where-    pretty Plaintext = text "plaintext"-    pretty IDEA = text "IDEA"-    pretty TripleDES = text "3DES"-    pretty CAST5 = text "CAST-128"-    pretty Blowfish = text "Blowfish"-    pretty ReservedSAFER = text "(reserved) SAFER"-    pretty ReservedDES = text "(reserved) DES"-    pretty AES128 = text "AES-128"-    pretty AES192 = text "AES-192"-    pretty AES256 = text "AES-256"-    pretty Twofish = text "Twofish"-    pretty Camellia128 = text "Camellia-128"-    pretty Camellia192 = text "Camellia-192"-    pretty Camellia256 = text "Camellia-256"-    pretty (OtherSA sa) = text "unknown symmetric algorithm" <+> pretty sa+    pretty Plaintext = pretty "plaintext"+    pretty IDEA = pretty "IDEA"+    pretty TripleDES = pretty "3DES"+    pretty CAST5 = pretty "CAST-128"+    pretty Blowfish = pretty "Blowfish"+    pretty ReservedSAFER = pretty "(reserved) SAFER"+    pretty ReservedDES = pretty "(reserved) DES"+    pretty AES128 = pretty "AES-128"+    pretty AES192 = pretty "AES-192"+    pretty AES256 = pretty "AES-256"+    pretty Twofish = pretty "Twofish"+    pretty Camellia128 = pretty "Camellia-128"+    pretty Camellia192 = pretty "Camellia-192"+    pretty Camellia256 = pretty "Camellia-256"+    pretty (OtherSA sa) = pretty "unknown symmetric algorithm" <+> pretty sa  $(ATH.deriveJSON ATH.defaultOptions ''SymmetricAlgorithm) @@ -179,8 +181,8 @@ instance Hashable NotationFlag  instance Pretty NotationFlag where-    pretty HumanReadable = text "human-readable"-    pretty (OtherNF o) = text "unknown notation flag type" <+> pretty o+    pretty HumanReadable = pretty "human-readable"+    pretty (OtherNF o) = pretty "unknown notation flag type" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''NotationFlag) @@ -192,7 +194,7 @@     unpack (ThirtyTwoBitTimeStamp o) = o  instance Pretty ThirtyTwoBitTimeStamp where-    pretty = text . formatTime defaultTimeLocale "%Y%m%d-%H%M%S" . posixSecondsToUTCTime . realToFrac+    pretty = pretty . formatTime defaultTimeLocale "%Y%m%d-%H%M%S" . posixSecondsToUTCTime . realToFrac  $(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitTimeStamp) @@ -212,7 +214,7 @@     unpack (ThirtyTwoBitDuration o) = o  instance Pretty ThirtyTwoBitDuration where-    pretty = text . concat . unfoldr durU . unpack+    pretty = pretty . concat . unfoldr durU . unpack  $(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitDuration) @@ -236,8 +238,8 @@ instance Hashable RevocationClass  instance Pretty RevocationClass where-    pretty SensitiveRK = text "sensitive"-    pretty (RClOther o) = text "unknown revocation class" <+> pretty o+    pretty SensitiveRK = pretty "sensitive"+    pretty (RClOther o) = pretty "unknown revocation class" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''RevocationClass) @@ -284,16 +286,16 @@ instance Hashable PubKeyAlgorithm  instance Pretty PubKeyAlgorithm where-    pretty RSA = text "RSA"-    pretty DeprecatedRSAEncryptOnly = text "(deprecated) RSA encrypt-only"-    pretty DeprecatedRSASignOnly = text "(deprecated) RSA sign-only"-    pretty ElgamalEncryptOnly = text "Elgamal encrypt-only"-    pretty DSA = text "DSA"-    pretty ECDH = text "ECDH"-    pretty ECDSA = text "ECDSA"-    pretty ForbiddenElgamal = text "(forbidden) Elgamal"-    pretty DH = text "DH"-    pretty (OtherPKA pka) = text "unknown pubkey algorithm type" <+> pretty pka+    pretty RSA = pretty "RSA"+    pretty DeprecatedRSAEncryptOnly = pretty "(deprecated) RSA encrypt-only"+    pretty DeprecatedRSASignOnly = pretty "(deprecated) RSA sign-only"+    pretty ElgamalEncryptOnly = pretty "Elgamal encrypt-only"+    pretty DSA = pretty "DSA"+    pretty ECDH = pretty "ECDH"+    pretty ECDSA = pretty "ECDSA"+    pretty ForbiddenElgamal = pretty "(forbidden) Elgamal"+    pretty DH = pretty "DH"+    pretty (OtherPKA pka) = pretty "unknown pubkey algorithm type" <+> pretty pka  $(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm) @@ -327,7 +329,7 @@     unpack (SpacedFingerprint o) = o  instance Pretty SpacedFingerprint where-    pretty = hsep . punctuate space . map hsep . chunksOf 5 . map text . chunksOf 4 . take 40 . bsToHexUpper . unTOF . unpack+    pretty = hsep . punctuate space . map hsep . chunksOf 5 . map pretty . chunksOf 4 . take 40 . bsToHexUpper . unTOF . unpack  bsToHexUpper :: ByteString -> String bsToHexUpper = map toUpper . BLC8.unpack . B16L.encode@@ -360,8 +362,11 @@     parseJSON _            = mzero  newtype NotationName = NotationName {unNotationName :: ByteString}-    deriving (Data, Eq, Generic, Hashable, Ord, Pretty, Show, Typeable)+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) +instance Pretty NotationName where+    pretty = prettyLBS . unNotationName+ instance Newtype NotationName ByteString where     pack = NotationName     unpack (NotationName nn) = nn@@ -374,8 +379,11 @@     parseJSON _            = mzero  newtype NotationValue = NotationValue {unNotationValue :: ByteString}-    deriving (Data, Eq, Generic, Hashable, Ord, Pretty, Show, Typeable)+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) +instance Pretty NotationValue where+    pretty = prettyLBS . unNotationValue+ instance Newtype NotationValue ByteString where     pack = NotationValue     unpack (NotationValue nv) = nv@@ -424,14 +432,14 @@ instance Hashable HashAlgorithm  instance Pretty HashAlgorithm where-    pretty DeprecatedMD5 = text "(deprecated) MD5"-    pretty SHA1 = text "SHA-1"-    pretty RIPEMD160 = text "RIPEMD-160"-    pretty SHA256 = text "SHA-256"-    pretty SHA384 = text "SHA-384"-    pretty SHA512 = text "SHA-512"-    pretty SHA224 = text "SHA-224"-    pretty (OtherHA ha) = text "unknown hash algorithm type" <+> pretty ha+    pretty DeprecatedMD5 = pretty "(deprecated) MD5"+    pretty SHA1 = pretty "SHA-1"+    pretty RIPEMD160 = pretty "RIPEMD-160"+    pretty SHA256 = pretty "SHA-256"+    pretty SHA384 = pretty "SHA-384"+    pretty SHA512 = pretty "SHA-512"+    pretty SHA224 = pretty "SHA-224"+    pretty (OtherHA ha) = pretty "unknown hash algorithm type" <+> pretty ha  $(ATH.deriveJSON ATH.defaultOptions ''HashAlgorithm) @@ -463,11 +471,11 @@ instance Hashable CompressionAlgorithm  instance Pretty CompressionAlgorithm where-    pretty Uncompressed = text "uncompressed"-    pretty ZIP = text "ZIP"-    pretty ZLIB = text "zlib"-    pretty BZip2 = text "bzip2"-    pretty (OtherCA ca) = text "unknown compression algorithm type" <+> pretty ca+    pretty Uncompressed = pretty "uncompressed"+    pretty ZIP = pretty "ZIP"+    pretty ZLIB = pretty "zlib"+    pretty BZip2 = pretty "bzip2"+    pretty (OtherCA ca) = pretty "unknown compression algorithm type" <+> pretty ca  $(ATH.deriveJSON ATH.defaultOptions ''CompressionAlgorithm) @@ -491,8 +499,8 @@ instance Hashable KSPFlag  instance Pretty KSPFlag where-    pretty NoModify = text "no-modify"-    pretty (KSPOther o) = text "unknown keyserver preference flag type" <+> pretty o+    pretty NoModify = pretty "no-modify"+    pretty (KSPOther o) = pretty "unknown keyserver preference flag type" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''KSPFlag) @@ -534,14 +542,14 @@ instance Hashable KeyFlag  instance Pretty KeyFlag where-    pretty GroupKey = text "group"-    pretty AuthKey = text "auth"-    pretty SplitKey = text "split"-    pretty EncryptStorageKey = text "encrypt-storage"-    pretty EncryptCommunicationsKey = text "encrypt-communications"-    pretty SignDataKey = text "sign-data"-    pretty CertifyKeysKey = text "certify-keys"-    pretty (KFOther o) = text "unknown key flag type" <+> pretty o+    pretty GroupKey = pretty "group"+    pretty AuthKey = pretty "auth"+    pretty SplitKey = pretty "split"+    pretty EncryptStorageKey = pretty "encrypt-storage"+    pretty EncryptCommunicationsKey = pretty "encrypt-communications"+    pretty SignDataKey = pretty "sign-data"+    pretty CertifyKeysKey = pretty "certify-keys"+    pretty (KFOther o) = pretty "unknown key flag type" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''KeyFlag) @@ -576,12 +584,12 @@ instance Hashable RevocationCode  instance Pretty RevocationCode where-    pretty NoReason = text "no reason"-    pretty KeySuperseded = text "key superseded"-    pretty KeyMaterialCompromised = text "key material compromised"-    pretty KeyRetiredAndNoLongerUsed = text "key retired and no longer used"-    pretty UserIdInfoNoLongerValid = text "user-ID info no longer valid"-    pretty (RCoOther o) = text "unknown revocation code" <+> pretty o+    pretty NoReason = pretty "no reason"+    pretty KeySuperseded = pretty "key superseded"+    pretty KeyMaterialCompromised = pretty "key material compromised"+    pretty KeyRetiredAndNoLongerUsed = pretty "key retired and no longer used"+    pretty UserIdInfoNoLongerValid = pretty "user-ID info no longer valid"+    pretty (RCoOther o) = pretty "unknown revocation code" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''RevocationCode) @@ -607,8 +615,8 @@     hashWithSalt salt = hashWithSalt salt . Set.toList  instance Pretty FeatureFlag where-    pretty ModificationDetection = text "modification-detection"-    pretty (FeatureOther o) = text "unknown feature flag type" <+> pretty o+    pretty ModificationDetection = pretty "modification-detection"+    pretty (FeatureOther o) = pretty "unknown feature flag type" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''FeatureFlag) @@ -694,22 +702,22 @@ instance Hashable SigType  instance Pretty SigType where-    pretty BinarySig = text "binary"-    pretty CanonicalTextSig = text "canonical-text"-    pretty StandaloneSig = text "standalone"-    pretty GenericCert = text "generic"-    pretty PersonaCert = text "persona"-    pretty CasualCert = text "casual"-    pretty PositiveCert = text "positive"-    pretty SubkeyBindingSig = text "subkey-binding"-    pretty PrimaryKeyBindingSig = text "primary-key-binding"-    pretty SignatureDirectlyOnAKey = text "signature directly on a key"-    pretty KeyRevocationSig = text "key-revocation"-    pretty SubkeyRevocationSig = text "subkey-revocation"-    pretty CertRevocationSig = text "cert-revocation"-    pretty TimestampSig = text "timestamp"-    pretty ThirdPartyConfirmationSig = text "third-party-confirmation"-    pretty (OtherSig o) = text "unknown signature type" <+> pretty o+    pretty BinarySig = pretty "binary"+    pretty CanonicalTextSig = pretty "canonical-pretty"+    pretty StandaloneSig = pretty "standalone"+    pretty GenericCert = pretty "generic"+    pretty PersonaCert = pretty "persona"+    pretty CasualCert = pretty "casual"+    pretty PositiveCert = pretty "positive"+    pretty SubkeyBindingSig = pretty "subkey-binding"+    pretty PrimaryKeyBindingSig = pretty "primary-key-binding"+    pretty SignatureDirectlyOnAKey = pretty "signature directly on a key"+    pretty KeyRevocationSig = pretty "key-revocation"+    pretty SubkeyRevocationSig = pretty "subkey-revocation"+    pretty CertRevocationSig = pretty "cert-revocation"+    pretty TimestampSig = pretty "timestamp"+    pretty ThirdPartyConfirmationSig = pretty "third-party-confirmation"+    pretty (OtherSig o) = pretty "unknown signature type" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''SigType) @@ -735,9 +743,9 @@ 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 <+> (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)+    pretty (SigV3 st ts eoki pka ha w16 mpis) = pretty "signature v3" <> pretty ':' <+> 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) = pretty "signature v4" <> pretty ':' <+> pretty st <+> pretty pka <+> pretty ha <+> pretty hsps <+> pretty usps <+> pretty w16 <+> (pretty . NE.toList) mpis+    pretty (SigVOther t bs) = pretty "unknown signature v" <> pretty t <> pretty ':' <+> pretty (BL.unpack bs)  instance A.ToJSON SignaturePayload where     toJSON (SigV3 st ts eoki pka ha w16 mpis) = A.toJSON (st, ts, eoki, pka, ha, w16, NE.toList mpis)@@ -774,31 +782,31 @@ instance Hashable SigSubPacketPayload  instance Pretty SigSubPacketPayload where-    pretty (SigCreationTime ts) = text "creation-time" <+> pretty ts-    pretty (SigExpirationTime d) = text "sig expiration time" <+> pretty d-    pretty (ExportableCertification e) = text "exportable certification" <+> pretty e-    pretty (TrustSignature tl ta) = text "trust signature" <+> pretty tl <+> pretty ta-    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" <+> 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" <+> 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" <+> 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" <+> 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" <+> 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)-    pretty (OtherSigSub t bs) = text "unknown signature subpacket type" <+> pretty t <+> pretty bs+    pretty (SigCreationTime ts) = pretty "creation-time" <+> pretty ts+    pretty (SigExpirationTime d) = pretty "sig expiration time" <+> pretty d+    pretty (ExportableCertification e) = pretty "exportable certification" <+> pretty e+    pretty (TrustSignature tl ta) = pretty "trust signature" <+> pretty tl <+> pretty ta+    pretty (RegularExpression apdre) = pretty "regular expression" <+> prettyLBS apdre+    pretty (Revocable r) = pretty "revocable" <+> pretty r+    pretty (KeyExpirationTime d) = pretty "key expiration time" <+> pretty d+    pretty (PreferredSymmetricAlgorithms sas) = pretty "preferred symmetric algorithms" <+> pretty sas+    pretty (RevocationKey rcs pka tof) = pretty "revocation key" <+> pretty (Set.toList rcs) <+> pretty pka <+> pretty tof+    pretty (Issuer eoki) = pretty "issuer" <+> pretty eoki+    pretty (NotationData nfs nn nv) = pretty "notation data" <+> pretty (Set.toList nfs) <+> pretty nn <+> pretty nv+    pretty (PreferredHashAlgorithms phas) = pretty "preferred hash algorithms" <+> pretty phas+    pretty (PreferredCompressionAlgorithms pcas) = pretty "preferred compression algorithms" <+> pretty pcas+    pretty (KeyServerPreferences kspfs) = pretty "keyserver preferences" <+> pretty (Set.toList kspfs)+    pretty (PreferredKeyServer ks) = pretty "preferred keyserver" <+> prettyLBS ks+    pretty (PrimaryUserId p) = (if p then mempty else pretty "NOT ") <> pretty "primary user-ID"+    pretty (PolicyURL u) = pretty "policy URL" <+> pretty u+    pretty (KeyFlags kfs) = pretty "key flags" <+> pretty (Set.toList kfs)+    pretty (SignersUserId u) = pretty "signer's user-ID" <+> pretty u+    pretty (ReasonForRevocation rc rr) = pretty "reason for revocation" <+> pretty rc <+> pretty rr+    pretty (Features ffs) = pretty "features" <+> pretty (Set.toList ffs)+    pretty (SignatureTarget pka ha sh) = pretty "signature target" <+> pretty pka <+> pretty ha <+> prettyLBS sh+    pretty (EmbeddedSignature sp) = pretty "embedded signature" <+> pretty sp+    pretty (UserDefinedSigSub t bs) = pretty "user-defined signature subpacket type" <+> pretty t <+> pretty (BL.unpack bs)+    pretty (OtherSigSub t bs) = pretty "unknown signature subpacket type" <+> pretty t <+> prettyLBS bs  instance A.ToJSON SigSubPacketPayload where     toJSON (SigCreationTime ts) = object [T.pack "sigCreationTime" .= ts]@@ -850,7 +858,7 @@   } deriving (Data, Eq, Generic, Show, Typeable)  instance Pretty SigSubPacket where-    pretty x = (if _sspCriticality x then char '*' else mempty) <> (pretty . _sspPayload) x+    pretty x = (if _sspCriticality x then pretty '*' else mempty) <> (pretty . _sspPayload) x  instance Hashable SigSubPacket @@ -863,8 +871,8 @@ instance Hashable KeyVersion  instance Pretty KeyVersion where-    pretty DeprecatedV3 = text "(deprecated) v3"-    pretty V4 = text "v4"+    pretty DeprecatedV3 = pretty "(deprecated) v3"+    pretty V4 = pretty "v4"  $(ATH.deriveJSON ATH.defaultOptions ''KeyVersion) @@ -907,10 +915,10 @@     toFVal o = OtherData o  instance Pretty DataType where-    pretty BinaryData = text "binary"-    pretty TextData = text "text"-    pretty UTF8Data = text "UTF-8"-    pretty (OtherData o) = text "other data type " <+> pretty o+    pretty BinaryData = pretty "binary"+    pretty TextData = pretty "text"+    pretty UTF8Data = pretty "UTF-8"+    pretty (OtherData o) = pretty "other data type " <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''DataType) @@ -948,10 +956,10 @@ instance Hashable S2K  instance Pretty S2K where-    pretty (Simple ha) = text "simple S2K," <+> pretty ha-    pretty (Salted ha salt) = text "salted S2K," <+> pretty ha <+> pretty salt-    pretty (IteratedSalted ha salt icount) = text "iterated-salted S2K," <+> pretty ha <+> pretty salt <+> pretty icount-    pretty (OtherS2K t bs) = text "unknown S2K type" <+> pretty t <+> pretty (bsToHexUpper bs)+    pretty (Simple ha) = pretty "simple S2K," <+> pretty ha+    pretty (Salted ha salt) = pretty "salted S2K," <+> pretty ha <+> pretty salt+    pretty (IteratedSalted ha salt icount) = pretty "iterated-salted S2K," <+> pretty ha <+> pretty salt <+> pretty icount+    pretty (OtherS2K t bs) = pretty "unknown S2K type" <+> pretty t <+> pretty (bsToHexUpper bs)  instance A.ToJSON S2K where     toJSON (Simple ha) = A.toJSON ha@@ -979,8 +987,8 @@ instance Hashable ImageFormat  instance Pretty ImageFormat where-    pretty JPEG = text "JPEG"-    pretty (OtherImage o) = text "unknown image format" <+> pretty o+    pretty JPEG = pretty "JPEG"+    pretty (OtherImage o) = pretty "unknown image format" <+> pretty o  $(ATH.deriveJSON ATH.defaultOptions ''ImageFormat) @@ -993,7 +1001,7 @@ instance Hashable ImageHeader  instance Pretty ImageHeader where-    pretty (ImageHV1 f) = text "imghdr v1" <+> pretty f+    pretty (ImageHV1 f) = pretty "imghdr v1" <+> pretty f  $(ATH.deriveJSON ATH.defaultOptions ''ImageHeader) @@ -1010,8 +1018,8 @@     compare (OtherUASub t1 b1) (OtherUASub t2 b2) = compare t1 t2 <> compare b1 b2  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" <> pretty t <+> pretty (BL.unpack bs)+    pretty (ImageAttribute ih d) = pretty "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)+    pretty (OtherUASub t bs) = pretty "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/CryptoniteNewtypes.hs view
@@ -20,7 +20,7 @@ import Data.Data (Data) import Data.Hashable (Hashable(..)) import Data.Typeable (Typeable)-import Text.PrettyPrint.Free (Pretty(..), (<+>), tupled)+import Data.Text.Prettyprint.Doc (Pretty(..), (<+>), tupled)  newtype DSA_PublicKey = DSA_PublicKey {unDSA_PublicKey :: DSA.PublicKey}     deriving (Data, Eq, Generic, Show, Typeable)
Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs view
@@ -26,7 +26,7 @@ import Data.Ord (comparing) import Data.Typeable (Typeable) import Data.Word (Word16)-import Text.PrettyPrint.Free (Pretty(..), (<+>), text)+import Data.Text.Prettyprint.Doc (Pretty(..), (<+>))  data PKey = RSAPubKey RSA_PublicKey           | DSAPubKey DSA_PublicKey@@ -39,12 +39,12 @@ instance Hashable PKey  instance Pretty PKey where-    pretty (RSAPubKey p) = text "RSA" <+> pretty p-    pretty (DSAPubKey p) = text "DSA" <+> pretty p-    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 (bsToHexUpper bs)+    pretty (RSAPubKey p) = pretty "RSA" <+> pretty p+    pretty (DSAPubKey p) = pretty "DSA" <+> pretty p+    pretty (ElGamalPubKey p g y) = pretty "Elgamal" <+> pretty p <+> pretty g <+> pretty y+    pretty (ECDHPubKey p ha sa) = pretty "ECDH" <+> pretty p <+> pretty ha <+> pretty sa+    pretty (ECDSAPubKey p) = pretty "ECDSA" <+> pretty p+    pretty (UnknownPKey bs) = pretty "<unknown>" <+> pretty (bsToHexUpper bs)  instance A.ToJSON PKey where     toJSON (RSAPubKey p) = A.toJSON p@@ -65,12 +65,12 @@ instance Hashable SKey  instance Pretty SKey where-    pretty (RSAPrivateKey p) = text "RSA" <+> pretty p-    pretty (DSAPrivateKey p) = text "DSA" <+> pretty p-    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 (bsToHexUpper bs)+    pretty (RSAPrivateKey p) = pretty "RSA" <+> pretty p+    pretty (DSAPrivateKey p) = pretty "DSA" <+> pretty p+    pretty (ElGamalPrivateKey p) = pretty "Elgamal" <+> pretty p+    pretty (ECDHPrivateKey p) = pretty "ECDH" <+> pretty p+    pretty (ECDSAPrivateKey p) = pretty "ECDSA" <+> pretty p+    pretty (UnknownSKey bs) = pretty "<unknown>" <+> pretty (bsToHexUpper bs)  instance A.ToJSON SKey where     toJSON (RSAPrivateKey k) = A.toJSON k@@ -110,10 +110,10 @@ instance Hashable SKAddendum  instance Pretty SKAddendum where-    pretty (SUS16bit sa s2k iv bs) = text "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)-    pretty (SUSSHA1 sa s2k iv bs) = text "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)-    pretty (SUSym sa iv bs) = text "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs)-    pretty (SUUnencrypted s ck) = text "SUUnencrypted" <+> pretty s <+> pretty ck+    pretty (SUS16bit sa s2k iv bs) = pretty "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)+    pretty (SUSSHA1 sa s2k iv bs) = pretty "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)+    pretty (SUSym sa iv bs) = pretty "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs)+    pretty (SUUnencrypted s ck) = pretty "SUUnencrypted" <+> pretty s <+> pretty ck  instance A.ToJSON SKAddendum where     toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)
Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs view
@@ -25,7 +25,7 @@ import Data.Text (Text) import Data.Typeable (Typeable) import Data.Word (Word8)-import Text.PrettyPrint.Free (Pretty(..))+import Data.Text.Prettyprint.Doc (Pretty(..))  class Packet a where     data PacketType a :: *
Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs view
@@ -37,7 +37,8 @@ import qualified Data.Text as T import Data.Typeable (Typeable) import Data.Word (Word8)-import Text.PrettyPrint.Free (Pretty(..), (<+>), char, text)+import Data.Text.Prettyprint.Doc (Pretty(..), (<+>))+import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS)  -- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm (NonEmpty MPI)@@ -67,25 +68,25 @@     compare = comparing pktTag <> comparing hash -- FIXME: is there something saner?  instance Pretty Pkt where-    pretty (PKESKPkt pv eoki pka mpis) = text "PKESK v" <> pretty pv <> char ':' <+> pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis+    pretty (PKESKPkt pv eoki pka mpis) = pretty "PKESK v" <> pretty pv <> pretty ':' <+> pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis     pretty (SignaturePkt sp) = pretty sp-    pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> pretty pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty (fmap bsToHexUpper 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-    pretty (CompressedDataPkt ca cdp) = text "compressed-data:" <+> pretty ca <+> pretty cdp-    pretty (SymEncDataPkt bs) = text "symmetrically-encrypted-data:" <+> pretty (bsToHexUpper bs)-    pretty (MarkerPkt bs) = text "marker:" <+> pretty (bsToHexUpper bs)-    pretty (LiteralDataPkt dt fn ts bs) = text "literal-data" <+> pretty dt <+> pretty fn <+> pretty ts <+> pretty (bsToHexUpper bs)-    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:" <+> pretty us-    pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <> char ':' <+> pretty (bsToHexUpper bs)-    pretty (ModificationDetectionCodePkt bs) = text "MDC:" <+> pretty (bsToHexUpper bs)-    pretty (OtherPacketPkt t bs) = text "unknown packet type" <+> pretty t <> char ':' <+> pretty (bsToHexUpper bs)-    pretty (BrokenPacketPkt s t bs) = text "BROKEN packet (" <> pretty s <> char ')' <+> pretty t <> char ':' <+> pretty (bsToHexUpper bs)+    pretty (SKESKPkt pv sa s2k mbs) = pretty "SKESK v" <> pretty pv <> pretty ':' <+> pretty sa <+> pretty s2k <+> pretty (fmap bsToHexUpper mbs)+    pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = pretty "one-pass signature v" <> pretty pv <> pretty ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag+    pretty (SecretKeyPkt pkp ska) = pretty "secret key:" <+> pretty pkp <+> pretty ska+    pretty (PublicKeyPkt pkp) = pretty "public key:" <+> pretty pkp+    pretty (SecretSubkeyPkt pkp ska) = pretty "secret subkey:" <+> pretty pkp <+> pretty ska+    pretty (CompressedDataPkt ca cdp) = pretty "compressed-data:" <+> pretty ca <+> prettyLBS cdp+    pretty (SymEncDataPkt bs) = pretty "symmetrically-encrypted-data:" <+> pretty (bsToHexUpper bs)+    pretty (MarkerPkt bs) = pretty "marker:" <+> pretty (bsToHexUpper bs)+    pretty (LiteralDataPkt dt fn ts bs) = pretty "literal-data" <+> pretty dt <+> prettyLBS fn <+> pretty ts <+> pretty (bsToHexUpper bs)+    pretty (TrustPkt bs) = pretty "trust:" <+> pretty (BL.unpack bs)+    pretty (UserIdPkt u) = pretty "user-ID:" <+> pretty u+    pretty (PublicSubkeyPkt pkp) = pretty "public subkey:" <+> pretty pkp+    pretty (UserAttributePkt us) = pretty "user-attribute:" <+> pretty us+    pretty (SymEncIntegrityProtectedDataPkt pv bs) = pretty "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <> pretty ':' <+> pretty (bsToHexUpper bs)+    pretty (ModificationDetectionCodePkt bs) = pretty "MDC:" <+> pretty (bsToHexUpper bs)+    pretty (OtherPacketPkt t bs) = pretty "unknown packet type" <+> pretty t <> pretty ':' <+> pretty (bsToHexUpper bs)+    pretty (BrokenPacketPkt s t bs) = pretty "BROKEN packet (" <> pretty s <> pretty ')' <+> pretty t <> pretty ':' <+> pretty (bsToHexUpper bs)  instance A.ToJSON Pkt where     toJSON (PKESKPkt pv eoki pka mpis) = object [T.pack "pkesk" .= object [T.pack "version" .= pv, T.pack "keyid" .= eoki, T.pack "pkalgo" .= pka, T.pack "mpis" .= NE.toList mpis]]
+ Codec/Encryption/OpenPGP/Types/Internal/PrettyUtils.hs view
@@ -0,0 +1,16 @@+-- PrettyUtils.hs: prettyprinter helpers+-- Copyright © 2018  Clint Adams+-- This software is released under the terms of the Expat license.+-- (See the LICENSE file).++module Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils where++import qualified Data.ByteString.Lazy as BL+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Text.Prettyprint.Doc (Pretty(..), Doc)++prettyBS = pretty . decodeUtf8With lenientDecode++prettyLBS :: BL.ByteString -> Doc ann+prettyLBS = pretty . decodeUtf8With lenientDecode . BL.toStrict
Codec/Encryption/OpenPGP/Types/Internal/TK.hs view
@@ -17,7 +17,6 @@ import Codec.Encryption.OpenPGP.Types.Internal.Pkt  import Control.Lens (makeLenses)-import qualified Data.Aeson as A import qualified Data.Aeson.TH as ATH import Data.Data (Data) import Data.IxSet.Typed (IxSet)
hOpenPGP.cabal view
@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             2.6.2+Version:             2.7 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581), plus ECC (RFC6637) Homepage:            https://salsa.debian.org/clint/hOpenPGP@@ -185,6 +185,7 @@                , Codec.Encryption.OpenPGP.Types.Internal.PacketClass                , Codec.Encryption.OpenPGP.Types.Internal.PKITypes                , Codec.Encryption.OpenPGP.Types.Internal.Pkt+               , Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils                , Codec.Encryption.OpenPGP.Types.Internal.TK                , Codec.Encryption.OpenPGP.BlockCipher   Build-depends: aeson@@ -213,6 +214,7 @@                , nettle                , newtype                , openpgp-asciiarmor                 >= 0.1+               , prettyprinter                , resourcet              > 0.4                , semigroups                , split@@ -222,7 +224,6 @@                , transformers                , unliftio-core                , unordered-containers-               , wl-pprint-extras                , zlib   if flag(network-uri)     build-depends: network-uri >= 2.6@@ -261,6 +262,7 @@                , monad-loops                , nettle                , newtype+               , prettyprinter                , semigroups                , split                , text@@ -269,7 +271,6 @@                , transformers                , unliftio-core                , unordered-containers-               , wl-pprint-extras                , zlib                , tasty                , tasty-hunit@@ -312,6 +313,7 @@                , nettle                , newtype                , openpgp-asciiarmor                 >= 0.1+               , prettyprinter                , resourcet              > 0.4                , semigroups                , split@@ -321,7 +323,6 @@                , transformers                , unliftio-core                , unordered-containers-               , wl-pprint-extras                , zlib                , criterion             > 0.8   if flag(network-uri)@@ -337,4 +338,4 @@ source-repository this   type:     git   location: https://salsa.debian.org/clint/hOpenPGP.git-  tag:      v2.6.2+  tag:      v2.7
tests/suite.hs view
@@ -39,7 +39,7 @@ import Data.Binary.Put (runPut) import Data.Text (Text) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Text.PrettyPrint.Free (pretty)+import Data.Text.Prettyprint.Doc (pretty)  import qualified Data.Conduit as DC import qualified Data.Conduit.Binary as CB