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

2025-06-28 20:29:53 +00:00 · 2022-01-29 20:21:37 +00:00 · 2022-01-29 20:21:37 +00:00 · 8425be0612
commit 8425be0612
parent c0199a38fd
11 changed files with 65 additions and 70 deletions
--- a/cabal.project
+++ b/cabal.project
@ -3,7 +3,12 @@ packages: .
 source-repository-package
    type: git
    location: git://github.com/simplex-chat/simplexmq.git
-    tag: 6fe3bfa980847c074b4cb0b9f3ea01cc5e6c567b
+    tag: 137ff7043d49feb3b350f56783c9b64a62bc636a
+
+source-repository-package
+    type: git
+    location: git://github.com/simplex-chat/aeson.git
+    tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7

 source-repository-package
    type: git
--- a/package.yaml
+++ b/package.yaml
@ -12,9 +12,9 @@ extra-source-files:
  - README.md

 dependencies:
-  - aeson == 1.5.*
+  - aeson == 2.0.*
  - ansi-terminal >= 0.10 && < 0.12
-  - attoparsec == 0.13.*
+  - attoparsec == 0.14.*
  - base >= 4.7 && < 5
  - base64-bytestring >= 1.0 && < 1.3
  - bytestring == 0.10.*
@ -36,7 +36,6 @@ dependencies:
  - time == 1.9.*
  - unliftio == 0.2.*
  - unliftio-core == 0.2.*
-  - unordered-containers == 0.2.*

 library:
  source-dirs: src
--- a/sha256map.nix
+++ b/sha256map.nix
@ -1,5 +1,6 @@
 {
-  "git://github.com/simplex-chat/simplexmq.git"."6fe3bfa980847c074b4cb0b9f3ea01cc5e6c567b" = "0yhxngrvis2ykcrx2mzin1c2bch1p7r6m4lqazdybrkas0p349qc";
+  "git://github.com/simplex-chat/simplexmq.git"."137ff7043d49feb3b350f56783c9b64a62bc636a" = "1jlxpmg40qkvisbf03082yrw6k2ah9dsw8pn1jqc0cyz5250qc49";
+  "git://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
  "git://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
  "git://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97";
 }
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@ -45,9 +45,9 @@ library
      src
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
  build-depends:
-      aeson ==1.5.*
+      aeson ==2.0.*
    , ansi-terminal >=0.10 && <0.12
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
    , base >=4.7 && <5
    , base64-bytestring >=1.0 && <1.3
    , bytestring ==0.10.*
@ -69,7 +69,6 @@ library
    , time ==1.9.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
-    , unordered-containers ==0.2.*
  default-language: Haskell2010

 executable simplex-chat
@ -80,9 +79,9 @@ executable simplex-chat
      apps/simplex-chat
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
  build-depends:
-      aeson ==1.5.*
+      aeson ==2.0.*
    , ansi-terminal >=0.10 && <0.12
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
    , base >=4.7 && <5
    , base64-bytestring >=1.0 && <1.3
    , bytestring ==0.10.*
@ -105,7 +104,6 @@ executable simplex-chat
    , time ==1.9.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
-    , unordered-containers ==0.2.*
  default-language: Haskell2010

 test-suite simplex-chat-test
@ -121,10 +119,10 @@ test-suite simplex-chat-test
      tests
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
  build-depends:
-      aeson ==1.5.*
+      aeson ==2.0.*
    , ansi-terminal >=0.10 && <0.12
    , async ==2.2.*
-    , attoparsec ==0.13.*
+    , attoparsec ==0.14.*
    , base >=4.7 && <5
    , base64-bytestring >=1.0 && <1.3
    , bytestring ==0.10.*
@ -149,5 +147,4 @@ test-suite simplex-chat-test
    , time ==1.9.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
-    , unordered-containers ==0.2.*
  default-language: Haskell2010
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@ -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)

--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@ -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
--- a/src/Simplex/Chat/Protocol.hs
+++ b/src/Simplex/Chat/Protocol.hs
@ -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
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@ -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"
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@ -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)

--- a/src/Simplex/Chat/Util.hs
+++ b/src/Simplex/Chat/Util.hs
@ -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
--- a/stack.yaml
+++ b/stack.yaml
@ -38,11 +38,20 @@ extra-deps:
  - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
  - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
  - tls-1.5.7@sha256:1cc30253a9696b65a9cafc0317fbf09f7dcea15e3a145ed6c9c0e28c632fa23a,6991
+  # below hackage dependancies are to update Aeson to 2.0.3
+  - OneTuple-0.3.1@sha256:a848c096c9d29e82ffdd30a9998aa2931cbccb3a1bc137539d80f6174d31603e,2262
+  - attoparsec-0.14.4@sha256:79584bdada8b730cb5138fca8c35c76fbef75fc1d1e01e6b1d815a5ee9843191,5810
+  - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005
+  - semialign-1.2.0.1@sha256:0e179b4d3a8eff79001d374d6c91917c6221696b9620f0a4d86852fc6a9b9501,2836
+  - text-short-0.1.5@sha256:962c6228555debdc46f758d0317dea16e5240d01419b42966674b08a5c3d8fa6,3498
+  - time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033
  # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
  # - ../simplexmq
  - github: simplex-chat/simplexmq
-    commit: 6fe3bfa980847c074b4cb0b9f3ea01cc5e6c567b
+    commit: 137ff7043d49feb3b350f56783c9b64a62bc636a
  # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
+  - github: simplex-chat/aeson
+    commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7
  - github: simplex-chat/haskell-terminal
    commit: f708b00009b54890172068f168bf98508ffcd495