core: DB json encoding for group events (platform independent) (#966)

* core: DB json encoding for group events (platform independent)

* comment, migration

* shorter constructors

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

simplex-chat.cabal

@@ -46,6 +46,7 @@ library
       Simplex.Chat.Migrations.M20220812_incognito_profiles
       Simplex.Chat.Migrations.M20220818_chat_notifications
       Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id
+      Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items
       Simplex.Chat.Mobile
       Simplex.Chat.Options
       Simplex.Chat.ProfileGenerator

src/Simplex/Chat/Messages.hs

@@ -521,6 +521,8 @@ profileToText :: Profile -> Text
 profileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName
 
 -- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API
+-- ! Nested sum types also have to use different encodings for database and API
+-- ! to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent
 data CIContent (d :: MsgDirection) where
   CISndMsgContent :: MsgContent -> CIContent 'MDSnd
   CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv
@@ -533,6 +535,9 @@ data CIContent (d :: MsgDirection) where
   CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd
   CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv
   CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd
+-- ^^^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API
+-- ! ^^^ Nested sum types also have to use different encodings for database and API
+-- ! ^^^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent
 
 deriving instance Show (CIContent d)
 
@@ -553,6 +558,15 @@ instance ToJSON RcvGroupEvent where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RGE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RGE"
 
+newtype DBRcvGroupEvent = RGE RcvGroupEvent
+
+instance FromJSON DBRcvGroupEvent where
+  parseJSON v = RGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RGE") v
+
+instance ToJSON DBRcvGroupEvent where
+  toJSON (RGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RGE") v
+  toEncoding (RGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RGE") v
+
 data SndGroupEvent
   = SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
   | SGEUserLeft -- CRLeftMemberUser
@@ -566,6 +580,15 @@ instance ToJSON SndGroupEvent where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SGE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SGE"
 
+newtype DBSndGroupEvent = SGE SndGroupEvent
+
+instance FromJSON DBSndGroupEvent where
+  parseJSON v = SGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SGE") v
+
+instance ToJSON DBSndGroupEvent where
+  toJSON (SGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SGE") v
+  toEncoding (SGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SGE") v
+
 data CIGroupInvitation = CIGroupInvitation
   { groupId :: GroupId,
     groupMemberId :: GroupMemberId,
@@ -703,8 +726,8 @@ data DBJSONCIContent
   | DBJCIRcvIntegrityError {msgError :: MsgErrorType}
   | DBJCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
   | DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
-  | DBJCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent}
-  | DBJCISndGroupEvent {sndGroupEvent :: SndGroupEvent}
+  | DBJCIRcvGroupEvent {rcvGroupEvent :: DBRcvGroupEvent}
+  | DBJCISndGroupEvent {sndGroupEvent :: DBSndGroupEvent}
   deriving (Generic)
 
 instance FromJSON DBJSONCIContent where
@@ -725,8 +748,8 @@ dbJsonCIContent = \case
   CIRcvIntegrityError err -> DBJCIRcvIntegrityError err
   CIRcvGroupInvitation groupInvitation memberRole -> DBJCIRcvGroupInvitation {groupInvitation, memberRole}
   CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole}
-  CIRcvGroupEvent rcvGroupEvent -> DBJCIRcvGroupEvent {rcvGroupEvent}
-  CISndGroupEvent sndGroupEvent -> DBJCISndGroupEvent {sndGroupEvent}
+  CIRcvGroupEvent rge -> DBJCIRcvGroupEvent $ RGE rge
+  CISndGroupEvent sge -> DBJCISndGroupEvent $ SGE sge
 
 aciContentDBJSON :: DBJSONCIContent -> ACIContent
 aciContentDBJSON = \case
@@ -739,8 +762,8 @@ aciContentDBJSON = \case
   DBJCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err
   DBJCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole
   DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole
-  DBJCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent
-  DBJCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent
+  DBJCIRcvGroupEvent (RGE rge) -> ACIContent SMDRcv $ CIRcvGroupEvent rge
+  DBJCISndGroupEvent (SGE sge) -> ACIContent SMDSnd $ CISndGroupEvent sge
 
 data CICallStatus
   = CISCallPending

src/Simplex/Chat/Migrations/M20220823_delete_broken_group_event_chat_items.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220823_delete_broken_group_event_chat_items :: Query
+m20220823_delete_broken_group_event_chat_items =
+  [sql|
+DELETE FROM chat_items WHERE item_content LIKE '%{"rcvGroupEvent":{"rcvGroupEvent":{%';
+DELETE FROM chat_items WHERE item_content LIKE '%{"sndGroupEvent":{"sndGroupEvent":{%';
+|]

src/Simplex/Chat/Store.hs

@@ -231,6 +231,7 @@ import Simplex.Chat.Migrations.M20220811_chat_items_indices
 import Simplex.Chat.Migrations.M20220812_incognito_profiles
 import Simplex.Chat.Migrations.M20220818_chat_notifications
 import Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id
+import Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@@ -263,7 +264,8 @@ schemaMigrations =
     ("20220811_chat_items_indices", m20220811_chat_items_indices),
     ("20220812_incognito_profiles", m20220812_incognito_profiles),
     ("20220818_chat_notifications", m20220818_chat_notifications),
-    ("20220822_groups_host_conn_custom_user_profile_id", m20220822_groups_host_conn_custom_user_profile_id)
+    ("20220822_groups_host_conn_custom_user_profile_id", m20220822_groups_host_conn_custom_user_profile_id),
+    ("20220823_delete_broken_group_event_chat_items", m20220823_delete_broken_group_event_chat_items)
   ]
 
 -- | The list of migrations in ascending order by date