core: derive JSON with TH (#3275)

* core: derive JSON with TH

* fix tests

* simplify events

* reduce diff

* fix

* update simplexmq

* update simplexmq

cabal.project

@@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: d920a2504b6d4653748da7d297cb13cd0a0f1f48
+    tag: 511d793b927b1e2f12999e0829718671b3a8f0cb
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."d920a2504b6d4653748da7d297cb13cd0a0f1f48" = "0r53wn01z044h6myvd458n3hiqsz64kpv59khgybzwdw5mmqnp34";
+  "https://github.com/simplex-chat/simplexmq.git"."511d793b927b1e2f12999e0829718671b3a8f0cb" = "14zk7g33x4a1g5d1dihaklvwzll86ks6fk87kf6l6l5back581zi";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."804fa283f067bd3fd89b8c5f8d25b3047813a517" = "1j67wp7rfybfx3ryx08z6gqmzj85j51hmzhgx47ihgmgr47sl895";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";

simplex-chat.cabal

@@ -36,6 +36,7 @@ library
       Simplex.Chat.Markdown
       Simplex.Chat.Messages
       Simplex.Chat.Messages.CIContent
+      Simplex.Chat.Messages.CIContent.Events
       Simplex.Chat.Migrations.M20220101_initial
       Simplex.Chat.Migrations.M20220122_v1_1
       Simplex.Chat.Migrations.M20220205_chat_item_status

src/Simplex/Chat.hs

@@ -58,6 +58,7 @@ import Simplex.Chat.Controller
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Messages.CIContent.Events
 import Simplex.Chat.Options
 import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol

src/Simplex/Chat/Call.hs

@@ -1,18 +1,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 {-# HLINT ignore "Use newtype instead of data" #-}
 
 module Simplex.Chat.Call where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
@@ -20,12 +20,11 @@ import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Types (Contact, ContactId, User)
 import Simplex.Chat.Types.Util (decodeJSON, encodeJSON)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
 
 data Call = Call
   { contactId :: ContactId,
@@ -47,14 +46,7 @@ data CallStateTag
   | CSTCallOfferSent
   | CSTCallOfferReceived
   | CSTCallNegotiated
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON CallStateTag where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CSTCall"
-
-instance ToJSON CallStateTag where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CSTCall"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CSTCall"
 
 callStateTag :: CallState -> CallStateTag
 callStateTag = \case
@@ -93,21 +85,7 @@ data CallState
         peerCallSession :: WebRTCSession,
         sharedKey :: Maybe C.Key
       }
-  deriving (Show, Generic)
+  deriving (Show)
-
--- database representation
-instance FromJSON CallState where
-  parseJSON = J.genericParseJSON $ singleFieldJSON fstToLower
-
-instance ToJSON CallState where
-  toJSON = J.genericToJSON $ singleFieldJSON fstToLower
-  toEncoding = J.genericToEncoding $ singleFieldJSON fstToLower
-
-instance ToField CallState where
-  toField = toField . encodeJSON
-
-instance FromField CallState where
-  fromField = fromTextField_ decodeJSON
 
 newtype CallId = CallId ByteString
   deriving (Eq, Show)
@@ -135,17 +113,13 @@ data RcvCallInvitation = RcvCallInvitation
     sharedKey :: Maybe C.Key,
     callTs :: UTCTime
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON RcvCallInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data CallType = CallType
   { media :: CallMedia,
     capabilities :: CallCapabilities
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 defaultCallType :: CallType
 defaultCallType = CallType CMVideo $ CallCapabilities {encryption = True}
@@ -153,95 +127,54 @@ defaultCallType = CallType CMVideo $ CallCapabilities {encryption = True}
 encryptedCall :: CallType -> Bool
 encryptedCall CallType {capabilities = CallCapabilities {encryption}} = encryption
 
-instance ToJSON CallType where toEncoding = J.genericToEncoding J.defaultOptions
-
 -- | * Types for chat protocol
 data CallInvitation = CallInvitation
   { callType :: CallType,
     callDhPubKey :: Maybe C.PublicKeyX25519
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON CallInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data CallMedia = CMAudio | CMVideo
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance FromJSON CallMedia where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CM"
-
-instance ToJSON CallMedia where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CM"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CM"
 
 data CallCapabilities = CallCapabilities
   { encryption :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON CallCapabilities where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 data CallOffer = CallOffer
   { callType :: CallType,
     rtcSession :: WebRTCSession,
     callDhPubKey :: Maybe C.PublicKeyX25519
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON CallOffer where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data WebRTCCallOffer = WebRTCCallOffer
   { callType :: CallType,
     rtcSession :: WebRTCSession
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON WebRTCCallOffer where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data CallAnswer = CallAnswer
   { rtcSession :: WebRTCSession
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON CallAnswer where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 data CallExtraInfo = CallExtraInfo
   { rtcExtraInfo :: WebRTCExtraInfo
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON CallExtraInfo where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 data WebRTCSession = WebRTCSession
   { rtcSession :: Text, -- LZW compressed JSON encoding of offer or answer
     rtcIceCandidates :: Text -- LZW compressed JSON encoding of array of ICE candidates
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON WebRTCSession where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 data WebRTCExtraInfo = WebRTCExtraInfo
   { rtcIceCandidates :: Text -- LZW compressed JSON encoding of array of ICE candidates
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON WebRTCExtraInfo where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 data WebRTCCallStatus = WCSConnecting | WCSConnected | WCSDisconnected | WCSFailed
   deriving (Show)
@@ -259,3 +192,37 @@ instance StrEncoding WebRTCCallStatus where
       "disconnected" -> pure WCSDisconnected
       "failed" -> pure WCSFailed
       _ -> fail "bad WebRTCCallStatus"
+
+$(J.deriveJSON (enumJSON $ dropPrefix "CSTCall") ''CallStateTag)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "CM") ''CallMedia)
+
+$(J.deriveJSON defaultJSON ''CallCapabilities)
+
+$(J.deriveJSON defaultJSON ''CallType)
+
+$(J.deriveJSON defaultJSON ''CallInvitation)
+
+$(J.deriveJSON defaultJSON ''WebRTCSession)
+
+$(J.deriveJSON defaultJSON ''CallOffer)
+
+$(J.deriveJSON defaultJSON ''WebRTCCallOffer)
+
+$(J.deriveJSON defaultJSON ''CallAnswer)
+
+$(J.deriveJSON defaultJSON ''WebRTCExtraInfo)
+
+$(J.deriveJSON defaultJSON ''CallExtraInfo)
+
+-- database representation
+$(J.deriveJSON (singleFieldJSON fstToLower) ''CallState)
+
+instance ToField CallState where
+  toField = toField . encodeJSON
+
+instance FromField CallState where
+  fromField = fromTextField_ decodeJSON
+
+$(J.deriveJSON defaultJSON ''RcvCallInvitation)
+

src/Simplex/Chat/Controller.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -41,7 +40,6 @@ import Data.String
 import Data.Text (Text)
 import Data.Time (NominalDiffTime, UTCTime)
 import Data.Version (showVersion)
-import GHC.Generics (Generic)
 import Language.Haskell.TH (Exp, Q, runIO)
 import Numeric.Natural
 import qualified Paths_simplex_chat as SC
@@ -67,7 +65,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (simplexMQVersion)
@@ -196,14 +194,7 @@ data ChatController = ChatController
   }
 
 data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSSettings | HSDatabase
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON HelpSection where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "HS"
-
-instance ToJSON HelpSection where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "HS"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "HS"
 
 data ChatCommand
   = ShowActiveUser
@@ -698,28 +689,14 @@ data ConnectionPlan
   = CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan}
   | CPContactAddress {contactAddressPlan :: ContactAddressPlan}
   | CPGroupLink {groupLinkPlan :: GroupLinkPlan}
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON ConnectionPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CP"
-
-instance ToJSON ConnectionPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CP"
 
 data InvitationLinkPlan
   = ILPOk
   | ILPOwnLink
   | ILPConnecting {contact_ :: Maybe Contact}
   | ILPKnown {contact :: Contact}
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON InvitationLinkPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "ILP"
-
-instance ToJSON InvitationLinkPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "ILP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "ILP"
 
 data ContactAddressPlan
   = CAPOk
@@ -727,14 +704,7 @@ data ContactAddressPlan
   | CAPConnectingConfirmReconnect
   | CAPConnectingProhibit {contact :: Contact}
   | CAPKnown {contact :: Contact}
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON ContactAddressPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CAP"
-
-instance ToJSON ContactAddressPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CAP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CAP"
 
 data GroupLinkPlan
   = GLPOk
@@ -742,14 +712,7 @@ data GroupLinkPlan
   | GLPConnectingConfirmReconnect
   | GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
   | GLPKnown {groupInfo :: GroupInfo}
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON GroupLinkPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "GLP"
-
-instance ToJSON GroupLinkPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "GLP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "GLP"
 
 connectionPlanProceed :: ConnectionPlan -> Bool
 connectionPlanProceed = \case
@@ -794,7 +757,7 @@ instance ToJSON AgentQueueId where
   toEncoding = strToJEncoding
 
 data ProtoServersConfig p = ProtoServersConfig {servers :: [ServerCfg p]}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (ProtoServersConfig p)
 
@@ -805,36 +768,17 @@ data UserProtoServers p = UserProtoServers
     protoServers :: NonEmpty (ServerCfg p),
     presetServers :: NonEmpty (ProtoServerWithAuth p)
   }
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
 
-instance FromJSON AUserProtoServers where
-  parseJSON v = J.withObject "AUserProtoServers" parse v
-    where
-      parse o = do
-        AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
-        case userProtocol p of
-          Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
-          Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
-
-instance ToJSON AUserProtoServers where
-  toJSON (AUPS s) = J.genericToJSON J.defaultOptions s
-  toEncoding (AUPS s) = J.genericToEncoding J.defaultOptions s
-
 deriving instance Show AUserProtoServers
 
 data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 data DBEncryptionConfig = DBEncryptionConfig {currentKey :: DBEncryptionKey, newKey :: DBEncryptionKey}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 newtype DBEncryptionKey = DBEncryptionKey String
   deriving (Show)
@@ -852,41 +796,25 @@ data ContactSubStatus = ContactSubStatus
   { contact :: Contact,
     contactError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON ContactSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data MemberSubStatus = MemberSubStatus
   { member :: GroupMember,
     memberError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON MemberSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data UserContactSubStatus = UserContactSubStatus
   { userContact :: UserContact,
     userContactError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON UserContactSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data PendingSubStatus = PendingSubStatus
   { connection :: PendingContactConnection,
     connError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON PendingSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data UserProfileUpdateSummary = UserProfileUpdateSummary
   { notChanged :: Int,
@@ -894,16 +822,14 @@ data UserProfileUpdateSummary = UserProfileUpdateSummary
     updateFailures :: Int,
     changedContacts :: [Contact]
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON UserProfileUpdateSummary where toEncoding = J.genericToEncoding J.defaultOptions
 
 data ComposedMessage = ComposedMessage
   { fileSource :: Maybe CryptoFile,
     quotedItemId :: Maybe ChatItemId,
     msgContent :: MsgContent
   }
-  deriving (Show, Generic)
+  deriving (Show)
 
 -- This instance is needed for backward compatibility, can be removed in v6.0
 instance FromJSON ComposedMessage where
@@ -918,24 +844,16 @@ instance FromJSON ComposedMessage where
   parseJSON invalid =
     JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid)
 
-instance ToJSON ComposedMessage where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
 data XFTPFileConfig = XFTPFileConfig
   { minFileSize :: Integer
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 defaultXFTPFileConfig :: XFTPFileConfig
 defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0}
 
-instance ToJSON XFTPFileConfig where toEncoding = J.genericToEncoding J.defaultOptions
-
 data NtfMsgInfo = NtfMsgInfo {msgTs :: UTCTime, msgFlags :: MsgFlags}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON NtfMsgInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 crNtfToken :: (DeviceToken, NtfTknStatus, NotificationsMode) -> ChatResponse
 crNtfToken (token, status, ntfMode) = CRNtfToken {token, status, ntfMode}
@@ -945,25 +863,19 @@ data SwitchProgress = SwitchProgress
     switchPhase :: SwitchPhase,
     connectionStats :: ConnectionStats
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON SwitchProgress where toEncoding = J.genericToEncoding J.defaultOptions
 
 data RatchetSyncProgress = RatchetSyncProgress
   { ratchetSyncStatus :: RatchetSyncState,
     connectionStats :: ConnectionStats
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON RatchetSyncProgress where toEncoding = J.genericToEncoding J.defaultOptions
 
 data ParsedServerAddress = ParsedServerAddress
   { serverAddress :: Maybe ServerAddress,
     parseError :: String
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON ParsedServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
 
 data ServerAddress = ServerAddress
   { serverProtocol :: AProtocolType,
@@ -972,9 +884,7 @@ data ServerAddress = ServerAddress
     keyHash :: String,
     basicAuth :: String
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON ServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
 
 data TimedMessagesEnabled
   = TMEEnableSetTTL Int
@@ -996,22 +906,18 @@ data CoreVersionInfo = CoreVersionInfo
     simplexmqVersion :: String,
     simplexmqCommit :: String
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON CoreVersionInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 data SendFileMode
   = SendFileSMP (Maybe InlineFileMode)
   | SendFileXFTP
-  deriving (Show, Generic)
+  deriving (Show)
 
 data SlowSQLQuery = SlowSQLQuery
   { query :: Text,
     queryStats :: SlowQueryStats
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON SlowSQLQuery where toEncoding = J.genericToEncoding J.defaultOptions
 
 data ChatError
   = ChatError {errorType :: ChatErrorType}
@@ -1020,14 +926,7 @@ data ChatError
   | ChatErrorDatabase {databaseError :: DatabaseError}
   | ChatErrorRemoteCtrl {remoteCtrlError :: RemoteCtrlError}
   | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
-
-instance FromJSON ChatError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "Chat"
-
-instance ToJSON ChatError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "Chat"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "Chat"
 
 data ChatErrorType
   = CENoActiveUser
@@ -1107,14 +1006,7 @@ data ChatErrorType
   | CEPeerChatVRangeIncompatible
   | CEInternalError {message :: String}
   | CEException {message :: String}
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
-
-instance FromJSON ChatErrorType where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CE"
-
-instance ToJSON ChatErrorType where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CE"
 
 data DatabaseError
   = DBErrorEncrypted
@@ -1122,24 +1014,10 @@ data DatabaseError
   | DBErrorNoFile {dbFile :: String}
   | DBErrorExport {sqliteError :: SQLiteError}
   | DBErrorOpen {sqliteError :: SQLiteError}
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
-
-instance FromJSON DatabaseError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "DB"
-
-instance ToJSON DatabaseError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DB"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DB"
 
 data SQLiteError = SQLiteErrorNotADatabase | SQLiteError String
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
-
-instance FromJSON SQLiteError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SQLite"
-
-instance ToJSON SQLiteError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SQLite"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SQLite"
 
 throwDBError :: ChatMonad m => DatabaseError -> m ()
 throwDBError = throwError . ChatErrorDatabase
@@ -1153,14 +1031,7 @@ data RemoteHostError
   | RHDisconnected {reason :: Text} -- ^ A session disconnected by a host
   | RHConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
   | RHProtocolError RemoteProtocolError
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
-
-instance FromJSON RemoteHostError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RH"
-
-instance ToJSON RemoteHostError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RH"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RH"
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteCtrlError
@@ -1176,26 +1047,12 @@ data RemoteCtrlError
   | RCEHTTP2RespStatus {statusCode :: Maybe Int} -- TODO remove
   | RCEInvalidResponse {responseError :: String}
   | RCEProtocolError {protocolError :: RemoteProtocolError}
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
-
-instance FromJSON RemoteCtrlError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE"
-
-instance ToJSON RemoteCtrlError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE"
 
 data ArchiveError
   = AEImport {chatError :: ChatError}
   | AEImportFile {file :: String, chatError :: ChatError}
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
-
-instance FromJSON ArchiveError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "AE"
-
-instance ToJSON ArchiveError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "AE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "AE"
 
 data RemoteCtrlSession = RemoteCtrlSession
   { -- | Host (mobile) side of transport to process remote commands and forward notifications
@@ -1295,4 +1152,83 @@ withStoreCtx ctx_ action = do
     handleInternal :: String -> SomeException -> IO (Either StoreError a)
     handleInternal ctxStr e = pure . Left . SEInternalError $ show e <> ctxStr
 
+$(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "ILP") ''InvitationLinkPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CAP") ''ContactAddressPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GLP") ''GroupLinkPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CP") ''ConnectionPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CE") ''ChatErrorType)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RH") ''RemoteHostError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RemoteCtrlError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "SQLite") ''SQLiteError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "DB") ''DatabaseError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "Chat") ''ChatError)
+
+$(JQ.deriveJSON defaultJSON ''ContactSubStatus)
+
+$(JQ.deriveJSON defaultJSON ''MemberSubStatus)
+
+$(JQ.deriveJSON defaultJSON ''UserContactSubStatus)
+
+$(JQ.deriveJSON defaultJSON ''PendingSubStatus)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "AE") ''ArchiveError)
+
+$(JQ.deriveJSON defaultJSON ''UserProfileUpdateSummary)
+
+$(JQ.deriveJSON defaultJSON ''NtfMsgInfo)
+
+$(JQ.deriveJSON defaultJSON ''SwitchProgress)
+
+$(JQ.deriveJSON defaultJSON ''RatchetSyncProgress)
+
+$(JQ.deriveJSON defaultJSON ''ServerAddress)
+
+$(JQ.deriveJSON defaultJSON ''ParsedServerAddress)
+
+$(JQ.deriveJSON defaultJSON ''CoreVersionInfo)
+
+$(JQ.deriveJSON defaultJSON ''SlowSQLQuery)
+
+instance ProtocolTypeI p => FromJSON (ProtoServersConfig p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ProtoServersConfig)
+
+instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''UserProtoServers)
+
+instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''UserProtoServers)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''UserProtoServers)
+
+instance FromJSON AUserProtoServers where
+  parseJSON v = J.withObject "AUserProtoServers" parse v
+    where
+      parse o = do
+        AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
+        case userProtocol p of
+          Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
+          Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
+
+instance ToJSON AUserProtoServers where
+  toJSON (AUPS s) = $(JQ.mkToJSON defaultJSON ''UserProtoServers) s
+  toEncoding (AUPS s) = $(JQ.mkToEncoding defaultJSON ''UserProtoServers) s
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
+
+$(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
+
+$(JQ.deriveFromJSON defaultJSON ''DBEncryptionConfig)
+
+$(JQ.deriveJSON defaultJSON ''XFTPFileConfig)
+
+$(JQ.deriveToJSON defaultJSON ''ComposedMessage)

src/Simplex/Chat/Markdown.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 {-# HLINT ignore "Use newtype instead of data" #-}
@@ -13,6 +13,7 @@ module Simplex.Chat.Markdown where
 import Control.Applicative (optional, (<|>))
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.Attoparsec.Text (Parser)
 import qualified Data.Attoparsec.Text as A
 import Data.Char (isDigit)
@@ -27,12 +28,11 @@ import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import GHC.Generics
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ConnReqScheme (..), ConnReqUriData (..), ConnectionRequestUri (..), SMPQueue (..))
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, sumTypeJSON)
 import Simplex.Messaging.Protocol (ProtocolServer (..))
 import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.Console.ANSI.Types
@@ -52,17 +52,10 @@ data Format
   | SimplexLink {linkType :: SimplexLinkType, simplexUri :: Text, smpHosts :: NonEmpty Text}
   | Email
   | Phone
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 data SimplexLinkType = XLContact | XLInvitation | XLGroup
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance FromJSON SimplexLinkType where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "XL"
-
-instance ToJSON SimplexLinkType where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "XL"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "XL"
 
 colored :: Color -> Format
 colored = Colored . FormatColor
@@ -70,13 +63,6 @@ colored = Colored . FormatColor
 markdown :: Format -> Text -> Markdown
 markdown = Markdown . Just
 
-instance FromJSON Format where
-  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
-
-instance ToJSON Format where
-  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
-  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
-
 instance Semigroup Markdown where
   m <> (Markdown _ "") = m
   (Markdown _ "") <> m = m
@@ -122,10 +108,7 @@ instance ToJSON FormatColor where
     White -> "white"
 
 data FormattedText = FormattedText {format :: Maybe Format, text :: Text}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON FormattedText where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 instance IsString FormattedText where
   fromString = FormattedText Nothing . T.pack
@@ -133,11 +116,6 @@ instance IsString FormattedText where
 type MarkdownList = [FormattedText]
 
 data ParsedMarkdown = ParsedMarkdown {formattedText :: Maybe MarkdownList}
-  deriving (Generic)
-
-instance ToJSON ParsedMarkdown where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 unmarked :: Text -> Markdown
 unmarked = Markdown Nothing
@@ -257,3 +235,11 @@ markdownP = mconcat <$> A.many' fragmentP
         linkType' ConnReqUriData {crClientData} = case crClientData >>= decodeJSON of
           Just (CRDataGroup _) -> XLGroup
           Nothing -> XLContact
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "XL") ''SimplexLinkType)
+
+$(JQ.deriveJSON (sumTypeJSON fstToLower) ''Format)
+
+$(JQ.deriveJSON defaultJSON ''FormattedText)
+
+$(JQ.deriveToJSON defaultJSON ''ParsedMarkdown)

src/Simplex/Chat/Messages.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -10,6 +9,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -20,6 +20,7 @@ import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON, ToJSON, (.:))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
+import qualified Data.Aeson.TH as JQ
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -33,7 +34,6 @@ import Data.Type.Equality
 import Data.Typeable (Typeable)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
@@ -43,17 +43,15 @@ import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptSta
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, enumJSON, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, parseAll, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Protocol (MsgBody)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 
 data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection
-  deriving (Eq, Show, Ord, Generic)
+  deriving (Eq, Show, Ord)
 
 data ChatName = ChatName {chatType :: ChatType, chatName :: Text}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON ChatName where toEncoding = J.genericToEncoding J.defaultOptions
 
 chatTypeStr :: ChatType -> String
 chatTypeStr = \case
@@ -68,13 +66,6 @@ chatNameStr (ChatName cType name) = chatTypeStr cType <> T.unpack name
 data ChatRef = ChatRef ChatType Int64
   deriving (Eq, Show, Ord)
 
-instance FromJSON ChatType where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CT"
-
-instance ToJSON ChatType where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CT"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CT"
-
 data ChatInfo (c :: ChatType) where
   DirectChat :: Contact -> ChatInfo 'CTDirect
   GroupChat :: GroupInfo -> ChatInfo 'CTGroup
@@ -113,14 +104,8 @@ data JSONChatInfo
   | JCInfoGroup {groupInfo :: GroupInfo}
   | JCInfoContactRequest {contactRequest :: UserContactRequest}
   | JCInfoContactConnection {contactConnection :: PendingContactConnection}
-  deriving (Generic)
 
-instance FromJSON JSONChatInfo where
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCInfo") ''JSONChatInfo)
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCInfo"
-
-instance ToJSON JSONChatInfo where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCInfo"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCInfo"
 
 instance ChatTypeI c => FromJSON (ChatInfo c) where
   parseJSON v = (\(AChatInfo _ c) -> checkChatType c) <$?> J.parseJSON v
@@ -163,14 +148,7 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
     reactions :: [CIReactionCount],
     file :: Maybe (CIFile d)
   }
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance (ChatTypeI c, MsgDirectionI d) => FromJSON (ChatItem c d) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance (ChatTypeI c, MsgDirectionI d) => ToJSON (ChatItem c d) where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 isMention :: ChatItem c d -> Bool
 isMention ChatItem {chatDir, quotedItem} = case chatDir of
@@ -195,34 +173,14 @@ deriving instance Show (CIDirection c d)
 
 data CCIDirection c = forall d. MsgDirectionI d => CCID (SMsgDirection d) (CIDirection c d)
 
-instance ChatTypeI c => FromJSON (CCIDirection c) where
-  parseJSON v = (\(ACID _ d x) -> checkChatType (CCID d x)) <$?> J.parseJSON v
-
 data ACIDirection = forall c d. (ChatTypeI c, MsgDirectionI d) => ACID (SChatType c) (SMsgDirection d) (CIDirection c d)
 
-instance FromJSON ACIDirection where
-  parseJSON v = jsonACIDirection <$> J.parseJSON v
-
 data JSONCIDirection
   = JCIDirectSnd
   | JCIDirectRcv
   | JCIGroupSnd
   | JCIGroupRcv {groupMember :: GroupMember}
-  deriving (Generic, Show)
+  deriving (Show)
-
-instance FromJSON JSONCIDirection where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI"
-
-instance ToJSON JSONCIDirection where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI"
-
-instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIDirection c d) where
-  parseJSON v = (\(CCID _ x') -> checkDirection x') <$?> J.parseJSON v
-
-instance ToJSON (CIDirection c d) where
-  toJSON = J.toJSON . jsonCIDirection
-  toEncoding = J.toEncoding . jsonCIDirection
 
 jsonCIDirection :: CIDirection c d -> JSONCIDirection
 jsonCIDirection = \case
@@ -239,26 +197,12 @@ jsonACIDirection = \case
   JCIGroupRcv m -> ACID SCTGroup SMDRcv $ CIGroupRcv m
 
 data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON CIReactionCount where toEncoding = J.genericToEncoding J.defaultOptions
 
 data CChatItem c = forall d. MsgDirectionI d => CChatItem (SMsgDirection d) (ChatItem c d)
 
 deriving instance Show (CChatItem c)
 
-instance forall c. ChatTypeI c => FromJSON (CChatItem c) where
-  parseJSON v = J.withObject "CChatItem" parse v
-    where
-      parse o = do
-        CCID d (_ :: CIDirection c d) <- o .: "chatDir"
-        ci <- J.parseJSON @(ChatItem c d) v
-        pure $ CChatItem d ci
-
-instance ChatTypeI c => ToJSON (CChatItem c) where
-  toJSON (CChatItem _ ci) = J.toJSON ci
-  toEncoding (CChatItem _ ci) = J.toEncoding ci
-
 cchatItemId :: CChatItem c -> ChatItemId
 cchatItemId (CChatItem _ ci) = chatItemId' ci
 
@@ -325,51 +269,25 @@ data Chat c = Chat
     chatItems :: [CChatItem c],
     chatStats :: ChatStats
   }
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance ChatTypeI c => ToJSON (Chat c) where toEncoding = J.genericToEncoding J.defaultOptions
 
 data AChat = forall c. ChatTypeI c => AChat (SChatType c) (Chat c)
 
 deriving instance Show AChat
 
-instance FromJSON AChat where
-  parseJSON = J.withObject "AChat" $ \o -> do
-    AChatInfo c chatInfo <- o .: "chatInfo"
-    chatItems <- o .: "chatItems"
-    chatStats <- o .: "chatStats"
-    pure $ AChat c Chat {chatInfo, chatItems, chatStats}
-
-instance ToJSON AChat where
-  toJSON (AChat _ c) = J.toJSON c
-  toEncoding (AChat _ c) = J.toEncoding c
-
 data ChatStats = ChatStats
   { unreadCount :: Int,
     minUnreadItemId :: ChatItemId,
     unreadChat :: Bool
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON ChatStats where toEncoding = J.genericToEncoding J.defaultOptions
 
 -- | type to show a mix of messages from multiple chats
 data AChatItem = forall c d. (ChatTypeI c, MsgDirectionI d) => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)
 
 deriving instance Show AChatItem
 
-instance FromJSON AChatItem where
-  parseJSON = J.withObject "AChatItem" $ \o -> do
-    AChatInfo c chatInfo <- o .: "chatInfo"
-    CChatItem d chatItem <- o .: "chatItem"
-    pure $ AChatItem c d chatInfo chatItem
-
-instance ToJSON AChatItem where
-  toJSON (AChatItem _ _ chat item) = J.toJSON $ JSONAnyChatItem chat item
-  toEncoding (AChatItem _ _ chat item) = J.toEncoding $ JSONAnyChatItem chat item
-
 data JSONAnyChatItem c d = JSONAnyChatItem {chatInfo :: ChatInfo c, chatItem :: ChatItem c d}
-  deriving (Generic)
 
 aChatItems :: AChat -> [AChatItem]
 aChatItems (AChat ct Chat {chatInfo, chatItems}) = map aChatItem chatItems
@@ -387,10 +305,6 @@ updateFileStatus ci@ChatItem {file} status = case file of
   Just f -> ci {file = Just (f :: CIFile d) {fileStatus = status}}
   Nothing -> ci
 
-instance (ChatTypeI c, MsgDirectionI d) => ToJSON (JSONAnyChatItem c d) where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
-
 -- This type is not saved to DB, so all JSON encodings are platform-specific
 data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
   { itemId :: ChatItemId,
@@ -406,7 +320,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d
 mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs createdAt updatedAt =
@@ -415,15 +329,11 @@ mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted item
         _ -> False
    in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, createdAt, updatedAt}
 
-instance ChatTypeI c => ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions
-
 data CITimed = CITimed
   { ttl :: Int, -- seconds
     deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON CITimed where toEncoding = J.genericToEncoding J.defaultOptions
 
 ttl' :: CITimed -> Int
 ttl' CITimed {ttl} = ttl
@@ -457,14 +367,7 @@ data CIQuote (c :: ChatType) = CIQuote
     content :: MsgContent,
     formattedText :: Maybe MarkdownList
   }
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance ChatTypeI c => FromJSON (CIQuote c) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ToJSON (CIQuote c) where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
   { chatDir :: CIDirection c d,
@@ -472,41 +375,15 @@ data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
     sentAt :: UTCTime,
     reaction :: MsgReaction
   }
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIReaction c d) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ChatTypeI c => ToJSON (CIReaction c d) where
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 data AnyCIReaction = forall c d. ChatTypeI c => ACIR (SChatType c) (SMsgDirection d) (CIReaction c d)
 
-instance FromJSON AnyCIReaction where
-  parseJSON v = J.withObject "AnyCIReaction" parse v
-    where
-      parse o = do
-        ACID c d (_ :: CIDirection c d) <- o .: "chatDir"
-        ACIR c d <$> J.parseJSON @(CIReaction c d) v
-
 data ACIReaction = forall c d. ChatTypeI c => ACIReaction (SChatType c) (SMsgDirection d) (ChatInfo c) (CIReaction c d)
 
 deriving instance Show ACIReaction
 
-instance FromJSON ACIReaction where
-  parseJSON = J.withObject "ACIReaction" $ \o -> do
-    ACIR c d reaction <- o .: "chatReaction"
-    cInfo <- o .: "chatInfo"
-    pure $ ACIReaction c d cInfo reaction
-
-instance ToJSON ACIReaction where
-  toJSON (ACIReaction _ _ cInfo reaction) = J.toJSON $ JSONCIReaction cInfo reaction
-  toEncoding (ACIReaction _ _ cInfo reaction) = J.toEncoding $ JSONCIReaction cInfo reaction
-
 data JSONCIReaction c d = JSONCIReaction {chatInfo :: ChatInfo c, chatReaction :: CIReaction c d}
-  deriving (Generic)
-
-instance ChatTypeI c => ToJSON (JSONCIReaction c d) where toEncoding = J.genericToEncoding J.defaultOptions
 
 data CIQDirection (c :: ChatType) where
   CIQDirectSnd :: CIQDirection 'CTDirect
@@ -518,13 +395,6 @@ deriving instance Show (CIQDirection c)
 
 data ACIQDirection = forall c. ChatTypeI c => ACIQDirection (SChatType c) (CIQDirection c)
 
-instance ChatTypeI c => FromJSON (CIQDirection c) where
-  parseJSON v = (\(ACIQDirection _ x) -> checkChatType x) . jsonACIQDirection <$?> J.parseJSON v
-
-instance ToJSON (CIQDirection c) where
-  toJSON = J.toJSON . jsonCIQDirection
-  toEncoding = J.toEncoding . jsonCIQDirection
-
 jsonCIQDirection :: CIQDirection c -> Maybe JSONCIDirection
 jsonCIQDirection = \case
   CIQDirectSnd -> Just JCIDirectSnd
@@ -556,14 +426,7 @@ data CIFile (d :: MsgDirection) = CIFile
     fileStatus :: CIFileStatus d,
     fileProtocol :: FileProtocol
   }
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance MsgDirectionI d => FromJSON (CIFile d) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance MsgDirectionI d => ToJSON (CIFile d) where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data FileProtocol = FPSMP | FPXFTP
   deriving (Eq, Show, Ord)
@@ -621,17 +484,6 @@ ciFileEnded = \case
   CIFSRcvError -> True
   CIFSInvalid {} -> True
 
-instance MsgDirectionI d => FromJSON (CIFileStatus d) where
-  parseJSON v = (\(AFS _ s) -> checkDirection s) . aciFileStatusJSON <$?> J.parseJSON v
-
-instance ToJSON (CIFileStatus d) where
-  toJSON = J.toJSON . jsonCIFileStatus
-  toEncoding = J.toEncoding . jsonCIFileStatus
-
-instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode
-
-instance FromField ACIFileStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
 data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d)
 
 deriving instance Show ACIFileStatus
@@ -689,14 +541,6 @@ data JSONCIFileStatus
   | JCIFSRcvCancelled
   | JCIFSRcvError
   | JCIFSInvalid {text :: Text}
-  deriving (Generic)
-
-instance FromJSON JSONCIFileStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCIFS"
-
-instance ToJSON JSONCIFileStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIFS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIFS"
 
 jsonCIFileStatus :: CIFileStatus d -> JSONCIFileStatus
 jsonCIFileStatus = \case
@@ -758,19 +602,6 @@ deriving instance Eq (CIStatus d)
 
 deriving instance Show (CIStatus d)
 
-instance MsgDirectionI d => FromJSON (CIStatus d) where
-  parseJSON v = (\(ACIStatus _ s) -> checkDirection s) . jsonACIStatus <$?> J.parseJSON v
-
-instance ToJSON (CIStatus d) where
-  toJSON = J.toJSON . jsonCIStatus
-  toEncoding = J.toEncoding . jsonCIStatus
-
-instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode
-
-instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
-instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
 data ACIStatus = forall d. MsgDirectionI d => ACIStatus (SMsgDirection d) (CIStatus d)
 
 deriving instance Show ACIStatus
@@ -813,14 +644,7 @@ data JSONCIStatus
   | JCISRcvNew
   | JCISRcvRead
   | JCISInvalid {text :: Text}
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON JSONCIStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCIS"
-
-instance ToJSON JSONCIStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIS"
 
 jsonCIStatus :: CIStatus d -> JSONCIStatus
 jsonCIStatus = \case
@@ -872,14 +696,7 @@ membersGroupItemStatus memStatusCounts
 data SndCIStatusProgress
   = SSPPartial
   | SSPComplete
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance FromJSON SndCIStatusProgress where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "SSP"
-
-instance ToJSON SndCIStatusProgress where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "SSP"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "SSP"
 
 instance StrEncoding SndCIStatusProgress where
   strEncode = \case
@@ -929,13 +746,6 @@ instance ChatTypeI 'CTContactRequest where chatTypeI = SCTContactRequest
 
 instance ChatTypeI 'CTContactConnection where chatTypeI = SCTContactConnection
 
-instance ChatTypeI c => FromJSON (SChatType c) where
-  parseJSON v = (\(ACT t) -> checkChatType t) . aChatType <$?> J.parseJSON v
-
-instance ToJSON (SChatType c) where
-  toJSON = J.toJSON . toChatType
-  toEncoding = J.toEncoding . toChatType
-
 toChatType :: SChatType c -> ChatType
 toChatType = \case
   SCTDirect -> CTDirect
@@ -1007,9 +817,7 @@ data MsgMetaJSON = MsgMetaJSON
     serverTs :: UTCTime,
     sndId :: Int64
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON MsgMetaJSON where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 msgMetaToJson :: MsgMeta -> MsgMetaJSON
 msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sndMsgId = sndId} =
@@ -1022,9 +830,6 @@ msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId
       sndId
     }
 
-msgMetaJson :: MsgMeta -> Text
-msgMetaJson = decodeLatin1 . LB.toStrict . J.encode . msgMetaToJson
-
 data MsgDeliveryStatus (d :: MsgDirection) where
   MDSRcvAgent :: MsgDeliveryStatus 'MDRcv
   MDSRcvAcknowledged :: MsgDeliveryStatus 'MDRcv
@@ -1081,25 +886,11 @@ deriving instance Show (CIDeleted c)
 
 data ACIDeleted = forall c. ChatTypeI c => ACIDeleted (SChatType c) (CIDeleted c)
 
-instance ChatTypeI c => FromJSON (CIDeleted c) where
-  parseJSON v = (\(ACIDeleted _ x) -> checkChatType x) . jsonACIDeleted <$?> J.parseJSON v
-
-instance ChatTypeI c => ToJSON (CIDeleted c) where
-  toJSON = J.toJSON . jsonCIDeleted
-  toEncoding = J.toEncoding . jsonCIDeleted
-
 data JSONCIDeleted
   = JCIDDeleted {deletedTs :: Maybe UTCTime, chatType :: ChatType}
   | JCIDBlocked {deletedTs :: Maybe UTCTime}
   | JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON JSONCIDeleted where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCID"
-
-instance ToJSON JSONCIDeleted where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCID"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCID"
 
 jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted
 jsonCIDeleted = \case
@@ -1123,9 +914,7 @@ data ChatItemInfo = ChatItemInfo
   { itemVersions :: [ChatItemVersion],
     memberDeliveryStatuses :: Maybe [MemberDeliveryStatus]
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON ChatItemInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 data ChatItemVersion = ChatItemVersion
   { chatItemVersionId :: Int64,
@@ -1134,9 +923,7 @@ data ChatItemVersion = ChatItemVersion
     itemVersionTs :: UTCTime,
     createdAt :: UTCTime
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON ChatItemVersion where toEncoding = J.genericToEncoding J.defaultOptions
 
 mkItemVersion :: ChatItem c d -> Maybe ChatItemVersion
 mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
@@ -1155,9 +942,7 @@ data MemberDeliveryStatus = MemberDeliveryStatus
   { groupMemberId :: GroupMemberId,
     memberDeliveryStatus :: CIStatus 'MDSnd
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON MemberDeliveryStatus where toEncoding = J.genericToEncoding J.defaultOptions
 
 data CIModeration = CIModeration
   { moderationId :: Int64,
@@ -1166,3 +951,187 @@ data CIModeration = CIModeration
     moderatedAt :: UTCTime
   }
   deriving (Show)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "CT") ''ChatType)
+
+instance ChatTypeI c => FromJSON (SChatType c) where
+  parseJSON v = (\(ACT t) -> checkChatType t) . aChatType <$?> J.parseJSON v
+
+instance ToJSON (SChatType c) where
+  toJSON = J.toJSON . toChatType
+  toEncoding = J.toEncoding . toChatType
+
+$(JQ.deriveJSON defaultJSON ''ChatName)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCID") ''JSONCIDeleted)
+
+instance ChatTypeI c => FromJSON (CIDeleted c) where
+  parseJSON v = (\(ACIDeleted _ x) -> checkChatType x) . jsonACIDeleted <$?> J.parseJSON v
+
+instance ChatTypeI c => ToJSON (CIDeleted c) where
+  toJSON = J.toJSON . jsonCIDeleted
+  toEncoding = J.toEncoding . jsonCIDeleted
+
+$(JQ.deriveJSON defaultJSON ''CITimed)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "SSP") ''SndCIStatusProgress)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCIS") ''JSONCIStatus)
+
+instance MsgDirectionI d => FromJSON (CIStatus d) where
+  parseJSON v = (\(ACIStatus _ s) -> checkDirection s) . jsonACIStatus <$?> J.parseJSON v
+
+instance ToJSON (CIStatus d) where
+  toJSON = J.toJSON . jsonCIStatus
+  toEncoding = J.toEncoding . jsonCIStatus
+
+instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode
+
+instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+$(JQ.deriveJSON defaultJSON ''MemberDeliveryStatus)
+
+$(JQ.deriveJSON defaultJSON ''ChatItemVersion)
+
+$(JQ.deriveJSON defaultJSON ''ChatItemInfo)
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIMeta c d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIMeta)
+
+instance ChatTypeI c => ToJSON (CIMeta c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''CIMeta)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''CIMeta)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCIFS") ''JSONCIFileStatus)
+
+instance MsgDirectionI d => FromJSON (CIFileStatus d) where
+  parseJSON v = (\(AFS _ s) -> checkDirection s) . aciFileStatusJSON <$?> J.parseJSON v
+
+instance ToJSON (CIFileStatus d) where
+  toJSON = J.toJSON . jsonCIFileStatus
+  toEncoding = J.toEncoding . jsonCIFileStatus
+
+instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode
+
+instance FromField ACIFileStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance MsgDirectionI d => FromJSON (CIFile d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIFile)
+
+instance MsgDirectionI d => ToJSON (CIFile d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''CIFile)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''CIFile)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCI") ''JSONCIDirection)
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIDirection c d) where
+  parseJSON v = (\(CCID _ x') -> checkDirection x') <$?> J.parseJSON v
+
+instance ToJSON (CIDirection c d) where
+  toJSON = J.toJSON . jsonCIDirection
+  toEncoding = J.toEncoding . jsonCIDirection
+
+instance ChatTypeI c => FromJSON (CCIDirection c) where
+  parseJSON v = (\(ACID _ d x) -> checkChatType (CCID d x)) <$?> J.parseJSON v
+
+instance FromJSON ACIDirection where
+  parseJSON v = jsonACIDirection <$> J.parseJSON v
+
+instance ChatTypeI c => FromJSON (CIQDirection c) where
+  parseJSON v = (\(ACIQDirection _ x) -> checkChatType x) . jsonACIQDirection <$?> J.parseJSON v
+
+instance ToJSON (CIQDirection c) where
+  toJSON = J.toJSON . jsonCIQDirection
+  toEncoding = J.toEncoding . jsonCIQDirection
+
+instance ChatTypeI c => FromJSON (CIQuote c) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIQuote)
+
+$(JQ.deriveToJSON defaultJSON ''CIQuote)
+
+$(JQ.deriveJSON defaultJSON ''CIReactionCount)
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (ChatItem c d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ChatItem)
+
+instance (ChatTypeI c, MsgDirectionI d) => ToJSON (ChatItem c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''ChatItem)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''ChatItem)
+
+instance (ChatTypeI c, MsgDirectionI d) => ToJSON (JSONAnyChatItem c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''JSONAnyChatItem)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''JSONAnyChatItem)
+
+instance FromJSON AChatItem where
+  parseJSON = J.withObject "AChatItem" $ \o -> do
+    AChatInfo c chatInfo <- o .: "chatInfo"
+    CChatItem d chatItem <- o .: "chatItem"
+    pure $ AChatItem c d chatInfo chatItem
+
+instance ToJSON AChatItem where
+  toJSON (AChatItem _ _ chat item) = J.toJSON $ JSONAnyChatItem chat item
+  toEncoding (AChatItem _ _ chat item) = J.toEncoding $ JSONAnyChatItem chat item
+
+instance forall c. ChatTypeI c => FromJSON (CChatItem c) where
+  parseJSON v = J.withObject "CChatItem" parse v
+    where
+      parse o = do
+        CCID d (_ :: CIDirection c d) <- o .: "chatDir"
+        ci <- J.parseJSON @(ChatItem c d) v
+        pure $ CChatItem d ci
+
+instance ChatTypeI c => ToJSON (CChatItem c) where
+  toJSON (CChatItem _ ci) = J.toJSON ci
+  toEncoding (CChatItem _ ci) = J.toEncoding ci
+
+$(JQ.deriveJSON defaultJSON ''ChatStats)
+
+instance ChatTypeI c => ToJSON (Chat c) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''Chat)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''Chat)
+
+instance FromJSON AChat where
+  parseJSON = J.withObject "AChat" $ \o -> do
+    AChatInfo c chatInfo <- o .: "chatInfo"
+    chatItems <- o .: "chatItems"
+    chatStats <- o .: "chatStats"
+    pure $ AChat c Chat {chatInfo, chatItems, chatStats}
+
+instance ToJSON AChat where
+  toJSON (AChat _ c) = J.toJSON c
+  toEncoding (AChat _ c) = J.toEncoding c
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIReaction c d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIReaction)
+
+instance ChatTypeI c => ToJSON (CIReaction c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''CIReaction)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''CIReaction)
+
+instance FromJSON AnyCIReaction where
+  parseJSON v = J.withObject "AnyCIReaction" parse v
+    where
+      parse o = do
+        ACID c d (_ :: CIDirection c d) <- o .: "chatDir"
+        ACIR c d <$> J.parseJSON @(CIReaction c d) v
+
+instance ChatTypeI c => ToJSON (JSONCIReaction c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''JSONCIReaction)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''JSONCIReaction)
+
+instance FromJSON ACIReaction where
+  parseJSON = J.withObject "ACIReaction" $ \o -> do
+    ACIR c d reaction <- o .: "chatReaction"
+    cInfo <- o .: "chatInfo"
+    pure $ ACIReaction c d cInfo reaction
+
+instance ToJSON ACIReaction where
+  toJSON (ACIReaction _ _ cInfo reaction) = J.toJSON $ JSONCIReaction cInfo reaction
+  toEncoding (ACIReaction _ _ cInfo reaction) = J.toEncoding $ JSONCIReaction cInfo reaction
+
+$(JQ.deriveJSON defaultJSON ''MsgMetaJSON)
+
+msgMetaJson :: MsgMeta -> Text
+msgMetaJson = decodeLatin1 . LB.toStrict . J.encode . msgMetaToJson

src/Simplex/Chat/Messages/CIContent.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -14,9 +13,9 @@
 
 module Simplex.Chat.Messages.CIContent where
 
-import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
-import qualified Data.Aeson.TH  as JQ
+import qualified Data.Aeson.TH as JQ
+import Data.Aeson.Types as JT
 import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -24,25 +23,20 @@ import Data.Type.Equality
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
+import Simplex.Chat.Messages.CIContent.Events
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..))
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow, (<$?>))
 
 data MsgDirection = MDRcv | MDSnd
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
-instance FromJSON MsgDirection where
+$(JQ.deriveJSON (enumJSON $ dropPrefix "MD") ''MsgDirection)
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MD"
-
-instance ToJSON MsgDirection where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "MD"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MD"
 
 instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgDirection . msgDirectionIntP
 
@@ -106,14 +100,9 @@ msgDirectionIntP = \case
   _ -> Nothing
 
 data CIDeleteMode = CIDMBroadcast | CIDMInternal
-  deriving (Show, Generic)
+  deriving (Show)
 
-instance ToJSON CIDeleteMode where
+$(JQ.deriveJSON (enumJSON $ dropPrefix "CIDM") ''CIDeleteMode)
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIDM"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIDM"
-
-instance FromJSON CIDeleteMode where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIDM"
 
 ciDeleteModeToText :: CIDeleteMode -> Text
 ciDeleteModeToText = \case
@@ -163,14 +152,7 @@ ciMsgContent = \case
   _ -> Nothing
 
 data MsgDecryptError = MDERatchetHeader | MDETooManySkipped | MDERatchetEarlier | MDEOther
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance ToJSON MsgDecryptError where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "MDE"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MDE"
-
-instance FromJSON MsgDecryptError where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MDE"
 
 ciRequiresAttention :: forall d. MsgDirectionI d => CIContent d -> Bool
 ciRequiresAttention content = case msgDirection @d of
@@ -204,135 +186,14 @@ ciRequiresAttention content = case msgDirection @d of
     CIRcvModerated -> True
     CIInvalidJSON _ -> False
 
-data RcvGroupEvent
-  = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting
-  | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
-  | RGEMemberLeft -- CRLeftMember
-  | RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
-  | RGEUserRole {role :: GroupMemberRole}
-  | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
-  | RGEUserDeleted -- CRDeletedMemberUser
-  | RGEGroupDeleted -- CRGroupDeleted
-  | RGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
-  -- RGEInvitedViaGroupLink chat items are not received - they're created when sending group invitations,
-  -- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message")
-  -- and be created as unread without adding / working around new status for sent items
-  | RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink
-  | RGEMemberCreatedContact -- CRNewMemberContactReceivedInv
-  deriving (Show, Generic)
-
-instance FromJSON RcvGroupEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RGE"
-
-instance ToJSON RcvGroupEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RGE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RGE"
-
-newtype DBRcvGroupEvent = RGE RcvGroupEvent
-
-instance FromJSON DBRcvGroupEvent where
-  parseJSON v = RGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RGE") v
-
-instance ToJSON DBRcvGroupEvent where
-  toJSON (RGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RGE") v
-  toEncoding (RGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RGE") v
-
-data SndGroupEvent
-  = SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
-  | SGEUserRole {role :: GroupMemberRole}
-  | SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
-  | SGEUserLeft -- CRLeftMemberUser
-  | SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
-  deriving (Show, Generic)
-
-instance FromJSON SndGroupEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SGE"
-
-instance ToJSON SndGroupEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SGE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SGE"
-
-newtype DBSndGroupEvent = SGE SndGroupEvent
-
-instance FromJSON DBSndGroupEvent where
-  parseJSON v = SGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SGE") v
-
-instance ToJSON DBSndGroupEvent where
-  toJSON (SGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SGE") v
-  toEncoding (SGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SGE") v
-
-data RcvConnEvent
-  = RCESwitchQueue {phase :: SwitchPhase}
-  | RCERatchetSync {syncStatus :: RatchetSyncState}
-  | RCEVerificationCodeReset
-  deriving (Show, Generic)
-
-data SndConnEvent
-  = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef}
-  | SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef}
-  deriving (Show, Generic)
-
-instance FromJSON RcvConnEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE"
-
-instance ToJSON RcvConnEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE"
-
-newtype DBRcvConnEvent = RCE RcvConnEvent
-
-instance FromJSON DBRcvConnEvent where
-  parseJSON v = RCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RCE") v
-
-instance ToJSON DBRcvConnEvent where
-  toJSON (RCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RCE") v
-  toEncoding (RCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RCE") v
-
-instance FromJSON SndConnEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SCE"
-
-instance ToJSON SndConnEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SCE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SCE"
-
-newtype DBSndConnEvent = SCE SndConnEvent
-
-instance FromJSON DBSndConnEvent where
-  parseJSON v = SCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SCE") v
-
-instance ToJSON DBSndConnEvent where
-  toJSON (SCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SCE") v
-  toEncoding (SCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SCE") v
-
-data RcvDirectEvent =
-  -- RDEProfileChanged {...}
-  RDEContactDeleted
-  deriving (Show, Generic)
-
-instance FromJSON RcvDirectEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RDE"
-
-instance ToJSON RcvDirectEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RDE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RDE"
-
-newtype DBRcvDirectEvent = RDE RcvDirectEvent
-
-instance FromJSON DBRcvDirectEvent where
-  parseJSON v = RDE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RDE") v
-
-instance ToJSON DBRcvDirectEvent where
-  toJSON (RDE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RDE") v
-  toEncoding (RDE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RDE") v
-
 newtype DBMsgErrorType = DBME MsgErrorType
 
 instance FromJSON DBMsgErrorType where
-  parseJSON v = DBME <$> J.genericParseJSON (singleFieldJSON fstToLower) v
+  parseJSON v = DBME <$> $(JQ.mkParseJSON (singleFieldJSON fstToLower) ''MsgErrorType) v
 
 instance ToJSON DBMsgErrorType where
-  toJSON (DBME v) = J.genericToJSON (singleFieldJSON fstToLower) v
+  toJSON (DBME v) = $(JQ.mkToJSON (singleFieldJSON fstToLower) ''MsgErrorType) v
-  toEncoding (DBME v) = J.genericToEncoding (singleFieldJSON fstToLower) v
+  toEncoding (DBME v) = $(JQ.mkToEncoding (singleFieldJSON fstToLower) ''MsgErrorType) v
 
 data CIGroupInvitation = CIGroupInvitation
   { groupId :: GroupId,
@@ -341,25 +202,14 @@ data CIGroupInvitation = CIGroupInvitation
     groupProfile :: GroupProfile,
     status :: CIGroupInvitationStatus
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON CIGroupInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data CIGroupInvitationStatus
   = CIGISPending
   | CIGISAccepted
   | CIGISRejected
   | CIGISExpired
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance FromJSON CIGroupInvitationStatus where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIGIS"
-
-instance ToJSON CIGroupInvitationStatus where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIGIS"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIGIS"
 
 ciContentToText :: CIContent d -> Text
 ciContentToText = \case
@@ -685,6 +535,12 @@ ciCallInfoText status duration = case status of
   CISCallEnded -> "ended " <> durationText duration
   CISCallError -> "error"
 
+$(JQ.deriveJSON (enumJSON $ dropPrefix "MDE") ''MsgDecryptError)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "CIGIS") ''CIGroupInvitationStatus)
+
+$(JQ.deriveJSON defaultJSON ''CIGroupInvitation)
+
 $(JQ.deriveJSON (enumJSON $ dropPrefix "CISCall") ''CICallStatus)
 
 -- platform specific

src/Simplex/Chat/Messages/CIContent/Events.hs

@@ -0,0 +1,116 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Chat.Messages.CIContent.Events where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson.TH as J
+import Simplex.Chat.Types
+import Simplex.Messaging.Agent.Protocol (RatchetSyncState (..), SwitchPhase (..))
+import Simplex.Messaging.Parsers (dropPrefix, singleFieldJSON, sumTypeJSON)
+
+data RcvGroupEvent
+  = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting
+  | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
+  | RGEMemberLeft -- CRLeftMember
+  | RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
+  | RGEUserRole {role :: GroupMemberRole}
+  | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
+  | RGEUserDeleted -- CRDeletedMemberUser
+  | RGEGroupDeleted -- CRGroupDeleted
+  | RGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
+  -- RGEInvitedViaGroupLink chat items are not received - they're created when sending group invitations,
+  -- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message")
+  -- and be created as unread without adding / working around new status for sent items
+  | RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink
+  | RGEMemberCreatedContact -- CRNewMemberContactReceivedInv
+  deriving (Show)
+
+data SndGroupEvent
+  = SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
+  | SGEUserRole {role :: GroupMemberRole}
+  | SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
+  | SGEUserLeft -- CRLeftMemberUser
+  | SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
+  deriving (Show)
+
+data RcvConnEvent
+  = RCESwitchQueue {phase :: SwitchPhase}
+  | RCERatchetSync {syncStatus :: RatchetSyncState}
+  | RCEVerificationCodeReset
+  deriving (Show)
+
+data SndConnEvent
+  = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef}
+  | SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef}
+  deriving (Show)
+
+data RcvDirectEvent =
+  -- RDEProfileChanged {...}
+  RDEContactDeleted
+  deriving (Show)
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RGE") ''RcvGroupEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBRcvGroupEvent = RGE RcvGroupEvent
+
+instance FromJSON DBRcvGroupEvent where
+  parseJSON v = RGE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "RGE") ''RcvGroupEvent) v
+
+instance ToJSON DBRcvGroupEvent where
+  toJSON (RGE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "RGE") ''RcvGroupEvent) v
+  toEncoding (RGE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "RGE") ''RcvGroupEvent) v
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "SGE") ''SndGroupEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBSndGroupEvent = SGE SndGroupEvent
+
+instance FromJSON DBSndGroupEvent where
+  parseJSON v = SGE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "SGE") ''SndGroupEvent) v
+
+instance ToJSON DBSndGroupEvent where
+  toJSON (SGE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "SGE") ''SndGroupEvent) v
+  toEncoding (SGE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "SGE") ''SndGroupEvent) v
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RcvConnEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBRcvConnEvent = RCE RcvConnEvent
+
+instance FromJSON DBRcvConnEvent where
+  parseJSON v = RCE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "RCE") ''RcvConnEvent) v
+
+instance ToJSON DBRcvConnEvent where
+  toJSON (RCE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "RCE") ''RcvConnEvent) v
+  toEncoding (RCE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "RCE") ''RcvConnEvent) v
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "SCE") ''SndConnEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBSndConnEvent = SCE SndConnEvent
+
+instance FromJSON DBSndConnEvent where
+  parseJSON v = SCE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "SCE") ''SndConnEvent) v
+
+instance ToJSON DBSndConnEvent where
+  toJSON (SCE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "SCE") ''SndConnEvent) v
+  toEncoding (SCE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "SCE") ''SndConnEvent) v
+
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RDE") ''RcvDirectEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBRcvDirectEvent = RDE RcvDirectEvent
+
+instance FromJSON DBRcvDirectEvent where
+  parseJSON v = RDE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "RDE") ''RcvDirectEvent) v
+
+instance ToJSON DBRcvDirectEvent where
+  toJSON (RDE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "RDE") ''RcvDirectEvent) v
+  toEncoding (RDE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "RDE") ''RcvDirectEvent) v

src/Simplex/Chat/Mobile.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fobject-code #-}
@@ -13,8 +13,8 @@ import Control.Concurrent.STM
 import Control.Exception (catch, SomeException)
 import Control.Monad.Except
 import Control.Monad.Reader
-import Data.Aeson (ToJSON (..))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
@@ -32,7 +32,6 @@ import Foreign.Ptr
 import Foreign.StablePtr
 import Foreign.Storable (poke)
 import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding)
-import GHC.Generics (Generic)
 import Simplex.Chat
 import Simplex.Chat.Controller
 import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList)
@@ -50,12 +49,26 @@ import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), Migrati
 import Simplex.Messaging.Client (defaultNetworkConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), BasicAuth (..), CorrId (..), ProtoServerWithAuth (..), ProtocolServer (..))
 import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
 import System.IO (utf8)
 import System.Timeout (timeout)
 
+data DBMigrationResult
+  = DBMOk
+  | DBMInvalidConfirmation
+  | DBMErrorNotADatabase {dbFile :: String}
+  | DBMErrorMigration {dbFile :: String, migrationError :: MigrationError}
+  | DBMErrorSQL {dbFile :: String, migrationSQLError :: String}
+  deriving (Show)
+
+$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "DBM") ''DBMigrationResult)
+
+data APIResponse = APIResponse {corr :: Maybe CorrId, remoteHostId :: Maybe RemoteHostId, resp :: ChatResponse}
+
+$(JQ.deriveToJSON defaultJSON ''APIResponse)
+
 foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
 
 foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString
@@ -189,18 +202,6 @@ defaultMobileConfig =
 getActiveUser_ :: SQLiteStore -> IO (Maybe User)
 getActiveUser_ st = find activeUser <$> withTransaction st getUsers
 
-data DBMigrationResult
-  = DBMOk
-  | DBMInvalidConfirmation
-  | DBMErrorNotADatabase {dbFile :: String}
-  | DBMErrorMigration {dbFile :: String, migrationError :: MigrationError}
-  | DBMErrorSQL {dbFile :: String, migrationSQLError :: String}
-  deriving (Show, Generic)
-
-instance ToJSON DBMigrationResult where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DBM"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DBM"
-
 chatMigrateInit :: String -> String -> String -> IO (Either DBMigrationResult ChatController)
 chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
   confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
@@ -264,10 +265,3 @@ chatPasswordHash pwd salt = either (const "") passwordHash salt'
   where
     salt' = U.decode salt
     passwordHash = U.encode . C.sha512Hash . (pwd <>)
-
-data APIResponse = APIResponse {corr :: Maybe CorrId, remoteHostId :: Maybe RemoteHostId, resp :: ChatResponse}
-  deriving (Generic)
-
-instance ToJSON APIResponse where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}

src/Simplex/Chat/Mobile/File.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
 module Simplex.Chat.Mobile.File
@@ -19,8 +19,8 @@ where
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
@@ -32,7 +32,6 @@ import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
 import Foreign.Ptr
 import Foreign.Storable (poke, pokeByteOff)
-import GHC.Generics (Generic)
 import Simplex.Chat.Mobile.Shared
 import Simplex.Chat.Util (chunkSize, encryptFile)
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..))
@@ -45,9 +44,8 @@ import UnliftIO (Handle, IOMode (..), withFile)
 data WriteFileResult
   = WFResult {cryptoArgs :: CryptoFileArgs}
   | WFError {writeError :: String}
-  deriving (Generic)
 
-instance ToJSON WriteFileResult where toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "WF"
+$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "WF") ''WriteFileResult)
 
 cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString
 cChatWriteFile cPath ptr len = do
@@ -66,9 +64,6 @@ chatWriteFile path s = do
 data ReadFileResult
   = RFResult {fileSize :: Int}
   | RFError {readError :: String}
-  deriving (Generic)
-
-instance ToJSON ReadFileResult where toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RF"
 
 cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8)
 cChatReadFile cPath cKey cNonce = do
@@ -141,3 +136,5 @@ chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runCatchExcept
 
 runCatchExceptT :: ExceptT String IO a -> IO (Either String a)
 runCatchExceptT action = runExceptT action `catchAll` (pure . Left . show)
+
+$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "RF") ''ReadFileResult)

src/Simplex/Chat/Protocol.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -11,6 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -23,6 +23,7 @@ import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.KeyMap as JM
+import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
@@ -40,13 +41,12 @@ import Data.Typeable (Typeable)
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Call
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version hiding (version)
 
@@ -70,14 +70,9 @@ data ConnectionEntity
   | SndFileConnection {entityConnection :: Connection, sndFileTransfer :: SndFileTransfer}
   | RcvFileConnection {entityConnection :: Connection, rcvFileTransfer :: RcvFileTransfer}
   | UserContactConnection {entityConnection :: Connection, userContact :: UserContact}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
-instance FromJSON ConnectionEntity where
+$(JQ.deriveJSON (sumTypeJSON fstToLower) ''ConnectionEntity)
-  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
-
-instance ToJSON ConnectionEntity where
-  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
-  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
 
 updateEntityConnStatus :: ConnectionEntity -> ConnStatus -> ConnectionEntity
 updateEntityConnStatus connEntity connStatus = case connEntity of
@@ -104,8 +99,6 @@ instance MsgEncodingI 'Binary where encoding = SBinary
 
 instance MsgEncodingI 'Json where encoding = SJson
 
-data ACMEventTag = forall e. MsgEncodingI e => ACMEventTag (SMsgEncoding e) (CMEventTag e)
-
 instance TestEquality SMsgEncoding where
   testEquality SBinary SBinary = Just Refl
   testEquality SJson SJson = Just Refl
@@ -127,7 +120,6 @@ data AppMessageJson = AppMessageJson
     event :: Text,
     params :: J.Object
   }
-  deriving (Generic, FromJSON)
 
 data AppMessageBinary = AppMessageBinary
   { msgId :: Maybe SharedMsgId,
@@ -135,10 +127,6 @@ data AppMessageBinary = AppMessageBinary
     body :: ByteString
   }
 
-instance ToJSON AppMessageJson where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-
 instance StrEncoding AppMessageBinary where
   strEncode AppMessageBinary {tag, msgId, body} = smpEncode (tag, msgId', Tail body)
     where
@@ -167,20 +155,42 @@ instance ToJSON SharedMsgId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
+$(JQ.deriveJSON defaultJSON ''AppMessageJson)
+
 data MsgRef = MsgRef
   { msgId :: Maybe SharedMsgId,
     sentAt :: UTCTime,
     sent :: Bool,
     memberId :: Maybe MemberId -- must be present in all group message references, both referencing sent and received
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
-instance FromJSON MsgRef where
+$(JQ.deriveJSON defaultJSON ''MsgRef)
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
 
-instance ToJSON MsgRef where
+data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknown {tag :: Text, json :: J.Object}
+  deriving (Eq, Show)
+
+$(pure [])
+
+instance FromJSON LinkContent where
+  parseJSON v@(J.Object j) =
+    $(JQ.mkParseJSON (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) v
+      <|> LCUnknown <$> j .: "type" <*> pure j
+  parseJSON invalid =
+    JT.prependFailure "bad LinkContent, " (JT.typeMismatch "Object" invalid)
+
+instance ToJSON LinkContent where
+  toJSON = \case
+    LCUnknown _ j -> J.Object j
+    v -> $(JQ.mkToJSON (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) v
+  toEncoding = \case
+    LCUnknown _ j -> JE.value $ J.Object j
+    v -> $(JQ.mkToEncoding (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) v
+
+$(JQ.deriveJSON defaultJSON ''LinkPreview)
 
 data ChatMessage e = ChatMessage
   { chatVRange :: VersionRange,
@@ -191,19 +201,6 @@ data ChatMessage e = ChatMessage
 
 data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e)
 
-instance MsgEncodingI e => StrEncoding (ChatMessage e) where
-  strEncode msg = case chatToAppMessage msg of
-    AMJson m -> LB.toStrict $ J.encode m
-    AMBinary m -> strEncode m
-  strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
-
-instance StrEncoding AChatMessage where
-  strEncode (ACMsg _ m) = strEncode m
-  strP =
-    A.peekChar' >>= \case
-      '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
-      _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
-
 data ChatMsgEvent (e :: MsgEncoding) where
   XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
   XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
@@ -329,11 +326,7 @@ instance Encoding InlineFileChunk where
         pure FileChunk {chunkNo = fromIntegral $ c2w c, chunkBytes}
 
 data QuotedMsg = QuotedMsg {msgRef :: MsgRef, content :: MsgContent}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON QuotedMsg where
-  toEncoding = J.genericToEncoding J.defaultOptions
-  toJSON = J.genericToJSON J.defaultOptions
 
 cmToQuotedMsg :: AChatMsgEvent -> Maybe QuotedMsg
 cmToQuotedMsg = \case
@@ -386,34 +379,6 @@ isQuote = \case
   MCQuote {} -> True
   _ -> False
 
-data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent}
-  deriving (Eq, Show, Generic)
-
-data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknown {tag :: Text, json :: J.Object}
-  deriving (Eq, Show, Generic)
-
-instance FromJSON LinkPreview where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance ToJSON LinkPreview where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance FromJSON LinkContent where
-  parseJSON v@(J.Object j) =
-    J.genericParseJSON (taggedObjectJSON $ dropPrefix "LC") v
-      <|> LCUnknown <$> j .: "type" <*> pure j
-  parseJSON invalid =
-    JT.prependFailure "bad LinkContent, " (JT.typeMismatch "Object" invalid)
-
-instance ToJSON LinkContent where
-  toJSON = \case
-    LCUnknown _ j -> J.Object j
-    v -> J.genericToJSON (taggedObjectJSON $ dropPrefix "LC") v
-  toEncoding = \case
-    LCUnknown _ j -> JE.value $ J.Object j
-    v -> J.genericToEncoding (taggedObjectJSON $ dropPrefix "LC") v
-
 data MsgContent
   = MCText Text
   | MCLink {text :: Text, preview :: LinkPreview}
@@ -466,6 +431,21 @@ msgContentTag = \case
 data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool}
   deriving (Eq, Show)
 
+$(JQ.deriveJSON defaultJSON ''QuotedMsg)
+
+instance MsgEncodingI e => StrEncoding (ChatMessage e) where
+  strEncode msg = case chatToAppMessage msg of
+    AMJson m -> LB.toStrict $ J.encode m
+    AMBinary m -> strEncode m
+  strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
+
+instance StrEncoding AChatMessage where
+  strEncode (ACMsg _ m) = strEncode m
+  strP =
+    A.peekChar' >>= \case
+      '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
+      _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
+
 parseMsgContainer :: J.Object -> JT.Parser MsgContainer
 parseMsgContainer v =
   MCQuote <$> v .: "quote" <*> mc
@@ -545,6 +525,8 @@ instance ToField MsgContent where
 instance FromField MsgContent where
   fromField = fromTextField_ decodeJSON
 
+data ACMEventTag = forall e. MsgEncodingI e => ACMEventTag (SMsgEncoding e) (CMEventTag e)
+
 data CMEventTag (e :: MsgEncoding) where
   XMsgNew_ :: CMEventTag 'Json
   XMsgFileDescr_ :: CMEventTag 'Json

src/Simplex/Chat/Remote/Protocol.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}

src/Simplex/Chat/Remote/Types.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -12,7 +11,7 @@ import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import UnliftIO
 
 data RemoteHostClient = RemoteHostClient
@@ -116,10 +115,10 @@ $(J.deriveJSON (sumTypeJSON $ dropPrefix "RPE") ''RemoteProtocolError)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "PE") ''PlatformEncoding)
 
-$(J.deriveJSON J.defaultOptions ''RemoteCtrlOOB)
+$(J.deriveJSON defaultJSON ''RemoteCtrlOOB)
 
-$(J.deriveJSON J.defaultOptions ''RemoteHostInfo)
+$(J.deriveJSON defaultJSON ''RemoteHostInfo)
 
-$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrl)
+$(J.deriveJSON defaultJSON ''RemoteCtrl)
 
-$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrlInfo)
+$(J.deriveJSON defaultJSON ''RemoteCtrlInfo)

src/Simplex/Chat/Store/Profiles.hs

@@ -1,10 +1,10 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -61,8 +61,7 @@ where
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson.TH as J
-import qualified Data.Aeson as J
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.List.NonEmpty as L
@@ -73,7 +72,6 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
-import GHC.Generics (Generic)
 import Simplex.Chat.Call
 import Simplex.Chat.Messages
 import Simplex.Chat.Protocol
@@ -86,6 +84,7 @@ import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (safeDecodeUtf8)
@@ -400,17 +399,17 @@ data UserContactLink = UserContactLink
   { connReqContact :: ConnReqContact,
     autoAccept :: Maybe AutoAccept
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON UserContactLink where toEncoding = J.genericToEncoding J.defaultOptions
 
 data AutoAccept = AutoAccept
   { acceptIncognito :: IncognitoEnabled,
     autoReply :: Maybe MsgContent
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
-instance ToJSON AutoAccept where toEncoding = J.genericToEncoding J.defaultOptions
+$(J.deriveJSON defaultJSON ''AutoAccept)
+
+$(J.deriveJSON defaultJSON ''UserContactLink)
 
 toUserContactLink :: (ConnReqContact, Bool, IncognitoEnabled, Maybe MsgContent) -> UserContactLink
 toUserContactLink (connReq, autoAccept, acceptIncognito, autoReply) =

src/Simplex/Chat/Store/Shared.hs

@@ -1,11 +1,11 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Simplex.Chat.Store.Shared where
@@ -16,8 +16,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG, randomBytesGenerate)
-import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson.TH as J
-import qualified Data.Aeson as J
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
@@ -28,7 +27,6 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Database.SQLite.Simple (NamedParam (..), Only (..), Query, SQLError, (:.) (..))
 import qualified Database.SQLite.Simple as SQL
 import Database.SQLite.Simple.QQ (sql)
-import GHC.Generics (Generic)
 import Simplex.Chat.Messages
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.Types
@@ -103,14 +101,9 @@ data StoreError
   | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
   | SERemoteHostNotFound {remoteHostId :: RemoteHostId}
   | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
 
-instance FromJSON StoreError where
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SE"
-
-instance ToJSON StoreError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SE"
 
 insertedRowId :: DB.Connection -> IO Int64
 insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"

src/Simplex/Chat/Types.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -45,14 +44,13 @@ import Database.SQLite.Simple.FromField (returnError, FromField(..))
 import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Util
 import Simplex.FileTransfer.Description (FileDigest)
 import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId)
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON, enumJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON, enumJSON)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
 import Simplex.Messaging.Util ((<$?>))
 import Simplex.Messaging.Version
@@ -264,9 +262,7 @@ data UserContact = UserContact
     connReqContact :: ConnReqContact,
     groupId :: Maybe GroupId
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON UserContact where toEncoding = J.genericToEncoding J.defaultOptions
 
 userContactGroupId :: UserContact -> Maybe GroupId
 userContactGroupId UserContact {groupId} = groupId
@@ -284,10 +280,7 @@ data UserContactRequest = UserContactRequest
     updatedAt :: UTCTime,
     xContactId :: Maybe XContactId
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON UserContactRequest where
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 newtype XContactId = XContactId ByteString
   deriving (Eq, Show)
@@ -341,9 +334,7 @@ optionalFullName displayName fullName
   | otherwise = " (" <> fullName <> ")"
 
 data Group = Group {groupInfo :: GroupInfo, members :: [GroupMember]}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON Group where toEncoding = J.genericToEncoding J.defaultOptions
 
 type GroupId = Int64
 
@@ -359,9 +350,7 @@ data GroupInfo = GroupInfo
     updatedAt :: UTCTime,
     chatTs :: Maybe UTCTime
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 groupName' :: GroupInfo -> GroupName
 groupName' GroupInfo {localDisplayName = g} = g
@@ -369,9 +358,7 @@ groupName' GroupInfo {localDisplayName = g} = g
 data GroupSummary = GroupSummary
   { currentMembers :: Int
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON GroupSummary where toEncoding = J.genericToEncoding J.defaultOptions
 
 data ContactOrGroup = CGContact Contact | CGGroup Group
 
@@ -386,9 +373,7 @@ data ChatSettings = ChatSettings
     sendRcpts :: Maybe Bool,
     favorite :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON ChatSettings where toEncoding = J.genericToEncoding J.defaultOptions
 
 defaultChatSettings :: ChatSettings
 defaultChatSettings =
@@ -402,18 +387,7 @@ chatHasNtfs :: ChatSettings -> Bool
 chatHasNtfs ChatSettings {enableNtfs} = enableNtfs /= MFNone
 
 data MsgFilter = MFNone | MFAll | MFMentions
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance FromJSON MsgFilter where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MF"
-
-instance ToJSON MsgFilter where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "MF"
-
-instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP
-
-instance ToField MsgFilter where toField = toField . msgFilterInt
 
 msgFilterInt :: MsgFilter -> Int
 msgFilterInt = \case
@@ -496,11 +470,7 @@ data Profile = Profile
     -- - incognito
     -- - local_alias
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON Profile where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 -- check if profiles match ignoring preferences
 profilesMatch :: LocalProfile -> LocalProfile -> Bool
@@ -522,11 +492,7 @@ data LocalProfile = LocalProfile
     preferences :: Maybe Preferences,
     localAlias :: LocalAlias
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON LocalProfile where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 localProfileId :: LocalProfile -> ProfileId
 localProfileId LocalProfile{profileId} = profileId
@@ -546,11 +512,7 @@ data GroupProfile = GroupProfile
     image :: Maybe ImageData,
     groupPreferences :: Maybe GroupPreferences
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupProfile where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 newtype ImageData = ImageData Text
   deriving (Eq, Show)
@@ -567,14 +529,6 @@ instance ToField ImageData where toField (ImageData t) = toField t
 instance FromField ImageData where fromField = fmap ImageData . fromField
 
 data CReqClientData = CRDataGroup {groupLinkId :: GroupLinkId}
-  deriving (Generic)
-
-instance ToJSON CReqClientData where
-  toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "CRData"
-  toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "CRData"
-
-instance FromJSON CReqClientData where
-  parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "CRData"
 
 newtype GroupLinkId = GroupLinkId {unGroupLinkId :: ByteString} -- used to identify invitation via group link
   deriving (Eq, Show)
@@ -602,29 +556,19 @@ data GroupInvitation = GroupInvitation
     groupProfile :: GroupProfile,
     groupLinkId :: Maybe GroupLinkId
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data MemberIdRole = MemberIdRole
   { memberId :: MemberId,
     memberRole :: GroupMemberRole
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON MemberIdRole where toEncoding = J.genericToEncoding J.defaultOptions
 
 data IntroInvitation = IntroInvitation
   { groupConnReq :: ConnReqInvitation,
     directConnReq :: Maybe ConnReqInvitation
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON IntroInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data MemberInfo = MemberInfo
   { memberId :: MemberId,
@@ -632,11 +576,7 @@ data MemberInfo = MemberInfo
     v :: Maybe ChatVersionRange,
     profile :: Profile
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON MemberInfo where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 memberInfo :: GroupMember -> MemberInfo
 memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} =
@@ -675,16 +615,10 @@ data GroupMember = GroupMember
     memberContactProfileId :: ProfileId,
     activeConn :: Maybe Connection
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupMember where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data GroupMemberRef = GroupMemberRef {groupMemberId :: Int64, profile :: Profile}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupMemberRef where toEncoding = J.genericToEncoding J.defaultOptions
 
 groupMemberRef :: GroupMember -> GroupMemberRef
 groupMemberRef GroupMember {groupMemberId, memberProfile = p} =
@@ -744,14 +678,7 @@ instance ToJSON MemberId where
   toEncoding = strToJEncoding
 
 data InvitedBy = IBContact {byContactId :: Int64} | IBUser | IBUnknown
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance FromJSON InvitedBy where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "IB"
-
-instance ToJSON InvitedBy where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "IB"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "IB"
 
 toInvitedBy :: Int64 -> Maybe Int64 -> InvitedBy
 toInvitedBy userCtId (Just ctId)
@@ -803,9 +730,7 @@ instance ToJSON GroupMemberRole where
 data GroupMemberSettings = GroupMemberSettings
   { showMessages :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupMemberSettings where toEncoding = J.genericToEncoding J.defaultOptions
 
 defaultMemberSettings :: GroupMemberSettings
 defaultMemberSettings = GroupMemberSettings {showMessages = True}
@@ -986,9 +911,7 @@ data SndFileTransfer = SndFileTransfer
     fileDescrId :: Maybe Int64,
     fileInline :: Maybe InlineFileMode
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON SndFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
 
 sndFileTransferConnId :: SndFileTransfer -> ConnId
 sndFileTransferConnId SndFileTransfer {agentConnId = AgentConnId acId} = acId
@@ -1003,24 +926,10 @@ data FileInvitation = FileInvitation
     fileInline :: Maybe InlineFileMode,
     fileDescr :: Maybe FileDescr
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance ToJSON FileInvitation where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance FromJSON FileInvitation where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
 
 data FileDescr = FileDescr {fileDescrText :: Text, fileDescrPartNo :: Int, fileDescrComplete :: Bool}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance ToJSON FileDescr where
-  toEncoding = J.genericToEncoding J.defaultOptions
-  toJSON = J.genericToJSON J.defaultOptions
-
-instance FromJSON FileDescr where
-  parseJSON = J.genericParseJSON J.defaultOptions
 
 xftpFileInvitation :: FilePath -> Integer -> FileDescr -> FileInvitation
 xftpFileInvitation fileName fileSize fileDescr =
@@ -1036,7 +945,7 @@ xftpFileInvitation fileName fileSize fileDescr =
 data InlineFileMode
   = IFMOffer -- file will be sent inline once accepted
   | IFMSent -- file is sent inline without acceptance
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance TextEncoding InlineFileMode where
   textEncode = \case
@@ -1072,18 +981,14 @@ data RcvFileTransfer = RcvFileTransfer
     -- SMP files are encrypted after all chunks are received
     cryptoArgs :: Maybe CryptoFileArgs
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
 
 data XFTPRcvFile = XFTPRcvFile
   { rcvFileDescription :: RcvFileDescr,
     agentRcvFileId :: Maybe AgentRcvFileId,
     agentRcvFileDeleted :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON XFTPRcvFile where toEncoding = J.genericToEncoding J.defaultOptions
 
 data RcvFileDescr = RcvFileDescr
   { fileDescrId :: Int64,
@@ -1091,9 +996,7 @@ data RcvFileDescr = RcvFileDescr
     fileDescrPartNo :: Int,
     fileDescrComplete :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON RcvFileDescr where toEncoding = J.genericToEncoding J.defaultOptions
 
 data RcvFileStatus
   = RFSNew
@@ -1101,14 +1004,7 @@ data RcvFileStatus
   | RFSConnected RcvFileInfo
   | RFSComplete RcvFileInfo
   | RFSCancelled (Maybe RcvFileInfo)
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance FromJSON RcvFileStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RFS"
-
-instance ToJSON RcvFileStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RFS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RFS"
 
 rcvFileComplete :: RcvFileStatus -> Bool
 rcvFileComplete = \case
@@ -1123,9 +1019,7 @@ data RcvFileInfo = RcvFileInfo
     connId :: Maybe Int64,
     agentConnId :: Maybe AgentConnId
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON RcvFileInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 liveRcvFileTransferInfo :: RcvFileTransfer -> Maybe RcvFileInfo
 liveRcvFileTransferInfo RcvFileTransfer {fileStatus} = case fileStatus of
@@ -1226,14 +1120,7 @@ data FileTransfer
         sndFileTransfers :: [SndFileTransfer]
       }
   | FTRcv {rcvFileTransfer :: RcvFileTransfer}
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance FromJSON FileTransfer where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "FT"
-
-instance ToJSON FileTransfer where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "FT"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "FT"
 
 data FileTransferMeta = FileTransferMeta
   { fileId :: FileTransferId,
@@ -1245,9 +1132,7 @@ data FileTransferMeta = FileTransferMeta
     chunkSize :: Integer,
     cancelled :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON FileTransferMeta where toEncoding = J.genericToEncoding J.defaultOptions
 
 data XFTPSndFile = XFTPSndFile
   { agentSndFileId :: AgentSndFileId,
@@ -1255,9 +1140,7 @@ data XFTPSndFile = XFTPSndFile
     agentSndFileDeleted :: Bool,
     cryptoArgs :: Maybe CryptoFileArgs
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON XFTPSndFile where toEncoding = J.genericToEncoding J.defaultOptions
 
 fileTransferCancelled :: FileTransfer -> Bool
 fileTransferCancelled (FTSnd FileTransferMeta {cancelled} _) = cancelled
@@ -1318,7 +1201,7 @@ data Connection = Connection
     authErrCounter :: Int,
     createdAt :: UTCTime
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 connReady :: Connection -> Bool
 connReady Connection {connStatus} = connStatus == ConnReady || connStatus == ConnSndReady
@@ -1330,9 +1213,7 @@ connDisabled :: Connection -> Bool
 connDisabled Connection {authErrCounter} = authErrCounter >= authErrDisableCount
 
 data SecurityCode = SecurityCode {securityCode :: Text, verifiedAt :: UTCTime}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON SecurityCode where toEncoding = J.genericToEncoding J.defaultOptions
 
 verificationCode :: ByteString -> Text
 verificationCode = T.pack . unwords . chunks 5 . show . os2ip
@@ -1351,13 +1232,6 @@ aConnId Connection {agentConnId = AgentConnId cId} = cId
 connIncognito :: Connection -> Bool
 connIncognito Connection {customUserProfileId} = isJust customUserProfileId
 
-instance FromJSON Connection where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance ToJSON Connection where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
 data PendingContactConnection = PendingContactConnection
   { pccConnId :: Int64,
     pccAgentConnId :: AgentConnId,
@@ -1371,13 +1245,11 @@ data PendingContactConnection = PendingContactConnection
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 aConnId' :: PendingContactConnection -> ConnId
 aConnId' PendingContactConnection {pccAgentConnId = AgentConnId cId} = cId
 
-instance ToJSON PendingContactConnection where toEncoding = J.genericToEncoding J.defaultOptions
-
 data ConnStatus
   = -- | connection is created by initiating party with agent NEW command (createConnection)
     ConnNew
@@ -1512,7 +1384,7 @@ data NetworkStatus
   | NSConnected
   | NSDisconnected
   | NSError {connectionError :: String}
-  deriving (Eq, Ord, Show, Generic)
+  deriving (Eq, Ord, Show)
 
 netStatusStr :: NetworkStatus -> String
 netStatusStr = \case
@@ -1521,20 +1393,11 @@ netStatusStr = \case
   NSDisconnected -> "disconnected"
   NSError e -> "error: " <> e
 
-instance FromJSON NetworkStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "NS"
-
-instance ToJSON NetworkStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "NS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "NS"
-
 data ConnNetworkStatus = ConnNetworkStatus
   { agentConnId :: AgentConnId,
     networkStatus :: NetworkStatus
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
-
-instance ToJSON ConnNetworkStatus where toEncoding = J.genericToEncoding J.defaultOptions
 
 type CommandId = Int64
 
@@ -1548,7 +1411,7 @@ data CommandStatus
   = CSCreated
   | CSCompleted -- unused - was replaced with deleteCommand
   | CSError -- internal command error, e.g. not matching connection id or unexpected response, not related to agent message ERR
-  deriving (Show, Generic)
+  deriving (Show)
 
 instance FromField CommandStatus where fromField = fromTextField_ textDecode
 
@@ -1575,7 +1438,7 @@ data CommandFunction
   | CFAcceptContact
   | CFAckMessage
   | CFDeleteConn -- not used
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance FromField CommandFunction where fromField = fromTextField_ textDecode
 
@@ -1641,14 +1504,7 @@ data ServerCfg p = ServerCfg
     tested :: Maybe Bool,
     enabled :: Bool
   }
-  deriving (Show, Generic)
+  deriving (Show)
-
-instance ProtocolTypeI p => ToJSON (ServerCfg p) where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance ProtocolTypeI p => FromJSON (ServerCfg p) where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
 
 newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRange} deriving (Eq, Show)
 
@@ -1674,14 +1530,95 @@ instance ToJSON JVersionRange where
   toJSON (JVersionRange (VersionRange minV maxV)) = J.object ["minVersion" .= minV, "maxVersion" .= maxV]
   toEncoding (JVersionRange (VersionRange minV maxV)) = J.pairs $ "minVersion" .= minV <> "maxVersion" .= maxV
 
-$(JQ.deriveJSON defOpts ''UserPwdHash)
+$(JQ.deriveJSON defaultJSON ''UserContact)
 
-$(JQ.deriveJSON defOpts ''User)
+$(JQ.deriveJSON defaultJSON ''Profile)
 
-$(JQ.deriveJSON defOpts ''NewUser)
+$(JQ.deriveJSON defaultJSON ''LocalProfile)
 
-$(JQ.deriveJSON defOpts ''UserInfo)
+$(JQ.deriveJSON defaultJSON ''UserContactRequest)
 
-$(JQ.deriveJSON defOpts ''Contact)
+$(JQ.deriveJSON defaultJSON ''GroupProfile)
 
-$(JQ.deriveJSON defOpts ''ContactRef)
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "IB") ''InvitedBy)
+
+$(JQ.deriveJSON defaultJSON ''GroupMemberSettings)
+
+$(JQ.deriveJSON defaultJSON ''SecurityCode)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "NS") ''NetworkStatus)
+
+$(JQ.deriveJSON defaultJSON ''ConnNetworkStatus)
+
+$(JQ.deriveJSON defaultJSON ''Connection)
+
+$(JQ.deriveJSON defaultJSON ''PendingContactConnection)
+
+$(JQ.deriveJSON defaultJSON ''GroupMember)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "MF") ''MsgFilter)
+
+$(JQ.deriveJSON defaultJSON ''ChatSettings)
+
+$(JQ.deriveJSON defaultJSON ''GroupInfo)
+
+$(JQ.deriveJSON defaultJSON ''Group)
+
+$(JQ.deriveJSON defaultJSON ''GroupSummary)
+
+instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP
+
+instance ToField MsgFilter where toField = toField . msgFilterInt
+
+$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "CRData") ''CReqClientData)
+
+$(JQ.deriveJSON defaultJSON ''MemberIdRole)
+
+$(JQ.deriveJSON defaultJSON ''GroupInvitation)
+
+$(JQ.deriveJSON defaultJSON ''IntroInvitation)
+
+$(JQ.deriveJSON defaultJSON ''MemberInfo)
+
+$(JQ.deriveJSON defaultJSON ''GroupMemberRef)
+
+$(JQ.deriveJSON defaultJSON ''FileDescr)
+
+$(JQ.deriveJSON defaultJSON ''FileInvitation)
+
+$(JQ.deriveJSON defaultJSON ''SndFileTransfer)
+
+$(JQ.deriveJSON defaultJSON ''RcvFileDescr)
+
+$(JQ.deriveJSON defaultJSON ''XFTPRcvFile)
+
+$(JQ.deriveJSON defaultJSON ''RcvFileInfo)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RFS") ''RcvFileStatus)
+
+$(JQ.deriveJSON defaultJSON ''RcvFileTransfer)
+
+$(JQ.deriveJSON defaultJSON ''XFTPSndFile)
+
+$(JQ.deriveJSON defaultJSON ''FileTransferMeta)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FT") ''FileTransfer)
+
+$(JQ.deriveJSON defaultJSON ''UserPwdHash)
+
+$(JQ.deriveJSON defaultJSON ''User)
+
+$(JQ.deriveJSON defaultJSON ''NewUser)
+
+$(JQ.deriveJSON defaultJSON ''UserInfo)
+
+$(JQ.deriveJSON defaultJSON ''Contact)
+
+$(JQ.deriveJSON defaultJSON ''ContactRef)
+
+instance ProtocolTypeI p => ToJSON (ServerCfg p) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
+  toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)
+
+instance ProtocolTypeI p => FromJSON (ServerCfg p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ServerCfg)

src/Simplex/Chat/Types/Preferences.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -12,6 +11,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 
@@ -24,7 +24,7 @@ module Simplex.Chat.Types.Preferences where
 
 import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.Maybe (fromMaybe, isJust)
@@ -32,11 +32,10 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import GHC.Records.Compat
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
 import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
 
 data ChatFeature
@@ -45,7 +44,7 @@ data ChatFeature
   | CFReactions
   | CFVoice
   | CFCalls
-  deriving (Show, Generic)
+  deriving (Show)
 
 data SChatFeature (f :: ChatFeature) where
   SCFTimedMessages :: SChatFeature 'CFTimedMessages
@@ -71,13 +70,6 @@ chatFeatureNameText = \case
 chatFeatureNameText' :: SChatFeature f -> Text
 chatFeatureNameText' = chatFeatureNameText . chatFeature
 
-instance ToJSON ChatFeature where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CF"
-
-instance FromJSON ChatFeature where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CF"
-
 allChatFeatures :: [AChatFeature]
 allChatFeatures =
   [ ACF SCFTimedMessages,
@@ -149,17 +141,7 @@ data Preferences = Preferences
     voice :: Maybe VoicePreference,
     calls :: Maybe CallsPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON Preferences where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance ToField Preferences where
-  toField = toField . encodeJSON
-
-instance FromField Preferences where
-  fromField = fromTextField_ decodeJSON
 
 data GroupFeature
   = GFTimedMessages
@@ -168,7 +150,7 @@ data GroupFeature
   | GFReactions
   | GFVoice
   | GFFiles
-  deriving (Show, Generic)
+  deriving (Show)
 
 data SGroupFeature (f :: GroupFeature) where
   SGFTimedMessages :: SGroupFeature 'GFTimedMessages
@@ -200,13 +182,6 @@ groupFeatureAllowed' :: GroupFeatureI f => SGroupFeature f -> FullGroupPreferenc
 groupFeatureAllowed' feature prefs =
   getField @"enable" (getGroupPreference feature prefs) == FEOn
 
-instance ToJSON GroupFeature where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "GF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "GF"
-
-instance FromJSON GroupFeature where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "GF"
-
 allGroupFeatures :: [AGroupFeature]
 allGroupFeatures =
   [ AGF SGFTimedMessages,
@@ -263,17 +238,7 @@ data GroupPreferences = GroupPreferences
     voice :: Maybe VoiceGroupPreference,
     files :: Maybe FilesGroupPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupPreferences where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance ToField GroupPreferences where
-  toField = toField . encodeJSON
-
-instance FromField GroupPreferences where
-  fromField = fromTextField_ decodeJSON
 
 setGroupPreference :: forall f. GroupFeatureI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
 setGroupPreference f enable prefs_ = setGroupPreference_ f pref prefs
@@ -312,9 +277,7 @@ data FullPreferences = FullPreferences
     voice :: VoicePreference,
     calls :: CallsPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON FullPreferences where toEncoding = J.genericToEncoding J.defaultOptions
 
 -- full collection of group preferences defined in the app - it is used to ensure we include all preferences and to simplify processing
 -- if some of the preferences are not defined in GroupPreferences, defaults from defaultGroupPrefs are used here.
@@ -326,9 +289,7 @@ data FullGroupPreferences = FullGroupPreferences
     voice :: VoiceGroupPreference,
     files :: FilesGroupPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON FullGroupPreferences where toEncoding = J.genericToEncoding J.defaultOptions
 
 -- merged preferences of user for a given contact - they differentiate between specific preferences for the contact and global user preferences
 data ContactUserPreferences = ContactUserPreferences
@@ -338,30 +299,17 @@ data ContactUserPreferences = ContactUserPreferences
     voice :: ContactUserPreference VoicePreference,
     calls :: ContactUserPreference CallsPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data ContactUserPreference p = ContactUserPreference
   { enabled :: PrefEnabled,
     userPreference :: ContactUserPref p,
     contactPreference :: p
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 data ContactUserPref p = CUPContact {preference :: p} | CUPUser {preference :: p}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
-
-instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance FromJSON p => FromJSON (ContactUserPreference p) where parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ToJSON p => ToJSON (ContactUserPreference p) where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance FromJSON p => FromJSON (ContactUserPref p) where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CUP"
-
-instance ToJSON p => ToJSON (ContactUserPref p) where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CUP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP"
 
 toChatPrefs :: FullPreferences -> Preferences
 toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls} =
@@ -404,31 +352,19 @@ data TimedMessagesPreference = TimedMessagesPreference
   { allow :: FeatureAllowed,
     ttl :: Maybe Int
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON TimedMessagesPreference where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data FullDeletePreference = FullDeletePreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON FullDeletePreference where toEncoding = J.genericToEncoding J.defaultOptions
 
 data ReactionsPreference = ReactionsPreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON ReactionsPreference where toEncoding = J.genericToEncoding J.defaultOptions
 
 data VoicePreference = VoicePreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON VoicePreference where toEncoding = J.genericToEncoding J.defaultOptions
 
 data CallsPreference = CallsPreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON CallsPreference where toEncoding = J.genericToEncoding J.defaultOptions
 
 class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureAllowed) => FeatureI f where
   type FeaturePreference (f :: ChatFeature) = p | p -> f
@@ -477,47 +413,33 @@ instance FeatureI 'CFCalls where
 
 data GroupPreference = GroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data TimedMessagesGroupPreference = TimedMessagesGroupPreference
   { enable :: GroupFeatureEnabled,
     ttl :: Maybe Int
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data DirectMessagesGroupPreference = DirectMessagesGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data FullDeleteGroupPreference = FullDeleteGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data ReactionsGroupPreference = ReactionsGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data VoiceGroupPreference = VoiceGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data FilesGroupPreference = FilesGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON TimedMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON DirectMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON ReactionsGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON FullDeleteGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON VoiceGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON FilesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
 
 class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
   type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
@@ -619,7 +541,7 @@ data FeatureAllowed
   = FAAlways -- allow unconditionally
   | FAYes -- allow, if peer allows it
   | FANo -- do not allow
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance FromField FeatureAllowed where fromField = fromBlobField_ strDecode
 
@@ -645,7 +567,7 @@ instance ToJSON FeatureAllowed where
   toEncoding = strToJEncoding
 
 data GroupFeatureEnabled = FEOn | FEOff
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance FromField GroupFeatureEnabled where fromField = fromBlobField_ strDecode
 
@@ -718,11 +640,7 @@ toGroupPreferences groupPreferences =
     pref f = Just $ getGroupPreference f groupPreferences
 
 data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
-
-instance ToJSON PrefEnabled where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
 
 prefEnabled :: FeatureI f => Bool -> FeaturePreference f -> FeaturePreference f -> PrefEnabled
 prefEnabled asymmetric user contact = case (getField @"allow" user, getField @"allow" contact) of
@@ -784,3 +702,69 @@ getContactUserPreference f ps = case f of
   SCFReactions -> ps.reactions
   SCFVoice -> ps.voice
   SCFCalls -> ps.calls
+
+$(J.deriveJSON (enumJSON $ dropPrefix "CF") ''ChatFeature)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "GF") ''GroupFeature)
+
+$(J.deriveJSON defaultJSON ''TimedMessagesPreference)
+
+$(J.deriveJSON defaultJSON ''FullDeletePreference)
+
+$(J.deriveJSON defaultJSON ''ReactionsPreference)
+
+$(J.deriveJSON defaultJSON ''VoicePreference)
+
+$(J.deriveJSON defaultJSON ''CallsPreference)
+
+$(J.deriveJSON defaultJSON ''Preferences)
+
+instance ToField Preferences where
+  toField = toField . encodeJSON
+
+instance FromField Preferences where
+  fromField = fromTextField_ decodeJSON
+
+$(J.deriveJSON defaultJSON ''GroupPreference)
+
+$(J.deriveJSON defaultJSON ''TimedMessagesGroupPreference)
+
+$(J.deriveJSON defaultJSON ''DirectMessagesGroupPreference)
+
+$(J.deriveJSON defaultJSON ''ReactionsGroupPreference)
+
+$(J.deriveJSON defaultJSON ''FullDeleteGroupPreference)
+
+$(J.deriveJSON defaultJSON ''VoiceGroupPreference)
+
+$(J.deriveJSON defaultJSON ''FilesGroupPreference)
+
+$(J.deriveJSON defaultJSON ''GroupPreferences)
+
+instance ToField GroupPreferences where
+  toField = toField . encodeJSON
+
+instance FromField GroupPreferences where
+  fromField = fromTextField_ decodeJSON
+
+$(J.deriveJSON defaultJSON ''FullPreferences)
+
+$(J.deriveJSON defaultJSON ''FullGroupPreferences)
+
+$(J.deriveJSON defaultJSON ''PrefEnabled)
+
+instance FromJSON p => FromJSON (ContactUserPref p) where
+  parseJSON = $(J.mkParseJSON (sumTypeJSON $ dropPrefix "CUP") ''ContactUserPref)
+
+instance ToJSON p => ToJSON (ContactUserPref p) where
+  toJSON = $(J.mkToJSON (sumTypeJSON $ dropPrefix "CUP") ''ContactUserPref)
+  toEncoding = $(J.mkToEncoding (sumTypeJSON $ dropPrefix "CUP") ''ContactUserPref)
+
+instance FromJSON p => FromJSON (ContactUserPreference p) where
+  parseJSON = $(J.mkParseJSON defaultJSON ''ContactUserPreference)
+
+instance ToJSON p => ToJSON (ContactUserPreference p) where
+  toJSON = $(J.mkToJSON defaultJSON ''ContactUserPreference)
+  toEncoding = $(J.mkToEncoding defaultJSON ''ContactUserPreference)
+
+$(J.deriveJSON defaultJSON ''ContactUserPreferences)

src/Simplex/Chat/Types/Util.hs

@@ -28,6 +28,3 @@ fromBlobField_ p = \case
       Right k -> Ok k
       Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
-
-defOpts :: J.Options
-defOpts = J.defaultOptions {J.omitNothingFields = True}

src/Simplex/Chat/View.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -7,12 +6,13 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Simplex.Chat.View where
 
-import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace, toUpper)
@@ -31,7 +31,6 @@ import Data.Time (LocalTime (..), TimeOfDay (..), TimeZone (..), utcToLocalTime)
 import Data.Time.Calendar (addDays)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
-import GHC.Generics (Generic)
 import qualified Network.HTTP.Types as Q
 import Numeric (showFFloat)
 import Simplex.Chat (defaultChatConfig, maxImageSize)
@@ -66,6 +65,13 @@ import System.Console.ANSI.Types
 
 type CurrentTime = UTCTime
 
+data WCallCommand
+  = WCCallStart {media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
+  | WCCallOffer {offer :: Text, iceCandidates :: Text, media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
+  | WCCallAnswer {answer :: Text, iceCandidates :: Text}
+
+$(JQ.deriveToJSON (taggedObjectJSON $ dropPrefix "WCCall") ''WCallCommand)
+
 serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> String
 serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz remoteHost_
 
@@ -1633,16 +1639,6 @@ supporedBrowsers callType
   | encryptedCall callType = " (only Chrome and Safari support e2e encryption for WebRTC, Safari may require enabling WebRTC insertable streams)"
   | otherwise = ""
 
-data WCallCommand
-  = WCCallStart {media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
-  | WCCallOffer {offer :: Text, iceCandidates :: Text, media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
-  | WCCallAnswer {answer :: Text, iceCandidates :: Text}
-  deriving (Generic)
-
-instance ToJSON WCallCommand where
-  toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "WCCall"
-  toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "WCCall"
-
 viewVersionInfo :: ChatLogLevel -> CoreVersionInfo -> [StyledString]
 viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCommit} =
   map plain $

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: d920a2504b6d4653748da7d297cb13cd0a0f1f48
+    commit: 511d793b927b1e2f12999e0829718671b3a8f0cb
   - github: kazu-yamamoto/http2
     commit: 804fa283f067bd3fd89b8c5f8d25b3047813a517
   # - ../direct-sqlcipher

tests/MobileTests.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -9,8 +10,9 @@ module MobileTests where
 import ChatTests.Utils
 import Control.Monad.Except
 import Crypto.Random (getRandomBytes)
-import Data.Aeson (FromJSON (..))
+import Data.Aeson (FromJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BS
@@ -256,9 +258,11 @@ testMediaCApi _ = do
       (f cKeyStr ptr cLen >>= peekCAString) `shouldReturn` ""
       getByteString ptr cLen
 
-instance FromJSON WriteFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "WF"
+instance FromJSON WriteFileResult where
+  parseJSON = $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "WF") ''WriteFileResult)
 
-instance FromJSON ReadFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RF"
+instance FromJSON ReadFileResult where
+  parseJSON = $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "RF") ''ReadFileResult)
 
 testFileCApi :: FilePath -> FilePath -> IO ()
 testFileCApi fileName tmp = do