blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

use aeson fork with nullableToObject option to make JSON compatible with Swift (#236)

Browse Source
This commit is contained in:
Evgeny Poberezkin
2022-01-29 20:21:37 +00:00
committed by GitHub
parent c0199a38fd
commit 8425be0612
11 changed files with 65 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+7 -8
View File
@@ -24,12 +24,11 @@ import Numeric.Natural
import Simplex.Chat.Messages
import Simplex.Chat.Store (StoreError)
import Simplex.Chat.Types
import Simplex.Chat.Util (enumJSON, singleFieldJSON)
import Simplex.Messaging.Agent (AgentClient)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
import Simplex.Messaging.Parsers (dropPrefix)
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
import Simplex.Messaging.Protocol (CorrId)
import System.IO (Handle)
import UnliftIO.STM
@@ -189,8 +188,8 @@ data ChatResponse
deriving (Show, Generic)
instance ToJSON ChatResponse where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "CR"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "CR"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
data ChatError
= ChatError {errorType :: ChatErrorType}
@@ -201,8 +200,8 @@ data ChatError
deriving (Show, Exception, Generic)
instance ToJSON ChatError where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "Chat"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "Chat"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "Chat"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "Chat"
data ChatErrorType
= CEGroupUserRole
@@ -231,8 +230,8 @@ data ChatErrorType
deriving (Show, Exception, Generic)
instance ToJSON ChatErrorType where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "CE"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "CE"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CE"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CE"
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
src/Simplex/Chat/Messages.hs
+12 -10
View File
@@ -30,11 +30,10 @@ import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics (Generic)
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Util (enumJSON, singleFieldJSON)
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..))
import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix)
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
import Simplex.Messaging.Protocol (MsgBody)
data ChatType = CTDirect | CTGroup
@@ -56,8 +55,8 @@ data JSONChatInfo
deriving (Generic)
instance ToJSON JSONChatInfo where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCInfo"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCInfo"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCInfo"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCInfo"
instance ToJSON (ChatInfo c) where
toJSON = J.toJSON . jsonChatInfo
@@ -92,11 +91,14 @@ data JSONCIDirection
| JCIDirectRcv
| JCIGroupSnd
| JCIGroupRcv {groupMember :: GroupMember}
deriving (Generic)
deriving (Generic, Show)
instance FromJSON JSONCIDirection where
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI"
instance ToJSON JSONCIDirection where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCI"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCI"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI"
instance ToJSON (CIDirection c d) where
toJSON = J.toJSON . jsonCIDirection
@@ -240,11 +242,11 @@ data JSONCIContent
deriving (Generic)
instance FromJSON JSONCIContent where
parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "JCI"
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI"
instance ToJSON JSONCIContent where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCI"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCI"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI"
jsonCIContent :: CIContent d -> JSONCIContent
jsonCIContent = \case
src/Simplex/Chat/Protocol.hs
+7 -7
View File
@@ -18,7 +18,7 @@ import qualified Data.Aeson as J
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.HashMap.Strict as H
import qualified Data.Aeson.KeyMap as JM
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Database.SQLite.Simple.FromField (FromField (..))
@@ -255,7 +255,7 @@ appToChatMessage AppMessage {event, params} = do
chatMsgEvent <- msg eventTag
pure ChatMessage {chatMsgEvent}
where
p :: FromJSON a => Text -> Either String a
p :: FromJSON a => J.Key -> Either String a
p key = JT.parseEither (.: key) params
msg = \case
XMsgNew_ -> XMsgNew <$> p "content"
@@ -284,8 +284,8 @@ chatToAppMessage :: ChatMessage -> AppMessage
chatToAppMessage ChatMessage {chatMsgEvent} = AppMessage {event, params}
where
event = serializeCMEventTag . toCMEventTag $ chatMsgEvent
o :: [(Text, J.Value)] -> J.Object
o = H.fromList
o :: [(J.Key, J.Value)] -> J.Object
o = JM.fromList
params = case chatMsgEvent of
XMsgNew content -> o ["content" .= content]
XFile fileInv -> o ["file" .= fileInv]
@@ -302,9 +302,9 @@ chatToAppMessage ChatMessage {chatMsgEvent} = AppMessage {event, params}
XGrpMemCon memId -> o ["memberId" .= memId]
XGrpMemConAll memId -> o ["memberId" .= memId]
XGrpMemDel memId -> o ["memberId" .= memId]
XGrpLeave -> H.empty
XGrpDel -> H.empty
XGrpLeave -> JM.empty
XGrpDel -> JM.empty
XInfoProbe probe -> o ["probe" .= probe]
XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
XInfoProbeOk probe -> o ["probe" .= probe]
XOk -> H.empty
XOk -> JM.empty
src/Simplex/Chat/Store.hs
+4 -4
View File
@@ -143,12 +143,12 @@ import Simplex.Chat.Migrations.M20220122_pending_group_messages
import Simplex.Chat.Migrations.M20220125_chat_items
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Util (eitherToMaybe, singleFieldJSON)
import Simplex.Chat.Util (eitherToMaybe)
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..))
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, firstRow, withTransaction)
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Parsers (dropPrefix)
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Util (liftIOEither, (<$$>))
import System.FilePath (takeFileName)
import UnliftIO.STM
@@ -2178,5 +2178,5 @@ data StoreError
deriving (Show, Exception, Generic)
instance ToJSON StoreError where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "SE"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "SE"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SE"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SE"
src/Simplex/Chat/Types.hs
+9 -10
View File
@@ -32,11 +32,10 @@ import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok (Ok (Ok))
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics (Generic)
import Simplex.Chat.Util (singleFieldJSON)
import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId)
import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix)
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Util ((<$?>))
class IsContact a where
@@ -244,11 +243,11 @@ data InvitedBy = IBContact {byContactId :: Int64} | IBUser | IBUnknown
deriving (Eq, Show, Generic)
instance FromJSON InvitedBy where
parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "IB"
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "IB"
instance ToJSON InvitedBy where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "IB"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "IB"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "IB"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "IB"
toInvitedBy :: Int64 -> Maybe Int64 -> InvitedBy
toInvitedBy userCtId (Just ctId)
@@ -484,11 +483,11 @@ data RcvFileStatus
deriving (Eq, Show, Generic)
instance FromJSON RcvFileStatus where
parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "RFS"
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RFS"
instance ToJSON RcvFileStatus where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "RFS"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "RFS"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RFS"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RFS"
data RcvFileInfo = RcvFileInfo
{ filePath :: FilePath,
@@ -522,8 +521,8 @@ data FileTransfer = FTSnd {sndFileTransfers :: [SndFileTransfer]} | FTRcv RcvFil
deriving (Show, Generic)
instance ToJSON FileTransfer where
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "FT"
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "FT"
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "FT"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "FT"
data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Ord, Show)
src/Simplex/Chat/Util.hs
-16
View File
@@ -1,7 +1,6 @@
module Simplex.Chat.Util where
import Control.Monad (when)
import qualified Data.Aeson as J
import Data.ByteString.Char8 (ByteString)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8With)
@@ -20,20 +19,5 @@ whenM ba a = ba >>= (`when` a)
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM b = ifM b $ pure ()
enumJSON :: (String -> String) -> J.Options
enumJSON tagModifier =
J.defaultOptions
{ J.constructorTagModifier = tagModifier,
J.allNullaryToStringTag = True
}
singleFieldJSON :: (String -> String) -> J.Options
singleFieldJSON tagModifier =
J.defaultOptions
{ J.constructorTagModifier = tagModifier,
J.sumEncoding = J.ObjectWithSingleField,
J.omitNothingFields = True
}
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = either (const Nothing) Just