From 8425be0612dba300be19521a4a113ab775af875d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 29 Jan 2022 20:21:37 +0000
Subject: [PATCH] use aeson fork with nullableToObject option to make JSON
 compatible with Swift (#236)

---
 cabal.project                  |  7 ++++++-
 package.yaml                   |  5 ++---
 sha256map.nix                  |  3 ++-
 simplex-chat.cabal             | 15 ++++++---------
 src/Simplex/Chat/Controller.hs | 15 +++++++--------
 src/Simplex/Chat/Messages.hs   | 22 ++++++++++++----------
 src/Simplex/Chat/Protocol.hs   | 14 +++++++-------
 src/Simplex/Chat/Store.hs      |  8 ++++----
 src/Simplex/Chat/Types.hs      | 19 +++++++++----------
 src/Simplex/Chat/Util.hs       | 16 ----------------
 stack.yaml                     | 11 ++++++++++-
 11 files changed, 65 insertions(+), 70 deletions(-)

diff --git a/cabal.project b/cabal.project
index 9672e6c7e..2d18b117c 100644
--- 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
diff --git a/package.yaml b/package.yaml
index b991ee8f5..8aa1ae3f1 100644
--- 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
diff --git a/sha256map.nix b/sha256map.nix
index cc95f1ca7..fc95b7a30 100644
--- 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";
 }
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 17e5cc734..56fa5acbc 100644
--- 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
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index f15eade32..a86a943b8 100644
--- 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)
 
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index b0cda969e..0aa53ab3a 100644
--- 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
diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs
index 8d1623984..5107ada98 100644
--- 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
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 9b11ca3a9..281b65bd7 100644
--- 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"
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index b413d2807..d6ab2a239 100644
--- 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)
 
diff --git a/src/Simplex/Chat/Util.hs b/src/Simplex/Chat/Util.hs
index f4663879b..a5e4c8b1e 100644
--- 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
diff --git a/stack.yaml b/stack.yaml
index 0e2d61898..9c282b18e 100644
--- 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