core: derive JSON with TH (#3275)

* core: derive JSON with TH

* fix tests

* simplify events

* reduce diff

* fix

* update simplexmq

* update simplexmq
This commit is contained in:
Evgeny Poberezkin
2023-10-26 15:44:50 +01:00
committed by GitHub
parent 3790752378
commit 16bda26022
23 changed files with 849 additions and 1136 deletions
+8 -9
View File
@@ -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 as J
import qualified Data.Aeson.TH 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)
instance ToJSON UserContactLink where toEncoding = J.genericToEncoding J.defaultOptions
deriving (Show)
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) =