packages feed

hOpenPGP 2.4.3 → 2.4.4

raw patch · 4 files changed

+413/−430 lines, 4 files

Files

Codec/Encryption/OpenPGP/Types/Internal/Base.hs view
@@ -26,6 +26,7 @@ import Control.Newtype (Newtype(..)) import Data.Aeson ((.=), object) import qualified Data.Aeson as A+import qualified Data.Aeson.TH as ATH import Data.Byteable (Byteable) import Data.ByteArray (ByteArrayAccess) import Data.ByteString.Lazy (ByteString)@@ -72,6 +73,14 @@ type ImageData = ByteString type NestedFlag = Bool +class (Eq a, Ord a) => FutureFlag a where+    fromFFlag :: a -> Int+    toFFlag :: Int -> a++class (Eq a, Ord a) => FutureVal a where+   fromFVal :: a -> Word8+   toFVal :: Word8 -> a+ data SymmetricAlgorithm = Plaintext                         | IDEA                         | TripleDES@@ -146,8 +155,7 @@     pretty Camellia256 = text "Camellia-256"     pretty (OtherSA sa) = text "unknown symmetric algorithm" <+> (text . show) sa -instance A.ToJSON SymmetricAlgorithm-instance A.FromJSON SymmetricAlgorithm+$(ATH.deriveJSON ATH.defaultOptions ''SymmetricAlgorithm)  data NotationFlag = HumanReadable                   | OtherNF Word8 -- FIXME: this should be constrained to 4 bits?@@ -172,21 +180,7 @@     pretty HumanReadable = text "human-readable"     pretty (OtherNF o) = text "unknown notation flag type" <+> pretty o -instance A.ToJSON NotationFlag-instance A.FromJSON NotationFlag--data SigSubPacket = SigSubPacket {-    _sspCriticality :: Bool-  , _sspPayload :: SigSubPacketPayload-  } deriving (Data, Eq, Generic, Show, Typeable)--instance Pretty SigSubPacket where-    pretty x = (if _sspCriticality x then char '*' else mempty) <> (pretty . _sspPayload) x--instance Hashable SigSubPacket--instance A.ToJSON SigSubPacket-instance A.FromJSON SigSubPacket+$(ATH.deriveJSON ATH.defaultOptions ''NotationFlag)  newtype ThirtyTwoBitTimeStamp = ThirtyTwoBitTimeStamp {unThirtyTwoBitTimeStamp :: Word32}     deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable)@@ -198,9 +192,16 @@ instance Pretty ThirtyTwoBitTimeStamp where     pretty = text . formatTime defaultTimeLocale "%Y%m%d-%H%M%S" . posixSecondsToUTCTime . realToFrac -instance A.ToJSON ThirtyTwoBitTimeStamp-instance A.FromJSON ThirtyTwoBitTimeStamp+$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitTimeStamp) +durU :: (Integral a, Show a) => a -> Maybe (String, a)+durU x+  | x >= 31557600 = Just ((++"y") . show $ x `div` 31557600, x `mod` 31557600)+  | x >= 2629800 = Just ((++"m") . show $ x `div` 2629800, x `mod` 2629800)+  | x >= 86400 = Just ((++"d") . show $ x `div` 86400, x `mod` 86400)+  | x > 0 = Just ((++"s") . show $ x, 0)+  | otherwise = Nothing+ newtype ThirtyTwoBitDuration = ThirtyTwoBitDuration {unThirtyTwoBitDuration :: Word32}     deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable) @@ -211,37 +212,151 @@ instance Pretty ThirtyTwoBitDuration where     pretty = text . concat . unfoldr durU . unpack -instance A.ToJSON ThirtyTwoBitDuration-instance A.FromJSON ThirtyTwoBitDuration+$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitDuration) -durU :: (Integral a, Show a) => a -> Maybe (String, a)-durU x-  | x >= 31557600 = Just ((++"y") . show $ x `div` 31557600, x `mod` 31557600)-  | x >= 2629800 = Just ((++"m") . show $ x `div` 2629800, x `mod` 2629800)-  | x >= 86400 = Just ((++"d") . show $ x `div` 86400, x `mod` 86400)-  | x > 0 = Just ((++"s") . show $ x, 0)-  | otherwise = Nothing+data RevocationClass = SensitiveRK+                     | RClOther Word8 -- FIXME: this should be constrained to 3 bits+    deriving (Data, Generic, Show, Typeable) -newtype URL = URL {unURL :: URI}+instance Eq RevocationClass where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord RevocationClass where+    compare = comparing fromFFlag++instance FutureFlag RevocationClass where+    fromFFlag SensitiveRK = 1+    fromFFlag (RClOther i) = fromIntegral i++    toFFlag 1 = SensitiveRK+    toFFlag i = RClOther (fromIntegral i)++instance Hashable RevocationClass++instance Pretty RevocationClass where+    pretty SensitiveRK = text "sensitive"+    pretty (RClOther o) = text "unknown revocation class" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''RevocationClass)++data PubKeyAlgorithm = RSA+                     | DeprecatedRSAEncryptOnly+                     | DeprecatedRSASignOnly+                     | ElgamalEncryptOnly+                     | DSA+                     | ECDH+                     | ECDSA+                     | ForbiddenElgamal+                     | DH+                     | OtherPKA Word8+    deriving (Show, Data, Generic, Typeable)++instance Eq PubKeyAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord PubKeyAlgorithm where+    compare = comparing fromFVal++instance FutureVal PubKeyAlgorithm where+    fromFVal RSA = 1+    fromFVal DeprecatedRSAEncryptOnly = 2+    fromFVal DeprecatedRSASignOnly = 3+    fromFVal ElgamalEncryptOnly = 16+    fromFVal DSA = 17+    fromFVal ECDH = 18+    fromFVal ECDSA = 19+    fromFVal ForbiddenElgamal = 20+    fromFVal DH = 21+    fromFVal (OtherPKA o) = o+    toFVal 1 = RSA+    toFVal 2 = DeprecatedRSAEncryptOnly+    toFVal 3 = DeprecatedRSASignOnly+    toFVal 16 = ElgamalEncryptOnly+    toFVal 17 = DSA+    toFVal 18 = ECDH+    toFVal 19 = ECDSA+    toFVal 20 = ForbiddenElgamal+    toFVal 21 = DH+    toFVal o = OtherPKA o++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 pka = text "unknown pubkey algorithm type" <+> (text . show) pka++$(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm)++newtype TwentyOctetFingerprint = TwentyOctetFingerprint {unTOF :: ByteString}     deriving (Data, Eq, Generic, Ord, Show, Typeable) -instance Newtype URL URI where-    pack = URL-    unpack (URL o) = o+instance Newtype TwentyOctetFingerprint ByteString where+    pack = TwentyOctetFingerprint+    unpack (TwentyOctetFingerprint o) = o -instance Hashable URL where-    hashWithSalt salt (URL (URI s a p q f)) = salt `hashWithSalt` s `hashWithSalt` show a `hashWithSalt` p `hashWithSalt` q `hashWithSalt` f+-- FIXME: read-show+instance Read TwentyOctetFingerprint where+    readsPrec _ = map ((TwentyOctetFingerprint . BL.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ') -instance Pretty URL where-    pretty = pretty . (\uri -> uriToString id uri "") . unpack+instance Hashable TwentyOctetFingerprint -instance A.ToJSON URL where-    toJSON u = object [T.pack "uri" .= (\uri -> uriToString id uri "") (unpack u)]-instance A.FromJSON URL where-    parseJSON (A.Object v) = URL . fromMaybe nullURI . parseURI <$>-                                      v A..: T.pack "uri"+instance Pretty TwentyOctetFingerprint where+    pretty = text . take 40 . w8sToHex . BL.unpack . unTOF++instance A.ToJSON TwentyOctetFingerprint where+    toJSON e = object [T.pack "fpr" .= (A.toJSON . show . pretty) e]+instance A.FromJSON TwentyOctetFingerprint where+    parseJSON (A.Object v) = TwentyOctetFingerprint . read <$>+                                      v A..: T.pack "fpr"     parseJSON _            = mzero +newtype SpacedFingerprint = SpacedFingerprint { unSpacedFingerprint :: TwentyOctetFingerprint }++instance Newtype SpacedFingerprint TwentyOctetFingerprint where+    pack = SpacedFingerprint+    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++w8sToHex :: [Word8] -> String+w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "")++hexToW8s :: ReadS Word8+hexToW8s = concatMap readHex . chunksOf 2 . map toLower++newtype EightOctetKeyId = EightOctetKeyId {unEOKI :: ByteString}+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Newtype EightOctetKeyId ByteString where+    pack = EightOctetKeyId+    unpack (EightOctetKeyId o) = o++instance Pretty EightOctetKeyId where+    pretty = text . w8sToHex . BL.unpack . unpack++-- FIXME: read-show+instance Read EightOctetKeyId where+    readsPrec _ = map ((EightOctetKeyId . BL.pack *** concat) . unzip) . chunksOf 8 . hexToW8s++instance Hashable EightOctetKeyId++instance A.ToJSON EightOctetKeyId where+    toJSON e = object [T.pack "eoki" .= (w8sToHex . BL.unpack . unpack) e]++instance A.FromJSON EightOctetKeyId where+    parseJSON (A.Object v) = EightOctetKeyId . read <$>+                                      v A..: T.pack "eoki"+    parseJSON _            = mzero+ newtype NotationName = NotationName {unNotationName :: ByteString}     deriving (Data, Eq, Generic, Hashable, Ord, Pretty, Show, Typeable) @@ -270,106 +385,6 @@                                       v A..: T.pack "notationvalue"     parseJSON _            = mzero -data SigSubPacketPayload = SigCreationTime ThirtyTwoBitTimeStamp-                  | SigExpirationTime ThirtyTwoBitDuration-                  | ExportableCertification Exportability-                  | TrustSignature TrustLevel TrustAmount-                  | RegularExpression AlmostPublicDomainRegex-                  | Revocable Revocability-                  | KeyExpirationTime ThirtyTwoBitDuration-                  | PreferredSymmetricAlgorithms [SymmetricAlgorithm]-                  | RevocationKey (Set RevocationClass) PubKeyAlgorithm TwentyOctetFingerprint-                  | Issuer EightOctetKeyId-                  | NotationData (Set NotationFlag) NotationName NotationValue-                  | PreferredHashAlgorithms [HashAlgorithm]-                  | PreferredCompressionAlgorithms [CompressionAlgorithm]-                  | KeyServerPreferences (Set KSPFlag)-                  | PreferredKeyServer KeyServer-                  | PrimaryUserId Bool-                  | PolicyURL URL-                  | KeyFlags (Set KeyFlag)-                  | SignersUserId Text-                  | ReasonForRevocation RevocationCode RevocationReason-                  | Features (Set FeatureFlag)-                  | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash-                  | EmbeddedSignature SignaturePayload-                  | UserDefinedSigSub Word8 ByteString-                  | OtherSigSub Word8 ByteString-    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME--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" <+> prettyList sas-    pretty (RevocationKey rcs pka tof) = text "revocation key" <+> prettyList (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 (PreferredCompressionAlgorithms pcas) = text "preferred compression algorithms" <+> pretty pcas-    pretty (KeyServerPreferences kspfs) = text "keyserver preferences" <+> prettyList (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 (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 (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--instance A.ToJSON SigSubPacketPayload where-    toJSON (SigCreationTime ts) = object [T.pack "sigCreationTime" .= ts]-    toJSON (SigExpirationTime d) = object [T.pack "sigExpirationTime" .= d]-    toJSON (ExportableCertification e) = object [T.pack "exportableCertification" .= e]-    toJSON (TrustSignature tl ta) = object [T.pack "trustSignature" .= (tl, ta)]-    toJSON (RegularExpression apdre) = object [T.pack "regularExpression" .= BL.unpack apdre]-    toJSON (Revocable r) = object [T.pack "revocable" .= r]-    toJSON (KeyExpirationTime d) = object [T.pack "keyExpirationTime" .= d]-    toJSON (PreferredSymmetricAlgorithms sas) = object [T.pack "preferredSymmetricAlgorithms" .= sas]-    toJSON (RevocationKey rcs pka tof) = object [T.pack "revocationKey" .= (rcs, pka, tof)]-    toJSON (Issuer eoki) = object [T.pack "issuer" .= eoki]-    toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) = object [T.pack "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)]-    toJSON (PreferredHashAlgorithms phas) = object [T.pack "preferredHashAlgorithms" .= phas]-    toJSON (PreferredCompressionAlgorithms pcas) = object [T.pack "preferredCompressionAlgorithms" .=  pcas]-    toJSON (KeyServerPreferences kspfs) = object [T.pack "keyServerPreferences" .= kspfs]-    toJSON (PreferredKeyServer ks) = object [T.pack "preferredKeyServer" .= show ks]-    toJSON (PrimaryUserId p) = object [T.pack "primaryUserId" .= p]-    toJSON (PolicyURL u) = object [T.pack "policyURL" .= u]-    toJSON (KeyFlags kfs) = object [T.pack "keyFlags" .= kfs]-    toJSON (SignersUserId u) = object [T.pack "signersUserId" .= u]-    toJSON (ReasonForRevocation rc rr) = object [T.pack "reasonForRevocation" .= (rc, rr)]-    toJSON (Features ffs) = object [T.pack "features" .= ffs]-    toJSON (SignatureTarget pka ha sh) = object [T.pack "signatureTarget" .= (pka, ha, BL.unpack sh)]-    toJSON (EmbeddedSignature sp) = object [T.pack "embeddedSignature" .= sp]-    toJSON (UserDefinedSigSub t bs) = object [T.pack "userDefinedSigSub" .= (t, BL.unpack bs)]-    toJSON (OtherSigSub t bs) = object [T.pack "otherSigSub" .= (t, BL.unpack bs)]--instance A.FromJSON SigSubPacketPayload where-    parseJSON (A.Object v) = (SigCreationTime <$> v A..: T.pack "sigCreationTime")-                         <|> (SigExpirationTime <$> v A..: T.pack "sigExpirationTime")-                         <|> (ExportableCertification <$> v A..: T.pack "exportableCertification")-                         <|> (uncurry TrustSignature <$> v A..: T.pack "trustSignature")-                         <|> (RegularExpression . BL.pack <$> v A..: T.pack "regularExpression")-                         <|> (Revocable <$> v A..: T.pack "revocable")-                         <|> (KeyExpirationTime <$> v A..: T.pack "keyExpirationTime")-                         <|> (PreferredSymmetricAlgorithms <$> v A..: T.pack "preferredSymmetricAlgorithms")-                         <|> (uc3 RevocationKey <$> v A..: T.pack "revocationKey")-                         <|> (Issuer <$> v A..: T.pack "issuer")-                         <|> (uc3 NotationData <$> v A..: T.pack "notationData")-    parseJSON _            = mzero--uc3 :: (a -> b -> c -> d) -> (a, b, c) -> d-uc3 f ~(a,b,c) = f a b c- data HashAlgorithm = DeprecatedMD5                    | SHA1                    | RIPEMD160@@ -416,8 +431,7 @@     pretty SHA224 = text "SHA-224"     pretty (OtherHA ha) = text "unknown hash algorithm type" <+> (text . show) ha -instance A.ToJSON HashAlgorithm-instance A.FromJSON HashAlgorithm+$(ATH.deriveJSON ATH.defaultOptions ''HashAlgorithm)  data CompressionAlgorithm = Uncompressed                           | ZIP@@ -453,73 +467,7 @@     pretty BZip2 = text "bzip2"     pretty (OtherCA ca) = text "unknown compression algorithm type" <+> (text . show) ca -instance A.ToJSON CompressionAlgorithm-instance A.FromJSON CompressionAlgorithm--class (Eq a, Ord a) => FutureVal a where-   fromFVal :: a -> Word8-   toFVal :: Word8 -> a--data PubKeyAlgorithm = RSA-                     | DeprecatedRSAEncryptOnly-                     | DeprecatedRSASignOnly-                     | ElgamalEncryptOnly-                     | DSA-                     | ECDH-                     | ECDSA-                     | ForbiddenElgamal-                     | DH-                     | OtherPKA Word8-    deriving (Show, Data, Generic, Typeable)--instance Eq PubKeyAlgorithm where-    (==) a b = fromFVal a == fromFVal b--instance Ord PubKeyAlgorithm where-    compare = comparing fromFVal--instance FutureVal PubKeyAlgorithm where-    fromFVal RSA = 1-    fromFVal DeprecatedRSAEncryptOnly = 2-    fromFVal DeprecatedRSASignOnly = 3-    fromFVal ElgamalEncryptOnly = 16-    fromFVal DSA = 17-    fromFVal ECDH = 18-    fromFVal ECDSA = 19-    fromFVal ForbiddenElgamal = 20-    fromFVal DH = 21-    fromFVal (OtherPKA o) = o-    toFVal 1 = RSA-    toFVal 2 = DeprecatedRSAEncryptOnly-    toFVal 3 = DeprecatedRSASignOnly-    toFVal 16 = ElgamalEncryptOnly-    toFVal 17 = DSA-    toFVal 18 = ECDH-    toFVal 19 = ECDSA-    toFVal 20 = ForbiddenElgamal-    toFVal 21 = DH-    toFVal o = OtherPKA o--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 pka = text "unknown pubkey algorithm type" <+> (text . show) pka--instance A.ToJSON PubKeyAlgorithm-instance A.FromJSON PubKeyAlgorithm--class (Eq a, Ord a) => FutureFlag a where-    fromFFlag :: a -> Int-    toFFlag :: Int -> a+$(ATH.deriveJSON ATH.defaultOptions ''CompressionAlgorithm)  data KSPFlag = NoModify              | KSPOther Int@@ -544,8 +492,7 @@     pretty NoModify = text "no-modify"     pretty (KSPOther o) = text "unknown keyserver preference flag type" <+> pretty o -instance A.ToJSON KSPFlag-instance A.FromJSON KSPFlag+$(ATH.deriveJSON ATH.defaultOptions ''KSPFlag)  data KeyFlag = GroupKey              | AuthKey@@ -594,34 +541,7 @@     pretty CertifyKeysKey = text "certify-keys"     pretty (KFOther o) = text "unknown key flag type" <+> pretty o -instance A.ToJSON KeyFlag-instance A.FromJSON KeyFlag--data RevocationClass = SensitiveRK-                     | RClOther Word8 -- FIXME: this should be constrained to 3 bits-    deriving (Data, Generic, Show, Typeable)--instance Eq RevocationClass where-    (==) a b = fromFFlag a == fromFFlag b--instance Ord RevocationClass where-    compare = comparing fromFFlag--instance FutureFlag RevocationClass where-    fromFFlag SensitiveRK = 1-    fromFFlag (RClOther i) = fromIntegral i--    toFFlag 1 = SensitiveRK-    toFFlag i = RClOther (fromIntegral i)--instance Hashable RevocationClass--instance Pretty RevocationClass where-    pretty SensitiveRK = text "sensitive"-    pretty (RClOther o) = text "unknown revocation class" <+> pretty o--instance A.ToJSON RevocationClass-instance A.FromJSON RevocationClass+$(ATH.deriveJSON ATH.defaultOptions ''KeyFlag)  data RevocationCode = NoReason                     | KeySuperseded@@ -661,8 +581,7 @@     pretty UserIdInfoNoLongerValid = text "user-ID info no longer valid"     pretty (RCoOther o) = text "unknown revocation code" <+> pretty o -instance A.ToJSON RevocationCode-instance A.FromJSON RevocationCode+$(ATH.deriveJSON ATH.defaultOptions ''RevocationCode)  data FeatureFlag = ModificationDetection                  | FeatureOther Int@@ -689,9 +608,109 @@     pretty ModificationDetection = text "modification-detection"     pretty (FeatureOther o) = text "unknown feature flag type" <+> pretty o -instance A.ToJSON FeatureFlag-instance A.FromJSON FeatureFlag+$(ATH.deriveJSON ATH.defaultOptions ''FeatureFlag) +newtype URL = URL {unURL :: URI}+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Newtype URL URI where+    pack = URL+    unpack (URL o) = o++instance Hashable URL where+    hashWithSalt salt (URL (URI s a p q f)) = salt `hashWithSalt` s `hashWithSalt` show a `hashWithSalt` p `hashWithSalt` q `hashWithSalt` f++instance Pretty URL where+    pretty = pretty . (\uri -> uriToString id uri "") . unpack++instance A.ToJSON URL where+    toJSON u = object [T.pack "uri" .= (\uri -> uriToString id uri "") (unpack u)]+instance A.FromJSON URL where+    parseJSON (A.Object v) = URL . fromMaybe nullURI . parseURI <$>+                                      v A..: T.pack "uri"+    parseJSON _            = mzero++data SigType = BinarySig+             | CanonicalTextSig+             | StandaloneSig+             | GenericCert+             | PersonaCert+             | CasualCert+             | PositiveCert+             | SubkeyBindingSig+             | PrimaryKeyBindingSig+             | SignatureDirectlyOnAKey+             | KeyRevocationSig+             | SubkeyRevocationSig+             | CertRevocationSig+             | TimestampSig+             | ThirdPartyConfirmationSig+             | OtherSig Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq SigType where+    (==) a b = fromFVal a == fromFVal b++instance Ord SigType where+    compare = comparing fromFVal++instance FutureVal SigType where+    fromFVal BinarySig = 0x00+    fromFVal CanonicalTextSig = 0x01+    fromFVal StandaloneSig = 0x02+    fromFVal GenericCert = 0x10+    fromFVal PersonaCert = 0x11+    fromFVal CasualCert = 0x12+    fromFVal PositiveCert = 0x13+    fromFVal SubkeyBindingSig = 0x18+    fromFVal PrimaryKeyBindingSig = 0x19+    fromFVal SignatureDirectlyOnAKey = 0x1F+    fromFVal KeyRevocationSig = 0x20+    fromFVal SubkeyRevocationSig = 0x28+    fromFVal CertRevocationSig = 0x30+    fromFVal TimestampSig = 0x40+    fromFVal ThirdPartyConfirmationSig = 0x50+    fromFVal (OtherSig o) = o++    toFVal 0x00 = BinarySig+    toFVal 0x01 = CanonicalTextSig+    toFVal 0x02 = StandaloneSig+    toFVal 0x10 = GenericCert+    toFVal 0x11 = PersonaCert+    toFVal 0x12 = CasualCert+    toFVal 0x13 = PositiveCert+    toFVal 0x18 = SubkeyBindingSig+    toFVal 0x19 = PrimaryKeyBindingSig+    toFVal 0x1F = SignatureDirectlyOnAKey+    toFVal 0x20 = KeyRevocationSig+    toFVal 0x28 = SubkeyRevocationSig+    toFVal 0x30 = CertRevocationSig+    toFVal 0x40 = TimestampSig+    toFVal 0x50 = ThirdPartyConfirmationSig+    toFVal o = OtherSig o++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++$(ATH.deriveJSON ATH.defaultOptions ''SigType)+ newtype MPI = MPI {unMPI :: Integer}     deriving (Data, Eq, Generic, Show, Typeable) @@ -704,8 +723,7 @@ instance Pretty MPI where     pretty = pretty . unpack -instance A.ToJSON MPI-instance A.FromJSON MPI+$(ATH.deriveJSON ATH.defaultOptions ''MPI)  data SignaturePayload = SigV3 SigType ThirtyTwoBitTimeStamp EightOctetKeyId PubKeyAlgorithm HashAlgorithm Word16 (NonEmpty MPI)                       | SigV4 SigType PubKeyAlgorithm HashAlgorithm [SigSubPacket] [SigSubPacket] Word16 (NonEmpty MPI)@@ -724,6 +742,119 @@     toJSON (SigV4 st pka ha hsps usps w16 mpis) = A.toJSON (st, pka, ha, hsps, usps, w16, NE.toList mpis)     toJSON (SigVOther t bs) = A.toJSON (t, BL.unpack bs) +data SigSubPacketPayload = SigCreationTime ThirtyTwoBitTimeStamp+                  | SigExpirationTime ThirtyTwoBitDuration+                  | ExportableCertification Exportability+                  | TrustSignature TrustLevel TrustAmount+                  | RegularExpression AlmostPublicDomainRegex+                  | Revocable Revocability+                  | KeyExpirationTime ThirtyTwoBitDuration+                  | PreferredSymmetricAlgorithms [SymmetricAlgorithm]+                  | RevocationKey (Set RevocationClass) PubKeyAlgorithm TwentyOctetFingerprint+                  | Issuer EightOctetKeyId+                  | NotationData (Set NotationFlag) NotationName NotationValue+                  | PreferredHashAlgorithms [HashAlgorithm]+                  | PreferredCompressionAlgorithms [CompressionAlgorithm]+                  | KeyServerPreferences (Set KSPFlag)+                  | PreferredKeyServer KeyServer+                  | PrimaryUserId Bool+                  | PolicyURL URL+                  | KeyFlags (Set KeyFlag)+                  | SignersUserId Text+                  | ReasonForRevocation RevocationCode RevocationReason+                  | Features (Set FeatureFlag)+                  | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash+                  | EmbeddedSignature SignaturePayload+                  | UserDefinedSigSub Word8 ByteString+                  | OtherSigSub Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME++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" <+> prettyList sas+    pretty (RevocationKey rcs pka tof) = text "revocation key" <+> prettyList (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 (PreferredCompressionAlgorithms pcas) = text "preferred compression algorithms" <+> pretty pcas+    pretty (KeyServerPreferences kspfs) = text "keyserver preferences" <+> prettyList (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 (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 (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++instance A.ToJSON SigSubPacketPayload where+    toJSON (SigCreationTime ts) = object [T.pack "sigCreationTime" .= ts]+    toJSON (SigExpirationTime d) = object [T.pack "sigExpirationTime" .= d]+    toJSON (ExportableCertification e) = object [T.pack "exportableCertification" .= e]+    toJSON (TrustSignature tl ta) = object [T.pack "trustSignature" .= (tl, ta)]+    toJSON (RegularExpression apdre) = object [T.pack "regularExpression" .= BL.unpack apdre]+    toJSON (Revocable r) = object [T.pack "revocable" .= r]+    toJSON (KeyExpirationTime d) = object [T.pack "keyExpirationTime" .= d]+    toJSON (PreferredSymmetricAlgorithms sas) = object [T.pack "preferredSymmetricAlgorithms" .= sas]+    toJSON (RevocationKey rcs pka tof) = object [T.pack "revocationKey" .= (rcs, pka, tof)]+    toJSON (Issuer eoki) = object [T.pack "issuer" .= eoki]+    toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) = object [T.pack "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)]+    toJSON (PreferredHashAlgorithms phas) = object [T.pack "preferredHashAlgorithms" .= phas]+    toJSON (PreferredCompressionAlgorithms pcas) = object [T.pack "preferredCompressionAlgorithms" .=  pcas]+    toJSON (KeyServerPreferences kspfs) = object [T.pack "keyServerPreferences" .= kspfs]+    toJSON (PreferredKeyServer ks) = object [T.pack "preferredKeyServer" .= show ks]+    toJSON (PrimaryUserId p) = object [T.pack "primaryUserId" .= p]+    toJSON (PolicyURL u) = object [T.pack "policyURL" .= u]+    toJSON (KeyFlags kfs) = object [T.pack "keyFlags" .= kfs]+    toJSON (SignersUserId u) = object [T.pack "signersUserId" .= u]+    toJSON (ReasonForRevocation rc rr) = object [T.pack "reasonForRevocation" .= (rc, rr)]+    toJSON (Features ffs) = object [T.pack "features" .= ffs]+    toJSON (SignatureTarget pka ha sh) = object [T.pack "signatureTarget" .= (pka, ha, BL.unpack sh)]+    toJSON (EmbeddedSignature sp) = object [T.pack "embeddedSignature" .= sp]+    toJSON (UserDefinedSigSub t bs) = object [T.pack "userDefinedSigSub" .= (t, BL.unpack bs)]+    toJSON (OtherSigSub t bs) = object [T.pack "otherSigSub" .= (t, BL.unpack bs)]++uc3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uc3 f ~(a,b,c) = f a b c++instance A.FromJSON SigSubPacketPayload where+    parseJSON (A.Object v) = (SigCreationTime <$> v A..: T.pack "sigCreationTime")+                         <|> (SigExpirationTime <$> v A..: T.pack "sigExpirationTime")+                         <|> (ExportableCertification <$> v A..: T.pack "exportableCertification")+                         <|> (uncurry TrustSignature <$> v A..: T.pack "trustSignature")+                         <|> (RegularExpression . BL.pack <$> v A..: T.pack "regularExpression")+                         <|> (Revocable <$> v A..: T.pack "revocable")+                         <|> (KeyExpirationTime <$> v A..: T.pack "keyExpirationTime")+                         <|> (PreferredSymmetricAlgorithms <$> v A..: T.pack "preferredSymmetricAlgorithms")+                         <|> (uc3 RevocationKey <$> v A..: T.pack "revocationKey")+                         <|> (Issuer <$> v A..: T.pack "issuer")+                         <|> (uc3 NotationData <$> v A..: T.pack "notationData")+    parseJSON _            = mzero++data SigSubPacket = SigSubPacket {+    _sspCriticality :: Bool+  , _sspPayload :: SigSubPacketPayload+  } deriving (Data, Eq, Generic, Show, Typeable)++instance Pretty SigSubPacket where+    pretty x = (if _sspCriticality x then char '*' else mempty) <> (pretty . _sspPayload) x++instance Hashable SigSubPacket++$(ATH.deriveJSON ATH.defaultOptions ''SigSubPacket)+$(makeLenses ''SigSubPacket)+ data KeyVersion = DeprecatedV3 | V4     deriving (Data, Eq, Generic, Ord, Show, Typeable) @@ -733,8 +864,7 @@     pretty DeprecatedV3 = text "(deprecated) v3"     pretty V4 = text "v4" -instance A.ToJSON KeyVersion-instance A.FromJSON KeyVersion+$(ATH.deriveJSON ATH.defaultOptions ''KeyVersion)  newtype IV = IV {unIV :: B.ByteString}     deriving (Byteable, ByteArrayAccess, Data, Eq, Generic, Hashable, Monoid, Show, Typeable)@@ -780,8 +910,7 @@     pretty UTF8Data = text "UTF-8"     pretty (OtherData o) = text "other data type " <+> (text . show) o -instance A.ToJSON DataType-instance A.FromJSON DataType+$(ATH.deriveJSON ATH.defaultOptions ''DataType)  newtype Salt = Salt {unSalt :: B.ByteString}     deriving (Byteable, Data, Eq, Generic, Hashable, Show, Typeable)@@ -806,8 +935,7 @@ instance Pretty IterationCount where     pretty = pretty . unpack -instance A.ToJSON IterationCount-instance A.FromJSON IterationCount+$(ATH.deriveJSON ATH.defaultOptions ''IterationCount)  data S2K = Simple HashAlgorithm          | Salted HashAlgorithm Salt@@ -829,40 +957,6 @@     toJSON (IteratedSalted ha salt icount) = A.toJSON (ha, salt, icount)     toJSON (OtherS2K t bs) = A.toJSON (t, BL.unpack bs) -data UserAttrSubPacket = ImageAttribute ImageHeader ImageData-                       | OtherUASub Word8 ByteString-    deriving (Data, Eq, Generic, Show, Typeable)--instance Hashable UserAttrSubPacket--instance Ord UserAttrSubPacket where-    compare (ImageAttribute h1 d1) (ImageAttribute h2 d2) = compare h1 h2 <> compare d1 d2-    compare (ImageAttribute _ _) (OtherUASub _ _) = LT-    compare (OtherUASub _ _) (ImageAttribute _ _) = GT-    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" <> (text . show) t <+> pretty (BL.unpack bs)--instance A.ToJSON UserAttrSubPacket where-    toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)-    toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs)--data ImageHeader = ImageHV1 ImageFormat-    deriving (Data, Eq, Generic, Show, Typeable)--instance Ord ImageHeader where-    compare (ImageHV1 a) (ImageHV1 b) = compare a b--instance Hashable ImageHeader--instance Pretty ImageHeader where-    pretty (ImageHV1 f) = text "imghdr v1" <+> pretty f--instance A.ToJSON ImageHeader-instance A.FromJSON ImageHeader- data ImageFormat = JPEG                  | OtherImage Word8     deriving (Data, Generic, Show, Typeable)@@ -886,91 +980,41 @@     pretty JPEG = text "JPEG"     pretty (OtherImage o) = text "unknown image format" <+> pretty o -instance A.ToJSON ImageFormat-instance A.FromJSON ImageFormat+$(ATH.deriveJSON ATH.defaultOptions ''ImageFormat) -data SigType = BinarySig-             | CanonicalTextSig-             | StandaloneSig-             | GenericCert-             | PersonaCert-             | CasualCert-             | PositiveCert-             | SubkeyBindingSig-             | PrimaryKeyBindingSig-             | SignatureDirectlyOnAKey-             | KeyRevocationSig-             | SubkeyRevocationSig-             | CertRevocationSig-             | TimestampSig-             | ThirdPartyConfirmationSig-             | OtherSig Word8-    deriving (Data, Generic, Show, Typeable)+data ImageHeader = ImageHV1 ImageFormat+    deriving (Data, Eq, Generic, Show, Typeable) -instance Eq SigType where-    (==) a b = fromFVal a == fromFVal b+instance Ord ImageHeader where+    compare (ImageHV1 a) (ImageHV1 b) = compare a b -instance Ord SigType where-    compare = comparing fromFVal+instance Hashable ImageHeader -instance FutureVal SigType where-    fromFVal BinarySig = 0x00-    fromFVal CanonicalTextSig = 0x01-    fromFVal StandaloneSig = 0x02-    fromFVal GenericCert = 0x10-    fromFVal PersonaCert = 0x11-    fromFVal CasualCert = 0x12-    fromFVal PositiveCert = 0x13-    fromFVal SubkeyBindingSig = 0x18-    fromFVal PrimaryKeyBindingSig = 0x19-    fromFVal SignatureDirectlyOnAKey = 0x1F-    fromFVal KeyRevocationSig = 0x20-    fromFVal SubkeyRevocationSig = 0x28-    fromFVal CertRevocationSig = 0x30-    fromFVal TimestampSig = 0x40-    fromFVal ThirdPartyConfirmationSig = 0x50-    fromFVal (OtherSig o) = o+instance Pretty ImageHeader where+    pretty (ImageHV1 f) = text "imghdr v1" <+> pretty f -    toFVal 0x00 = BinarySig-    toFVal 0x01 = CanonicalTextSig-    toFVal 0x02 = StandaloneSig-    toFVal 0x10 = GenericCert-    toFVal 0x11 = PersonaCert-    toFVal 0x12 = CasualCert-    toFVal 0x13 = PositiveCert-    toFVal 0x18 = SubkeyBindingSig-    toFVal 0x19 = PrimaryKeyBindingSig-    toFVal 0x1F = SignatureDirectlyOnAKey-    toFVal 0x20 = KeyRevocationSig-    toFVal 0x28 = SubkeyRevocationSig-    toFVal 0x30 = CertRevocationSig-    toFVal 0x40 = TimestampSig-    toFVal 0x50 = ThirdPartyConfirmationSig-    toFVal o = OtherSig o+$(ATH.deriveJSON ATH.defaultOptions ''ImageHeader) -instance Hashable SigType+data UserAttrSubPacket = ImageAttribute ImageHeader ImageData+                       | OtherUASub Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable) -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+instance Hashable UserAttrSubPacket -instance A.ToJSON SigType-instance A.FromJSON SigType+instance Ord UserAttrSubPacket where+    compare (ImageAttribute h1 d1) (ImageAttribute h2 d2) = compare h1 h2 <> compare d1 d2+    compare (ImageAttribute _ _) (OtherUASub _ _) = LT+    compare (OtherUASub _ _) (ImageAttribute _ _) = GT+    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" <> (text . show) t <+> pretty (BL.unpack bs)++instance A.ToJSON UserAttrSubPacket where+    toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)+    toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs)+ data ECCCurve = BrokenNISTP256               | BrokenNISTP384               | BrokenNISTP521@@ -980,67 +1024,3 @@  newtype Block a = Block {unBlock :: [a]} -- so we can override cereal instance     deriving (Show, Eq)--newtype EightOctetKeyId = EightOctetKeyId {unEOKI :: ByteString}-    deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Newtype EightOctetKeyId ByteString where-    pack = EightOctetKeyId-    unpack (EightOctetKeyId o) = o--instance Pretty EightOctetKeyId where-    pretty = text . w8sToHex . BL.unpack . unpack---- FIXME: read-show-instance Read EightOctetKeyId where-    readsPrec _ = map ((EightOctetKeyId . BL.pack *** concat) . unzip) . chunksOf 8 . hexToW8s--instance Hashable EightOctetKeyId--instance A.ToJSON EightOctetKeyId where-    toJSON e = object [T.pack "eoki" .= (w8sToHex . BL.unpack . unpack) e]--instance A.FromJSON EightOctetKeyId where-    parseJSON (A.Object v) = EightOctetKeyId . read <$>-                                      v A..: T.pack "eoki"-    parseJSON _            = mzero--newtype TwentyOctetFingerprint = TwentyOctetFingerprint {unTOF :: ByteString}-    deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Newtype TwentyOctetFingerprint ByteString where-    pack = TwentyOctetFingerprint-    unpack (TwentyOctetFingerprint o) = o---- FIXME: read-show-instance Read TwentyOctetFingerprint where-    readsPrec _ = map ((TwentyOctetFingerprint . BL.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ')--instance Hashable TwentyOctetFingerprint--instance Pretty TwentyOctetFingerprint where-    pretty = text . take 40 . w8sToHex . BL.unpack . unTOF--instance A.ToJSON TwentyOctetFingerprint where-    toJSON e = object [T.pack "fpr" .= (A.toJSON . show . pretty) e]-instance A.FromJSON TwentyOctetFingerprint where-    parseJSON (A.Object v) = TwentyOctetFingerprint . read <$>-                                      v A..: T.pack "fpr"-    parseJSON _            = mzero--newtype SpacedFingerprint = SpacedFingerprint { unSpacedFingerprint :: TwentyOctetFingerprint }--instance Newtype SpacedFingerprint TwentyOctetFingerprint where-    pack = SpacedFingerprint-    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--w8sToHex :: [Word8] -> String-w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "")--hexToW8s :: ReadS Word8-hexToW8s = concatMap readHex . chunksOf 2 . map toLower--$(makeLenses ''SigSubPacket)
Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}  module Codec.Encryption.OpenPGP.Types.Internal.PKITypes where @@ -16,6 +17,7 @@ import Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes  import qualified Data.Aeson as A+import qualified Data.Aeson.TH as ATH import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Data (Data)@@ -94,7 +96,7 @@ instance Pretty PKPayload where     pretty (PKPayload kv ts v3e pka p) = pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p -instance A.ToJSON PKPayload+$(ATH.deriveToJSON ATH.defaultOptions ''PKPayload)  data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString                 | SUSSHA1 SymmetricAlgorithm S2K IV ByteString
Codec/Encryption/OpenPGP/Types/Internal/TK.hs view
@@ -18,6 +18,7 @@  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) import Data.Ord (comparing)@@ -35,7 +36,7 @@ instance Ord TK where     compare = comparing _tkKey -- FIXME: is this ridiculous? -instance A.ToJSON TK+$(ATH.deriveToJSON ATH.defaultOptions ''TK)  type KeyringIxs = '[EightOctetKeyId, TwentyOctetFingerprint, Text] type Keyring = IxSet KeyringIxs TK
hOpenPGP.cabal view
@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             2.4.3+Version:             2.4.4 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581) Homepage:            http://floss.scru.org/hOpenPGP/@@ -335,4 +335,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v2.4.3+  tag:      v2.4.4