derive JSON instances with TH (#869)

* derive JSON instances with TH

* defaultJSON

* remove ToJSON

simplexmq.cabal

@@ -107,6 +107,7 @@ library
       Simplex.Messaging.Notifications.Server.Env
       Simplex.Messaging.Notifications.Server.Main
       Simplex.Messaging.Notifications.Server.Push.APNS
+      Simplex.Messaging.Notifications.Server.Push.APNS.Internal
       Simplex.Messaging.Notifications.Server.Stats
       Simplex.Messaging.Notifications.Server.Store
       Simplex.Messaging.Notifications.Server.StoreLog

src/Simplex/FileTransfer/Description.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -9,6 +8,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.FileTransfer.Description
@@ -37,7 +37,7 @@ where
 import Control.Applicative (optional)
 import Control.Monad ((<=<))
 import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
@@ -53,12 +53,11 @@ import Data.Word (Word32)
 import qualified Data.Yaml as Y
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Parsers (defaultJSON, parseAll)
 import Simplex.Messaging.Protocol (XFTPServer)
 import Simplex.Messaging.Util (bshow, groupAllOn, (<$?>))
 
@@ -149,21 +148,13 @@ data YAMLFileDescription = YAMLFileDescription
     chunkSize :: String,
     replicas :: [YAMLServerReplicas]
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON YAMLFileDescription where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data YAMLServerReplicas = YAMLServerReplicas
   { server :: XFTPServer,
     chunks :: [String]
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON YAMLServerReplicas where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data FileServerReplica = FileServerReplica
   { chunkNo :: Int,
@@ -175,6 +166,13 @@ data FileServerReplica = FileServerReplica
   }
   deriving (Show)
 
+newtype FileSize a = FileSize {unFileSize :: a}
+  deriving (Eq, Show)
+
+$(J.deriveJSON defaultJSON ''YAMLServerReplicas)
+
+$(J.deriveJSON defaultJSON ''YAMLFileDescription)
+
 instance FilePartyI p => StrEncoding (ValidFileDescription p) where
   strEncode (ValidFD fd) = strEncode fd
   strDecode s = strDecode s >>= (\(AVFD fd) -> checkParty fd)
@@ -216,9 +214,6 @@ encodeFileDescription FileDescription {party, size, digest, key, nonce, chunkSiz
       replicas = encodeFileReplicas chunkSize chunks
     }
 
-newtype FileSize a = FileSize {unFileSize :: a}
-  deriving (Eq, Show)
-
 instance (Integral a, Show a) => StrEncoding (FileSize a) where
   strEncode (FileSize b)
     | b' /= 0 = bshow b

src/Simplex/FileTransfer/Protocol.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -7,6 +6,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
@@ -14,8 +14,7 @@
 module Simplex.FileTransfer.Protocol 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 Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
@@ -25,7 +24,6 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isNothing)
 import Data.Type.Equality
 import Data.Word (Word32)
-import GHC.Generics (Generic)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -67,14 +65,7 @@ xftpBlockSize = 16384
 
 -- | File protocol clients
 data FileParty = FRecipient | FSender
-  deriving (Eq, Show, Generic)
-
-instance FromJSON FileParty where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "F"
-
-instance ToJSON FileParty where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "F"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "F"
+  deriving (Eq, Show)
 
 data SFileParty :: FileParty -> Type where
   SFRecipient :: SFileParty FRecipient
@@ -353,14 +344,7 @@ data XFTPErrorType
     INTERNAL
   | -- | used internally, never returned by the server (to be removed)
     DUPLICATE_ -- not part of SMP protocol, used internally
-  deriving (Eq, Generic, Read, Show)
-
-instance ToJSON XFTPErrorType where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON XFTPErrorType where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show)
 
 instance StrEncoding XFTPErrorType where
   strEncode = \case
@@ -431,3 +415,7 @@ xftpDecodeTransmission sessionId t = do
   case tParse True t' of
     t'' :| [] -> Right $ tDecodeParseValidate sessionId currentXFTPVersion t''
     _ -> Left BLOCK
+
+$(J.deriveJSON (enumJSON $ dropPrefix "F") ''FileParty)
+
+$(J.deriveJSON (sumTypeJSON id) ''XFTPErrorType)

src/Simplex/Messaging/Agent/Client.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -15,6 +14,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
@@ -118,8 +118,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random (getRandomBytes)
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
@@ -138,7 +137,6 @@ import Data.Text (Text)
 import Data.Text.Encoding
 import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
 import Data.Word (Word16)
-import GHC.Generics (Generic)
 import Network.Socket (HostName)
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..), XFTPClient, XFTPClientConfig (..), XFTPClientError)
 import qualified Simplex.FileTransfer.Client as X
@@ -165,7 +163,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Client
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parse)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parse)
 import Simplex.Messaging.Protocol
   ( AProtocolType (..),
     BrokerMsg,
@@ -288,9 +286,7 @@ data AgentLocks = AgentLocks
     srvLocks :: Map String String,
     delLock :: Maybe String
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON AgentLocks where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data AgentStatsKey = AgentStatsKey
   { userId :: UserId,
@@ -738,22 +734,13 @@ data ProtocolTestStep
   | TSDownloadFile
   | TSCompareFile
   | TSDeleteFile
-  deriving (Eq, Show, Generic)
-
-instance ToJSON ProtocolTestStep where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "TS"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "TS"
-
-instance FromJSON ProtocolTestStep where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "TS"
+  deriving (Eq, Show)
 
 data ProtocolTestFailure = ProtocolTestFailure
   { testStep :: ProtocolTestStep,
     testError :: AgentErrorType
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON ProtocolTestFailure where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 runSMPServerTest :: AgentMonad m => AgentClient -> UserId -> SMPServerWithAuth -> m (Maybe ProtocolTestFailure)
 runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
@@ -1368,22 +1355,14 @@ withNextSrv c userId usedSrvs initUsed action = do
   action srvAuth
 
 data SubInfo = SubInfo {userId :: UserId, server :: Text, rcvId :: Text, subError :: Maybe String}
-  deriving (Show, Generic)
-
-instance ToJSON SubInfo where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance FromJSON SubInfo where parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data SubscriptionsInfo = SubscriptionsInfo
   { activeSubscriptions :: [SubInfo],
     pendingSubscriptions :: [SubInfo],
     removedSubscriptions :: [SubInfo]
   }
-  deriving (Show, Generic)
-
-instance ToJSON SubscriptionsInfo where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance FromJSON SubscriptionsInfo where parseJSON = J.genericParseJSON J.defaultOptions
+  deriving (Show)
 
 getAgentSubscriptions :: MonadIO m => AgentClient -> m SubscriptionsInfo
 getAgentSubscriptions c = do
@@ -1398,3 +1377,13 @@ getAgentSubscriptions c = do
     subInfo (uId, srv, rId) err = SubInfo {userId = uId, server = enc srv, rcvId = enc rId, subError = show <$> err}
     enc :: StrEncoding a => a -> Text
     enc = decodeLatin1 . strEncode
+
+$(J.deriveJSON defaultJSON ''AgentLocks)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "TS") ''ProtocolTestStep)
+
+$(J.deriveJSON defaultJSON ''ProtocolTestFailure)
+
+$(J.deriveJSON defaultJSON ''SubInfo)
+
+$(J.deriveJSON defaultJSON ''SubscriptionsInfo)

src/Simplex/Messaging/Agent/Protocol.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -13,6 +12,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -151,7 +151,7 @@ import Control.Monad (unless)
 import Control.Monad.Except (runExceptT, throwError)
 import Control.Monad.IO.Class
 import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Base64
@@ -176,7 +176,6 @@ import Data.Typeable ()
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.ToField
-import GHC.Generics (Generic)
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol (FileParty (..), XFTPErrorType)
 import Simplex.Messaging.Agent.QueryString
@@ -612,11 +611,7 @@ data RcvQueueInfo = RcvQueueInfo
     rcvSwitchStatus :: Maybe RcvSwitchStatus,
     canAbortSwitch :: Bool
   }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON RcvQueueInfo where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance FromJSON RcvQueueInfo where parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 instance StrEncoding RcvQueueInfo where
   strEncode RcvQueueInfo {rcvServer, rcvSwitchStatus, canAbortSwitch} =
@@ -633,11 +628,7 @@ data SndQueueInfo = SndQueueInfo
   { sndServer :: SMPServer,
     sndSwitchStatus :: Maybe SndSwitchStatus
   }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON SndQueueInfo where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance FromJSON SndQueueInfo where parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 instance StrEncoding SndQueueInfo where
   strEncode SndQueueInfo {sndServer, sndSwitchStatus} =
@@ -654,9 +645,7 @@ data ConnectionStats = ConnectionStats
     ratchetSyncState :: RatchetSyncState,
     ratchetSyncSupported :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON ConnectionStats where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 instance StrEncoding ConnectionStats where
   strEncode ConnectionStats {connAgentVersion, rcvQueuesInfo, sndQueuesInfo, ratchetSyncState, ratchetSyncSupported} =
@@ -1389,7 +1378,7 @@ type AgentMsgId = Int64
 
 -- | Result of received message integrity validation.
 data MsgIntegrity = MsgOk | MsgError {errorInfo :: MsgErrorType}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance StrEncoding MsgIntegrity where
   strP = "OK" $> MsgOk <|> "ERR " *> (MsgError <$> strP)
@@ -1397,20 +1386,13 @@ instance StrEncoding MsgIntegrity where
     MsgOk -> "OK"
     MsgError e -> "ERR " <> strEncode e
 
-instance ToJSON MsgIntegrity where
-  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
-  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
-
-instance FromJSON MsgIntegrity where
-  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
-
 -- | Error of message integrity validation.
 data MsgErrorType
   = MsgSkipped {fromMsgId :: AgentMsgId, toMsgId :: AgentMsgId}
   | MsgBadId {msgId :: AgentMsgId}
   | MsgBadHash
   | MsgDuplicate
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance StrEncoding MsgErrorType where
   strP =
@@ -1425,13 +1407,6 @@ instance StrEncoding MsgErrorType where
     MsgBadHash -> "HASH"
     MsgDuplicate -> "DUPLICATE"
 
-instance ToJSON MsgErrorType where
-  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
-  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
-
-instance FromJSON MsgErrorType where
-  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
-
 -- | Error type used in errors sent to agent clients.
 data AgentErrorType
   = -- | command or response error
@@ -1452,14 +1427,7 @@ data AgentErrorType
     INTERNAL {internalErr :: String}
   | -- | agent inactive
     INACTIVE
-  deriving (Eq, Generic, Show, Exception)
-
-instance ToJSON AgentErrorType where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON AgentErrorType where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Show, Exception)
 
 -- | SMP agent protocol command or response error.
 data CommandErrorType
@@ -1473,14 +1441,7 @@ data CommandErrorType
     SIZE
   | -- | message does not fit in SMP block
     LARGE
-  deriving (Eq, Generic, Read, Show, Exception)
-
-instance ToJSON CommandErrorType where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON CommandErrorType where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show, Exception)
 
 -- | Connection error.
 data ConnectionErrorType
@@ -1494,14 +1455,7 @@ data ConnectionErrorType
     NOT_ACCEPTED
   | -- | connection not available on reply confirmation/HELLO after timeout
     NOT_AVAILABLE
-  deriving (Eq, Generic, Read, Show, Exception)
-
-instance ToJSON ConnectionErrorType where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON ConnectionErrorType where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show, Exception)
 
 -- | SMP server errors.
 data BrokerErrorType
@@ -1517,14 +1471,7 @@ data BrokerErrorType
     TRANSPORT {transportErr :: TransportError}
   | -- | command response timeout
     TIMEOUT
-  deriving (Eq, Generic, Read, Show, Exception)
-
-instance ToJSON BrokerErrorType where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON BrokerErrorType where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show, Exception)
 
 -- | Errors of another SMP agent.
 data SMPAgentError
@@ -1541,7 +1488,7 @@ data SMPAgentError
     A_DUPLICATE
   | -- | error in the message to add/delete/etc queue in connection
     A_QUEUE {queueErr :: String}
-  deriving (Eq, Generic, Read, Show, Exception)
+  deriving (Eq, Read, Show, Exception)
 
 data AgentCryptoError
   = -- | AES decryption error
@@ -1554,14 +1501,7 @@ data AgentCryptoError
     RATCHET_EARLIER Word32
   | -- | too many skipped messages
     RATCHET_SKIPPED Word32
-  deriving (Eq, Generic, Read, Show, Exception)
-
-instance ToJSON AgentCryptoError where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON AgentCryptoError where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show, Exception)
 
 instance StrEncoding AgentCryptoError where
   strP =
@@ -1577,13 +1517,6 @@ instance StrEncoding AgentCryptoError where
     RATCHET_EARLIER n -> "RATCHET_EARLIER " <> strEncode n
     RATCHET_SKIPPED n -> "RATCHET_SKIPPED " <> strEncode n
 
-instance ToJSON SMPAgentError where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON SMPAgentError where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
-
 instance StrEncoding AgentErrorType where
   strP =
     "CMD " *> (CMD <$> parseRead1)
@@ -1943,3 +1876,25 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
             unless (B.null s) $ throwError $ CMD SIZE
             pure body
           Nothing -> return . Left $ CMD SYNTAX
+
+$(J.deriveJSON defaultJSON ''RcvQueueInfo)
+
+$(J.deriveJSON defaultJSON ''SndQueueInfo)
+
+$(J.deriveJSON defaultJSON ''ConnectionStats)
+
+$(J.deriveJSON (sumTypeJSON fstToLower) ''MsgErrorType)
+
+$(J.deriveJSON (sumTypeJSON fstToLower) ''MsgIntegrity)
+
+$(J.deriveJSON (sumTypeJSON id) ''CommandErrorType)
+
+$(J.deriveJSON (sumTypeJSON id) ''ConnectionErrorType)
+
+$(J.deriveJSON (sumTypeJSON id) ''BrokerErrorType)
+
+$(J.deriveJSON (sumTypeJSON id) ''AgentCryptoError)
+
+$(J.deriveJSON (sumTypeJSON id) ''SMPAgentError)
+
+$(J.deriveJSON (sumTypeJSON id) ''AgentErrorType)

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -17,6 +16,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -219,8 +219,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 as J
+import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (second)
 import Data.ByteString (ByteString)
@@ -246,7 +245,6 @@ import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.QQ (sql)
 import Database.SQLite.Simple.ToField (ToField (..))
 import qualified Database.SQLite3 as SQLite3
-import GHC.Generics (Generic)
 import Network.Socket (ServiceName)
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Description
@@ -266,7 +264,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Parsers (blobFieldParser, dropPrefix, fromTextField_, sumTypeJSON)
+import Simplex.Messaging.Parsers (blobFieldParser, defaultJSON, dropPrefix, fromTextField_, sumTypeJSON)
 import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -286,7 +284,7 @@ data MigrationError
   = MEUpgrade {upMigrations :: [UpMigration]}
   | MEDowngrade {downMigrations :: [String]}
   | MigrationError {mtrError :: MTRError}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 migrationErrorDescription :: MigrationError -> String
 migrationErrorDescription = \case
@@ -296,18 +294,12 @@ migrationErrorDescription = \case
     "Database version is newer than the app.\nConfirm to back up and downgrade using these migrations: " <> intercalate ", " dms
   MigrationError err -> mtrErrorDescription err
 
-instance ToJSON MigrationError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "ME"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "ME"
-
 data UpMigration = UpMigration {upName :: String, withDown :: Bool}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 upMigration :: Migration -> UpMigration
 upMigration Migration {name, down} = UpMigration name $ isJust down
 
-instance ToJSON UpMigration where toEncoding = J.genericToEncoding J.defaultOptions
-
 data MigrationConfirmation = MCYesUp | MCYesUpDown | MCConsole | MCError
   deriving (Eq, Show)
 
@@ -2745,3 +2737,7 @@ deleteDeletedSndChunkReplicasExpired :: DB.Connection -> NominalDiffTime -> IO (
 deleteDeletedSndChunkReplicasExpired db ttl = do
   cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
   DB.execute db "DELETE FROM deleted_snd_chunk_replicas WHERE created_at < ?" (Only cutoffTs)
+
+$(J.deriveJSON defaultJSON ''UpMigration)
+
+$(J.deriveToJSON (sumTypeJSON $ dropPrefix "ME") ''MigrationError)

src/Simplex/Messaging/Agent/Store/SQLite/DB.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Messaging.Agent.Store.SQLite.DB
   ( Connection (..),
@@ -20,13 +20,12 @@ where
 
 import Control.Concurrent.STM
 import Control.Monad (when)
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Time (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
 import qualified Database.SQLite.Simple as SQL
-import GHC.Generics (Generic)
+import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (diffToMilliseconds)
@@ -41,9 +40,7 @@ data SlowQueryStats = SlowQueryStats
     timeMax :: Int64,
     timeAvg :: Int64
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON SlowQueryStats where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
 timeIt slow sql a = do
@@ -100,3 +97,5 @@ query_ Connection {conn, slow} sql = timeIt slow sql $ SQL.query_ conn sql
 queryNamed :: FromRow r => Connection -> Query -> [NamedParam] -> IO [r]
 queryNamed Connection {conn, slow} sql = timeIt slow sql . SQL.queryNamed conn sql
 {-# INLINE queryNamed #-}
+
+$(J.deriveJSON defaultJSON ''SlowQueryStats)

src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -6,6 +5,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Agent.Store.SQLite.Migrations
@@ -26,8 +26,7 @@ module Simplex.Messaging.Agent.Store.SQLite.Migrations
 where
 
 import Control.Monad (forM_, when)
-import Data.Aeson (ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.List (intercalate, sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map as M
@@ -39,7 +38,6 @@ import Database.SQLite.Simple (Connection, Only (..), Query (..))
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
-import GHC.Generics (Generic)
 import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
 import Simplex.Messaging.Agent.Store.SQLite.Common
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
@@ -168,11 +166,7 @@ data MigrationsToRun = MTRUp [Migration] | MTRDown [DownMigration] | MTRNone
 data MTRError
   = MTRENoDown {dbMigrations :: [String]}
   | MTREDifferent {appMigration :: String, dbMigration :: String}
-  deriving (Eq, Show, Generic)
-
-instance ToJSON MTRError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "MTRE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "MTRE"
+  deriving (Eq, Show)
 
 mtrErrorDescription :: MTRError -> String
 mtrErrorDescription = \case
@@ -191,3 +185,5 @@ migrationsToRun [] dbMs
 migrationsToRun (a : as) (d : ds)
   | name a == name d = migrationsToRun as ds
   | otherwise = Left $ MTREDifferent (name a) (name d)
+
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "MTRE") ''MTRError)

src/Simplex/Messaging/Client.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -10,6 +9,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -86,8 +86,7 @@ import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
-import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
@@ -97,13 +96,12 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
 import Data.Time.Clock (UTCTime, getCurrentTime)
-import GHC.Generics (Generic)
 import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
 import Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -190,14 +188,7 @@ data HostMode
     HMOnion
   | -- | prefer (or require) public hosts
     HMPublic
-  deriving (Eq, Show, Generic)
-
-instance FromJSON HostMode where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "HM"
-
-instance ToJSON HostMode where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "HM"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "HM"
+  deriving (Eq, Show)
 
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
@@ -223,21 +214,10 @@ data NetworkConfig = NetworkConfig
     smpPingCount :: Int,
     logTLSErrors :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON NetworkConfig where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data TransportSessionMode = TSMUser | TSMEntity
-  deriving (Eq, Show, Generic)
-
-instance ToJSON TransportSessionMode where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "TSM"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "TSM"
-
-instance FromJSON TransportSessionMode where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "TSM"
+  deriving (Eq, Show)
 
 defaultNetworkConfig :: NetworkConfig
 defaultNetworkConfig =
@@ -765,3 +745,9 @@ mkTransmission ProtocolClient {sessionId, thVersion, client_ = PClient {clientCo
       r <- Request entId <$> newEmptyTMVar
       TM.insert corrId r sentCommands
       pure r
+
+$(J.deriveJSON (enumJSON $ dropPrefix "HM") ''HostMode)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "TSM") ''TransportSessionMode)
+
+$(J.deriveJSON defaultJSON ''NetworkConfig)

src/Simplex/Messaging/Crypto/File.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Messaging.Crypto.File
   ( CryptoFile (..),
@@ -23,19 +23,18 @@ where
 import Control.Exception
 import Control.Monad
 import Control.Monad.Except
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isJust)
-import GHC.Generics (Generic)
 import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Lazy (LazyByteString)
 import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Util (liftEitherWith)
 import System.Directory (getFileSize)
 import UnliftIO (Handle, IOMode (..), liftIO)
@@ -44,16 +43,10 @@ import UnliftIO.STM
 
 -- Possibly encrypted local file
 data CryptoFile = CryptoFile {filePath :: FilePath, cryptoArgs :: Maybe CryptoFileArgs}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CryptoFile where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data CryptoFileArgs = CFArgs {fileKey :: C.SbKey, fileNonce :: C.CbNonce}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CryptoFileArgs where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data CryptoFileHandle = CFHandle Handle (Maybe (TVar LC.SbState))
 
@@ -123,3 +116,7 @@ getFileContentsSize :: CryptoFile -> IO Integer
 getFileContentsSize (CryptoFile path cfArgs) = do
   size <- getFileSize path
   pure $ if isJust cfArgs then size - fromIntegral C.authTagSize else size
+
+$(J.deriveJSON defaultJSON ''CryptoFileArgs)
+
+$(J.deriveJSON defaultJSON ''CryptoFile)

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -1,12 +1,12 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -20,8 +20,9 @@ import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
 import Crypto.Hash (SHA512)
 import qualified Crypto.KDF.HKDF as H
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
@@ -33,12 +34,11 @@ import Data.Typeable (Typeable)
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics
 import Simplex.Messaging.Agent.QueryString
 import Simplex.Messaging.Crypto
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (blobFieldDecoder, parseE, parseE')
+import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE')
 import Simplex.Messaging.Version
 
 currentE2EEncryptVersion :: Version
@@ -135,29 +135,20 @@ data Ratchet a = Ratchet
     rcNHKs :: HeaderKey,
     rcNHKr :: HeaderKey
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance AlgorithmI a => ToJSON (Ratchet a) where
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data SndRatchet a = SndRatchet
   { rcDHRr :: PublicKey a,
     rcCKs :: RatchetKey,
     rcHKs :: HeaderKey
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance AlgorithmI a => ToJSON (SndRatchet a) where
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data RcvRatchet = RcvRatchet
   { rcCKr :: RatchetKey,
     rcHKr :: HeaderKey
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON RcvRatchet where
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 type SkippedMsgKeys = Map HeaderKey SkippedHdrMsgKeys
 
@@ -204,10 +195,6 @@ instance ToJSON RatchetKey where
 instance FromJSON RatchetKey where
   parseJSON = fmap RatchetKey . strParseJSON "Key"
 
-instance AlgorithmI a => ToField (Ratchet a) where toField = toField . LB.toStrict . J.encode
-
-instance (AlgorithmI a, Typeable a) => FromField (Ratchet a) where fromField = blobFieldDecoder J.eitherDecodeStrict'
-
 instance ToField MessageKey where toField = toField . smpEncode
 
 instance FromField MessageKey where fromField = blobFieldDecoder smpDecode
@@ -493,3 +480,23 @@ hkdf3 salt ikm info = (s1, s2, s3)
     out = H.expand prk info 96
     (s1, rest) = B.splitAt 32 out
     (s2, s3) = B.splitAt 32 rest
+
+$(JQ.deriveJSON defaultJSON ''RcvRatchet)
+
+instance AlgorithmI a => ToJSON (SndRatchet a) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''SndRatchet)
+  toJSON = $(JQ.mkToJSON defaultJSON ''SndRatchet)
+
+instance AlgorithmI a => FromJSON (SndRatchet a) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''SndRatchet)
+
+instance AlgorithmI a => ToJSON (Ratchet a) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''Ratchet)
+  toJSON = $(JQ.mkToJSON defaultJSON ''Ratchet)
+
+instance AlgorithmI a => FromJSON (Ratchet a) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''Ratchet)
+
+instance AlgorithmI a => ToField (Ratchet a) where toField = toField . LB.toStrict . J.encode
+
+instance (AlgorithmI a, Typeable a) => FromField (Ratchet a) where fromField = blobFieldDecoder J.eitherDecodeStrict'

src/Simplex/Messaging/Notifications/Server/Push/APNS.hs

@@ -1,9 +1,9 @@
 {-# 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" #-}
@@ -23,15 +23,15 @@ import qualified Crypto.Store.PKCS8 as PK
 import Data.ASN1.BinaryEncoding (DER (..))
 import Data.ASN1.Encoding
 import Data.ASN1.Types
-import Data.Aeson (FromJSON, ToJSON, (.=))
+import Data.Aeson (ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
+import qualified Data.Aeson.TH as JQ
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LB
-import qualified Data.CaseInsensitive as CI
 import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
@@ -40,8 +40,7 @@ import qualified Data.Text as T
 import Data.Time.Clock.System
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
-import GHC.Generics (Generic)
-import Network.HTTP.Types (HeaderName, Status)
+import Network.HTTP.Types (Status)
 import qualified Network.HTTP.Types as N
 import Network.HTTP2.Client (Request)
 import qualified Network.HTTP2.Client as H
@@ -49,7 +48,9 @@ import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Server.Store (NtfTknData (..))
+import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Protocol (EncNMsgMeta)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import Simplex.Messaging.Transport.HTTP2.Client
@@ -61,17 +62,13 @@ data JWTHeader = JWTHeader
   { alg :: Text, -- key algorithm, ES256 for APNS
     kid :: Text -- key ID
   }
-  deriving (Show, Generic)
-
-instance ToJSON JWTHeader where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data JWTClaims = JWTClaims
   { iss :: Text, -- issuer, team ID for APNS
     iat :: Int64 -- issue time, seconds from epoch
   }
-  deriving (Show, Generic)
-
-instance ToJSON JWTClaims where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data JWTToken = JWTToken JWTHeader JWTClaims
   deriving (Show)
@@ -83,6 +80,10 @@ mkJWTToken hdr iss = do
 
 type SignedJWTToken = ByteString
 
+$(JQ.deriveToJSON defaultJSON ''JWTHeader)
+
+$(JQ.deriveToJSON defaultJSON ''JWTClaims)
+
 signedJWTToken :: EC.PrivateKey -> JWTToken -> IO SignedJWTToken
 signedJWTToken pk (JWTToken hdr claims) = do
   let hc = jwtEncode hdr <> "." <> jwtEncode claims
@@ -122,24 +123,13 @@ instance StrEncoding PNMessageData where
     pure PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}
 
 data APNSNotification = APNSNotification {aps :: APNSNotificationBody, notificationData :: Maybe J.Value}
-  deriving (Show, Generic)
-
-instance ToJSON APNSNotification where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data APNSNotificationBody
   = APNSBackground {contentAvailable :: Int}
   | APNSMutableContent {mutableContent :: Int, alert :: APNSAlertBody, category :: Maybe Text}
   | APNSAlert {alert :: APNSAlertBody, badge :: Maybe Int, sound :: Maybe Text, category :: Maybe Text}
-  deriving (Show, Generic)
-
-apnsJSONOptions :: J.Options
-apnsJSONOptions = J.defaultOptions {J.omitNothingFields = True, J.sumEncoding = J.UntaggedValue, J.fieldLabelModifier = J.camelTo2 '-'}
-
-instance ToJSON APNSNotificationBody where
-  toJSON = J.genericToJSON apnsJSONOptions
-  toEncoding = J.genericToEncoding apnsJSONOptions
+  deriving (Show)
 
 type APNSNotificationData = Map Text Text
 
@@ -305,6 +295,10 @@ apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
 
 -- apnAlert alert = APNSAlert {alert, badge = Nothing, sound = Nothing, category = Nothing}
 
+$(JQ.deriveToJSON apnsJSONOptions ''APNSNotificationBody)
+
+$(JQ.deriveToJSON defaultJSON ''APNSNotification)
+
 apnsRequest :: APNSPushClient -> ByteString -> APNSNotification -> IO Request
 apnsRequest c tkn ntf@APNSNotification {aps} = do
   signedJWT <- getApnsJWTToken c
@@ -337,7 +331,8 @@ type PushProviderClient = NtfTknData -> PushNotification -> ExceptT PushProvider
 
 -- this is not a newtype on purpose to have a correct JSON encoding as a record
 data APNSErrorResponse = APNSErrorResponse {reason :: Text}
-  deriving (Generic, FromJSON)
+
+$(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
 apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {token = DeviceToken _ tknStr} pn = do
@@ -372,12 +367,3 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
     err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
     err s r = throwError $ PPResponseError s r
     liftHTTPS2 a = ExceptT $ first PPConnection <$> a
-
-hApnsTopic :: HeaderName
-hApnsTopic = CI.mk "apns-topic"
-
-hApnsPushType :: HeaderName
-hApnsPushType = CI.mk "apns-push-type"
-
-hApnsPriority :: HeaderName
-hApnsPriority = CI.mk "apns-priority"

src/Simplex/Messaging/Notifications/Server/Push/APNS/Internal.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Notifications.Server.Push.APNS.Internal where
+
+import qualified Data.Aeson as J
+import qualified Data.CaseInsensitive as CI
+import Network.HTTP.Types (HeaderName)
+import Simplex.Messaging.Parsers (defaultJSON)
+
+hApnsTopic :: HeaderName
+hApnsTopic = CI.mk "apns-topic"
+
+hApnsPushType :: HeaderName
+hApnsPushType = CI.mk "apns-push-type"
+
+hApnsPriority :: HeaderName
+hApnsPriority = CI.mk "apns-priority"
+
+apnsJSONOptions :: J.Options
+apnsJSONOptions = defaultJSON {J.sumEncoding = J.UntaggedValue, J.fieldLabelModifier = J.camelTo2 '-'}

src/Simplex/Messaging/Parsers.hs

@@ -151,3 +151,6 @@ singleFieldJSON_ objectTag tagModifier =
       J.nullaryToObject = True,
       J.omitNothingFields = True
     }
+
+defaultJSON :: J.Options
+defaultJSON = J.defaultOptions {J.omitNothingFields = True}

src/Simplex/Messaging/Protocol.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -17,6 +16,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
@@ -155,7 +155,7 @@ import Control.Applicative (optional, (<|>))
 import Control.Concurrent (threadDelay)
 import Control.Monad.Except
 import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
@@ -170,7 +170,6 @@ import Data.Maybe (isJust, isNothing)
 import Data.String
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Type.Equality
-import GHC.Generics (Generic)
 import GHC.TypeLits (ErrorMessage (..), TypeError, type (+))
 import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
@@ -472,9 +471,7 @@ instance Encoding NMsgMeta where
 
 -- it must be data for correct JSON encoding
 data MsgFlags = MsgFlags {notification :: Bool}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON MsgFlags where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 -- this encoding should not become bigger than 7 bytes (currently it is 1 byte)
 instance Encoding MsgFlags where
@@ -997,14 +994,7 @@ data ErrorType
     INTERNAL
   | -- | used internally, never returned by the server (to be removed)
     DUPLICATE_ -- not part of SMP protocol, used internally
-  deriving (Eq, Generic, Read, Show)
-
-instance ToJSON ErrorType where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON ErrorType where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show)
 
 instance StrEncoding ErrorType where
   strEncode = \case
@@ -1026,14 +1016,7 @@ data CommandError
     HAS_AUTH
   | -- | transmission has no required entity ID (e.g. SMP queue)
     NO_ENTITY
-  deriving (Eq, Generic, Read, Show)
-
-instance ToJSON CommandError where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON CommandError where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show)
 
 -- | SMP transmission parser.
 transmissionP :: Parser RawTransmission
@@ -1381,3 +1364,9 @@ tDecodeParseValidate sessionId v = \case
     tParseValidate signed t@(sig, corrId, entityId, command) =
       let cmd = parseProtocol @err @cmd v command >>= checkCredentials t
        in (sig, signed, (CorrId corrId, entityId, cmd))
+
+$(J.deriveJSON defaultJSON ''MsgFlags)
+
+$(J.deriveJSON (sumTypeJSON id) ''CommandError)
+
+$(J.deriveJSON (sumTypeJSON id) ''ErrorType)

src/Simplex/Messaging/Transport.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -10,6 +9,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 -- |
@@ -63,8 +63,7 @@ where
 import Control.Applicative ((<|>))
 import Control.Monad.Except
 import Control.Monad.Trans.Except (throwE)
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import Data.Bifunctor (first)
 import Data.Bitraversable (bimapM)
@@ -74,7 +73,6 @@ import qualified Data.ByteString.Lazy as BL
 import Data.Default (def)
 import Data.Functor (($>))
 import Data.Version (showVersion)
-import GHC.Generics (Generic)
 import GHC.IO.Handle.Internals (ioe_EOF)
 import Network.Socket
 import qualified Network.TLS as T
@@ -282,14 +280,7 @@ data TransportError
     TEBadSession
   | -- | transport handshake error
     TEHandshake {handshakeErr :: HandshakeError}
-  deriving (Eq, Generic, Read, Show, Exception)
-
-instance ToJSON TransportError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "TE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "TE"
-
-instance FromJSON TransportError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "TE"
+  deriving (Eq, Read, Show, Exception)
 
 -- | Transport handshake error.
 data HandshakeError
@@ -299,14 +290,7 @@ data HandshakeError
     VERSION
   | -- | incorrect server identity
     IDENTITY
-  deriving (Eq, Generic, Read, Show, Exception)
-
-instance ToJSON HandshakeError where
-  toJSON = J.genericToJSON $ sumTypeJSON id
-  toEncoding = J.genericToEncoding $ sumTypeJSON id
-
-instance FromJSON HandshakeError where
-  parseJSON = J.genericParseJSON $ sumTypeJSON id
+  deriving (Eq, Read, Show, Exception)
 
 -- | SMP encrypted transport error parser.
 transportErrorP :: Parser TransportError
@@ -379,3 +363,7 @@ getHandshake th = ExceptT $ (parse smpP (TEHandshake PARSE) =<<) <$> tGetBlock t
 
 smpTHandle :: Transport c => c -> THandle c
 smpTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = smpBlockSize, thVersion = 0, batch = False}
+
+$(J.deriveJSON (sumTypeJSON id) ''HandshakeError)
+
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "TE") ''TransportError)

src/Simplex/Messaging/Transport/KeepAlive.hs

@@ -1,25 +1,22 @@
 {-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Messaging.Transport.KeepAlive where
 
-import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Foreign.C (CInt (..))
-import GHC.Generics (Generic)
 import Network.Socket
+import Simplex.Messaging.Parsers (defaultJSON)
 
 data KeepAliveOpts = KeepAliveOpts
   { keepIdle :: Int,
     keepIntvl :: Int,
     keepCnt :: Int
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON KeepAliveOpts where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 defaultKeepAliveOpts :: KeepAliveOpts
 defaultKeepAliveOpts =
@@ -68,3 +65,5 @@ setSocketKeepAlive sock KeepAliveOpts {keepCnt, keepIdle, keepIntvl} = do
   setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPIDLE) keepIdle
   setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPINTVL) keepIntvl
   setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPCNT) keepCnt
+
+$(J.deriveJSON defaultJSON ''KeepAliveOpts)

tests/CoreTests/ProtocolErrorTests.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module CoreTests.ProtocolErrorTests where
@@ -7,13 +9,14 @@ module CoreTests.ProtocolErrorTests where
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
+import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
-import Simplex.FileTransfer.Protocol (XFTPErrorType)
+import Simplex.FileTransfer.Protocol (XFTPErrorType (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (CommandError, ErrorType)
-import Simplex.Messaging.Transport (HandshakeError, TransportError)
+import Simplex.Messaging.Protocol (CommandError (..), ErrorType (..))
+import Simplex.Messaging.Transport (HandshakeError (..), TransportError (..))
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -33,6 +36,28 @@ protocolErrorTests = modifyMaxSuccess (const 1000) $ do
       _ -> False
     hasSpaces s = ' ' `B.elem` encodeUtf8 (T.pack s)
 
+deriving instance Generic AgentErrorType
+
+deriving instance Generic CommandErrorType
+
+deriving instance Generic ConnectionErrorType
+
+deriving instance Generic BrokerErrorType
+
+deriving instance Generic SMPAgentError
+
+deriving instance Generic AgentCryptoError
+
+deriving instance Generic ErrorType
+
+deriving instance Generic CommandError
+
+deriving instance Generic TransportError
+
+deriving instance Generic HandshakeError
+
+deriving instance Generic XFTPErrorType
+
 instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU
 
 instance Arbitrary CommandErrorType where arbitrary = genericArbitraryU

tests/NtfClient.hs

@@ -38,6 +38,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Push.APNS
+import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
@@ -186,10 +187,16 @@ instance FromJSON APNSAlertBody where
   parseJSON (J.String v) = pure $ APNSAlertText v
   parseJSON invalid = JT.prependFailure "parsing Coord failed, " (JT.typeMismatch "Object" invalid)
 
+deriving instance Generic APNSNotificationBody
+
 instance FromJSON APNSNotificationBody where parseJSON = J.genericParseJSON apnsJSONOptions {J.rejectUnknownFields = True}
 
+deriving instance Generic APNSNotification
+
 deriving instance FromJSON APNSNotification
 
+deriving instance Generic APNSErrorResponse
+
 deriving instance ToJSON APNSErrorResponse
 
 getAPNSMockServer :: HTTP2ServerConfig -> IO APNSMockServer