diff --git a/Codec/Encryption/OpenPGP/Types/Internal/Base.hs b/Codec/Encryption/OpenPGP/Types/Internal/Base.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/Base.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/Base.hs @@ -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) diff --git a/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/Types/Internal/TK.hs b/Codec/Encryption/OpenPGP/Types/Internal/TK.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/TK.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/TK.hs @@ -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 diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -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