core: group integrity status types (#3302)

* core: group DAG types

* fix tests

* schema, more types

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

simplex-chat.cabal

@@ -36,6 +36,7 @@ library
       Simplex.Chat.Markdown
       Simplex.Chat.Messages
       Simplex.Chat.Messages.CIContent
+      Simplex.Chat.Messages.Events
       Simplex.Chat.Migrations.M20220101_initial
       Simplex.Chat.Migrations.M20220122_v1_1
       Simplex.Chat.Migrations.M20220205_chat_item_status
@@ -119,6 +120,7 @@ library
       Simplex.Chat.Migrations.M20231010_member_settings
       Simplex.Chat.Migrations.M20231019_indexes
       Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
+      Simplex.Chat.Migrations.M20231101_group_events
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared

src/Simplex/Chat.hs

@@ -5264,13 +5264,13 @@ createSndMessage chatMsgEvent connOrGroupId = do
   gVar <- asks idsDrg
   ChatConfig {chatVRange} <- asks config
   withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId ->
-    let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
+    let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent, groupEvent = Nothing}
      in NewMessage {chatMsgEvent, msgBody}
 
 directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString
 directMessage chatMsgEvent = do
   ChatConfig {chatVRange} <- asks config
-  pure $ strEncode ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
+  pure $ strEncode ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent, groupEvent = Nothing}
 
 deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64
 deliverMessage conn@Connection {connId} cmEventTag msgBody msgId = do

src/Simplex/Chat/Messages.hs

@@ -36,6 +36,7 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Messages.Events
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -341,6 +342,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
     itemTimed :: Maybe CITimed,
     itemLive :: Maybe Bool,
     editable :: Bool,
+    groupIntegrityStatus :: GroupIntegrityStatus,
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
@@ -351,10 +353,22 @@ mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted item
   let editable = case itemContent of
         CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
         _ -> False
-   in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, createdAt, updatedAt}
+      groupIntegrityStatus = GISNoEvent
+   in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, groupIntegrityStatus, createdAt, updatedAt}
 
 instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions
 
+data GroupIntegrityStatus
+  = GISOk                                              -- sent event; or received event with all parents known
+  | GISIntegrityError GroupEventIntegrityError         -- received event has integrity error (if many, order and choose one?)
+  | GISConfirmedParent GroupEventIntegrityConfirmation -- received event has no errors and was confirmed by other member, higher role is preferred
+  | GISNoEvent                                         -- direct chat items and group chat items without recorded group events (legacy)
+  deriving (Show, Generic)
+
+instance ToJSON GroupIntegrityStatus where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "GIS"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "GIS"
+
 data CITimed = CITimed
   { ttl :: Int, -- seconds
     deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read

src/Simplex/Chat/Messages/CIContent.hs

@@ -137,6 +137,7 @@ data CIContent (d :: MsgDirection) where
   CIRcvGroupFeatureRejected :: GroupFeature -> CIContent 'MDRcv
   CISndModerated :: CIContent 'MDSnd
   CIRcvModerated :: CIContent 'MDRcv
+  -- CIRcvMissing :: CIContent 'MDRcv -- to display group dag gaps
   CIInvalidJSON :: Text -> CIContent d
 -- ^ 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

src/Simplex/Chat/Messages/Events.hs

@@ -0,0 +1,80 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Chat.Messages.Events where
+
+import qualified Data.Aeson.TH as JQ
+import Data.ByteString.Char8 (ByteString)
+import Data.Time.Clock (UTCTime)
+import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Protocol
+import Simplex.Chat.Types
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
+import Simplex.Messaging.Version
+
+data StoredGroupEvent d = StoredGroupEvent
+  { chatVRange :: VersionRange,
+    msgId :: SharedMsgId,
+    eventData :: StoredGroupEventData,
+    integrityErrors :: [GroupEventIntegrityError],
+    integrityConfirmations :: [GroupEventIntegrityConfirmation],
+    sharedHash :: ByteString,
+    eventDir :: GEDirection d,
+    parents :: [AStoredGroupEvent]
+  }
+
+data AStoredGroupEvent = forall d. MsgDirectionI d => AStoredGroupEvent (StoredGroupEvent d)
+
+data GroupEventIntegrityError = GroupEventIntegrityError
+  { groupMemberId :: GroupMemberId,
+    memberRole :: GroupMemberRole,
+    error :: GroupEventError
+  }
+  deriving (Show)
+
+data GroupEventError
+  = GEErrInvalidHash                    -- content hash mismatch
+  | GEErrUnconfirmedParent SharedMsgId  -- referenced parent wasn't previously received from author or admin
+  | GEErrParentHashMismatch SharedMsgId -- referenced parent has different hash
+  | GEErrChildHashMismatch SharedMsgId  -- child referencing this event has different hash (mirrors GEErrParentHashMismatch)
+  deriving (Show)
+
+data GroupEventIntegrityConfirmation = GroupEventIntegrityConfirmation
+  { groupMemberId :: GroupMemberId,
+    memberRole :: GroupMemberRole
+  }
+  deriving (Show)
+
+data GEDirection (d :: MsgDirection) where
+  GESent :: GEDirection 'MDSnd
+  GEReceived :: ReceivedEventInfo -> GEDirection 'MDRcv
+
+data StoredGroupEventData = SGEData (ChatMsgEvent 'Json) | SGEAvailable [GroupMemberId]
+
+data ReceivedEventInfo = ReceivedEventInfo
+  { authorMemberId :: MemberId,
+    authorMemberName :: ContactName,
+    authorMember :: GroupMemberRef,
+    receivedFrom :: GroupMemberRef,
+    processing :: EventProcessing
+  }
+
+data ReceivedFromRole = RFAuthor | RFSufficientPrivilege | RFLower
+
+receivedFromRole' :: ReceivedEventInfo -> ReceivedFromRole
+receivedFromRole' = undefined
+
+data EventProcessing
+  = EPProcessed UTCTime
+  | EPScheduled UTCTime
+  | EPPendingConfirmation -- e.g. till it's received from author or member with the same or higher privileges (depending on the event)
+
+-- platform-specific JSON encoding (used in API)
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GEErr") ''GroupEventError)
+
+$(JQ.deriveJSON defaultJSON ''GroupEventIntegrityError)
+
+$(JQ.deriveJSON defaultJSON ''GroupEventIntegrityConfirmation)

src/Simplex/Chat/Migrations/M20231101_group_events.hs

@@ -0,0 +1,128 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20231101_group_events where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20231101_group_events :: Query
+m20231101_group_events =
+  [sql|
+CREATE TABLE group_events (
+  group_event_id INTEGER PRIMARY KEY,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL,
+  chat_min_version INTEGER NOT NULL DEFAULT 1,  -- chatVRange :: VersionRange
+  chat_max_version INTEGER NOT NULL DEFAULT 1,
+  shared_msg_id BLOB NOT NULL,                  -- msgId :: SharedMsgId
+  event_data TEXT NOT NULL,                     -- eventData :: StoredGroupEventData
+  shared_hash BLOB NOT NULL,                    -- sharedHash :: ByteString
+  event_sent INTEGER NOT NULL,                  -- 0 for received, 1 for sent; below `rcvd_` fields are null for sent
+  -- ReceivedEventInfo fields:
+  rcvd_author_member_id BLOB,                   -- authorMemberId :: MemberId
+  rcvd_author_member_name TEXT,                 -- authorMemberName :: ContactName
+  -- authorMember :: GroupMemberRef
+  rcvd_author_group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
+  rcvd_author_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE CASCADE,
+  rcvd_author_role TEXT,
+  -- receivedFrom :: GroupMemberRef
+  rcvd_from_group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
+  rcvd_from_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE CASCADE,
+  rcvd_from_role TEXT,
+  -- ReceivedEventInfo processing :: EventProcessing
+  rcvd_processed_at TEXT,                       -- EPProcessed UTCTime
+  rcvd_scheduled_at TEXT,                       -- EPScheduled UTCTime; both this and rcvd_processed_at are null -> EPPendingConfirmation
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE INDEX idx_group_events_user_id ON group_events(user_id);
+CREATE INDEX idx_group_events_chat_item_id ON group_events(chat_item_id);
+CREATE INDEX idx_group_events_shared_msg_id ON group_events(shared_msg_id);
+CREATE INDEX idx_group_events_rcvd_author_group_member_id ON group_events(rcvd_author_group_member_id);
+CREATE INDEX idx_group_events_rcvd_author_contact_profile_id ON group_events(rcvd_author_contact_profile_id);
+CREATE INDEX idx_group_events_rcvd_from_group_member_id ON group_events(rcvd_from_group_member_id);
+CREATE INDEX idx_group_events_rcvd_from_contact_profile_id ON group_events(rcvd_from_contact_profile_id);
+
+CREATE TABLE group_events_availabilities (
+  group_events_availability_id INTEGER PRIMARY KEY,
+  group_event_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  available_at_group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE INDEX idx_group_events_availabilities_group_event_id ON group_events_availabilities(group_event_id);
+CREATE INDEX idx_group_events_availabilities_available_at_group_member_id ON group_events_availabilities(available_at_group_member_id);
+
+CREATE TABLE group_events_errors (
+  group_event_dag_error_id INTEGER PRIMARY KEY,
+  group_event_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  referred_group_event_id INTEGER REFERENCES group_events ON DELETE SET NULL,
+  referred_group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
+  referred_group_member_role TEXT NOT NULL,
+  error TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE INDEX idx_group_events_errors_group_event_id ON group_events_errors(group_event_id);
+CREATE INDEX idx_group_events_errors_referred_group_event_id ON group_events_errors(referred_group_event_id);
+CREATE INDEX idx_group_events_errors_referred_group_member_id ON group_events_errors(referred_group_member_id);
+
+CREATE TABLE group_events_confirmations (
+  group_event_confirmation_id INTEGER PRIMARY KEY,
+  group_event_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  confirming_group_event_id INTEGER REFERENCES group_events ON DELETE SET NULL,
+  confirmed_by_group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
+  confirmed_by_group_member_role TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE INDEX idx_group_events_confirmations_group_event_id ON group_events_confirmations(group_event_id);
+CREATE INDEX idx_group_events_confirmations_confirming_group_event_id ON group_events_confirmations(confirming_group_event_id);
+CREATE INDEX idx_group_events_confirmations_confirmed_by_group_member_id ON group_events_confirmations(confirmed_by_group_member_id);
+
+CREATE TABLE group_events_parents (
+  group_event_parent_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  group_event_child_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
+  UNIQUE(group_event_parent_id, group_event_child_id)
+);
+
+CREATE INDEX idx_group_events_parents_group_event_parent_id ON group_events_parents(group_event_parent_id);
+CREATE INDEX idx_group_events_parents_group_event_child_id ON group_events_parents(group_event_child_id);
+|]
+
+down_m20231101_group_events :: Query
+down_m20231101_group_events =
+  [sql|
+DROP INDEX idx_group_events_parents_group_event_parent_id;
+DROP INDEX idx_group_events_parents_group_event_child_id;
+DROP TABLE group_events_parents;
+
+DROP INDEX idx_group_events_confirmations_group_event_id;
+DROP INDEX idx_group_events_confirmations_confirming_group_event_id;
+DROP INDEX idx_group_events_confirmations_confirmed_by_group_member_id;
+DROP TABLE group_events_confirmations;
+
+DROP INDEX idx_group_events_errors_group_event_id;
+DROP INDEX idx_group_events_errors_referred_group_event_id;
+DROP INDEX idx_group_events_errors_referred_group_member_id;
+DROP TABLE group_events_errors;
+
+DROP INDEX idx_group_events_availabilities_group_event_id;
+DROP INDEX idx_group_events_availabilities_available_at_group_member_id;
+DROP TABLE group_events_availabilities;
+
+DROP INDEX idx_group_events_user_id;
+DROP INDEX idx_group_events_chat_item_id;
+DROP INDEX idx_group_events_shared_msg_id;
+DROP INDEX idx_group_events_rcvd_author_group_member_id;
+DROP INDEX idx_group_events_rcvd_author_contact_profile_id;
+DROP INDEX idx_group_events_rcvd_from_group_member_id;
+DROP INDEX idx_group_events_rcvd_from_contact_profile_id;
+DROP TABLE group_events;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -520,6 +520,66 @@ CREATE TABLE IF NOT EXISTS "received_probes"(
   created_at TEXT CHECK(created_at NOT NULL),
   updated_at TEXT CHECK(updated_at NOT NULL)
 );
+CREATE TABLE group_events(
+  group_event_id INTEGER PRIMARY KEY,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL,
+  chat_min_version INTEGER NOT NULL DEFAULT 1, -- chatVRange :: VersionRange
+  chat_max_version INTEGER NOT NULL DEFAULT 1,
+  shared_msg_id BLOB NOT NULL, -- msgId :: SharedMsgId
+  event_data TEXT NOT NULL, -- eventData :: StoredGroupEventData
+  shared_hash BLOB NOT NULL, -- sharedHash :: ByteString
+  event_sent INTEGER NOT NULL, -- 0 for received, 1 for sent; below `rcvd_` fields are null for sent
+  -- ReceivedEventInfo fields:
+  rcvd_author_member_id BLOB, -- authorMemberId :: MemberId
+  rcvd_author_member_name TEXT, -- authorMemberName :: ContactName
+  -- authorMember :: GroupMemberRef
+  rcvd_author_group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
+  rcvd_author_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE CASCADE,
+  rcvd_author_role TEXT,
+  -- receivedFrom :: GroupMemberRef
+  rcvd_from_group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
+  rcvd_from_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE CASCADE,
+  rcvd_from_role TEXT,
+  -- ReceivedEventInfo processing :: EventProcessing
+  rcvd_processed_at TEXT, -- EPProcessed UTCTime
+  rcvd_scheduled_at TEXT, -- EPScheduled UTCTime; both this and rcvd_processed_at are null -> EPPendingConfirmation
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE group_events_availabilities(
+  group_events_availability_id INTEGER PRIMARY KEY,
+  group_event_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  available_at_group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE group_events_errors(
+  group_event_dag_error_id INTEGER PRIMARY KEY,
+  group_event_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  referred_group_event_id INTEGER REFERENCES group_events ON DELETE SET NULL,
+  referred_group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
+  referred_group_member_role TEXT NOT NULL,
+  error TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE group_events_confirmations(
+  group_event_confirmation_id INTEGER PRIMARY KEY,
+  group_event_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  confirming_group_event_id INTEGER REFERENCES group_events ON DELETE SET NULL,
+  confirmed_by_group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
+  confirmed_by_group_member_role TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE group_events_parents(
+  group_event_parent_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  group_event_child_id INTEGER NOT NULL REFERENCES group_events ON DELETE CASCADE,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
+  UNIQUE(group_event_parent_id, group_event_child_id)
+);
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
   full_name
@@ -748,3 +808,48 @@ CREATE INDEX idx_connections_via_contact_uri_hash ON connections(
   user_id,
   via_contact_uri_hash
 );
+CREATE INDEX idx_group_events_user_id ON group_events(user_id);
+CREATE INDEX idx_group_events_chat_item_id ON group_events(chat_item_id);
+CREATE INDEX idx_group_events_shared_msg_id ON group_events(shared_msg_id);
+CREATE INDEX idx_group_events_rcvd_author_group_member_id ON group_events(
+  rcvd_author_group_member_id
+);
+CREATE INDEX idx_group_events_rcvd_author_contact_profile_id ON group_events(
+  rcvd_author_contact_profile_id
+);
+CREATE INDEX idx_group_events_rcvd_from_group_member_id ON group_events(
+  rcvd_from_group_member_id
+);
+CREATE INDEX idx_group_events_rcvd_from_contact_profile_id ON group_events(
+  rcvd_from_contact_profile_id
+);
+CREATE INDEX idx_group_events_availabilities_group_event_id ON group_events_availabilities(
+  group_event_id
+);
+CREATE INDEX idx_group_events_availabilities_available_at_group_member_id ON group_events_availabilities(
+  available_at_group_member_id
+);
+CREATE INDEX idx_group_events_errors_group_event_id ON group_events_errors(
+  group_event_id
+);
+CREATE INDEX idx_group_events_errors_referred_group_event_id ON group_events_errors(
+  referred_group_event_id
+);
+CREATE INDEX idx_group_events_errors_referred_group_member_id ON group_events_errors(
+  referred_group_member_id
+);
+CREATE INDEX idx_group_events_confirmations_group_event_id ON group_events_confirmations(
+  group_event_id
+);
+CREATE INDEX idx_group_events_confirmations_confirming_group_event_id ON group_events_confirmations(
+  confirming_group_event_id
+);
+CREATE INDEX idx_group_events_confirmations_confirmed_by_group_member_id ON group_events_confirmations(
+  confirmed_by_group_member_id
+);
+CREATE INDEX idx_group_events_parents_group_event_parent_id ON group_events_parents(
+  group_event_parent_id
+);
+CREATE INDEX idx_group_events_parents_group_event_child_id ON group_events_parents(
+  group_event_child_id
+);

src/Simplex/Chat/Protocol.hs

@@ -124,12 +124,31 @@ data AppMessage (e :: MsgEncoding) where
 -- chat message is sent as JSON with these properties
 data AppMessageJson = AppMessageJson
   { v :: Maybe ChatVersionRange,
-    msgId :: Maybe SharedMsgId,
+    msgId :: Maybe SharedMsgId, -- maybe it's time we make it required? Or we can make it required inside `dag`
     event :: Text,
-    params :: J.Object
+    params :: J.Object,
+    groupEvent :: Maybe JsonGroupEvent
   }
   deriving (Generic, FromJSON)
 
+data JsonGroupEvent = JsonGroupEvent
+  { sharedHash :: Text, -- this hash must be computed from the shared part of the message that is sent to all members (e.g., including file hash but excluding file description)
+    parents :: [JsonGroupEventParent]
+  }
+  deriving (Generic, FromJSON, ToJSON)
+
+data JsonGroupEventParent = JsonGroupEventParent
+  { msgId :: SharedMsgId,
+    memberId :: MemberId,
+    displayName :: ContactName,
+    groupEvent :: JsonGroupEvent,
+    groupEventData :: JsonGroupEventData
+  }
+  deriving (Generic, FromJSON, ToJSON)
+
+data JsonGroupEventData = JGEData AppMessageJson | JGEAvailable | JGENothing
+  deriving (Generic, FromJSON, ToJSON)
+
 data AppMessageBinary = AppMessageBinary
   { msgId :: Maybe SharedMsgId,
     tag :: Char,
@@ -186,10 +205,29 @@ instance ToJSON MsgRef where
 data ChatMessage e = ChatMessage
   { chatVRange :: VersionRange,
     msgId :: Maybe SharedMsgId,
-    chatMsgEvent :: ChatMsgEvent e
+    chatMsgEvent :: ChatMsgEvent e,
+    groupEvent :: Maybe (GroupEvent e)
   }
   deriving (Eq, Show)
 
+data GroupEvent e = GroupEvent
+  { sharedHash :: Text, -- this hash must be computed from the shared part of the message that is sent to all members (e.g., including file hash but excluding file description)
+    parents :: [GroupEventParent e]
+  }
+  deriving (Eq, Show)
+
+data GroupEventParent e = GroupEventParent
+  { msgId :: SharedMsgId,
+    memberId :: MemberId,
+    displayName :: ContactName,
+    groupEvent :: GroupEvent e,
+    groupEventData :: GroupEventData e
+  }
+  deriving (Eq, Show)
+
+data GroupEventData e = GEData (ChatMessage e) | GEAvailable | GENothing
+  deriving (Eq, Show)
+
 data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e)
 
 instance MsgEncodingI e => StrEncoding (ChatMessage e) where
@@ -205,6 +243,51 @@ instance StrEncoding AChatMessage where
       '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
       _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
 
+sharedGroupMsgEvent :: ChatMsgEvent e -> Maybe (ChatMsgEvent e)
+sharedGroupMsgEvent ev = case ev of
+  XMsgNew _ -> Just ev -- TODO remove file description, include file hash
+  XMsgFileDescr {} -> Nothing
+  XMsgFileCancel _ -> Just ev
+  XMsgUpdate {} -> Just ev
+  XMsgDel {} -> Just ev
+  XMsgDeleted -> Nothing
+  XMsgReact {} -> Just ev
+  XFile _ -> Nothing
+  XFileAcpt _ -> Nothing
+  XFileAcptInv {} -> Nothing
+  XFileCancel _ -> Nothing
+  XInfo _ -> Just ev
+  XContact {} -> Just ev -- ?
+  XDirectDel -> Nothing
+  XGrpInv _ -> Nothing
+  XGrpAcpt _ -> Nothing
+  XGrpLinkInv _ -> Nothing
+  XGrpLinkMem _ -> Nothing
+  XGrpMemNew _ -> Just ev
+  XGrpMemIntro _ -> Nothing
+  XGrpMemInv {} -> Nothing
+  XGrpMemFwd {} -> Nothing
+  XGrpMemInfo {} -> Nothing
+  XGrpMemRole {} -> Just ev
+  XGrpMemCon _ -> Nothing -- TODO not implemented
+  XGrpMemConAll _ -> Nothing -- TODO not implemented
+  XGrpMemDel _ -> Just ev
+  XGrpLeave -> Just ev
+  XGrpDel -> Just ev
+  XGrpInfo _ -> Just ev
+  XGrpDirectInv {} -> Nothing
+  XInfoProbe _ -> Nothing
+  XInfoProbeCheck _ -> Nothing
+  XInfoProbeOk _ -> Nothing
+  XCallInv {} -> Nothing
+  XCallOffer {} -> Nothing
+  XCallAnswer {} -> Nothing
+  XCallExtra {} -> Nothing
+  XCallEnd _ -> Nothing
+  XOk -> Nothing
+  XUnknown {} -> Nothing
+  BFileChunk {} -> Nothing
+
 data ChatMsgEvent (e :: MsgEncoding) where
   XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
   XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
@@ -775,7 +858,7 @@ appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
 appBinaryToCM AppMessageBinary {msgId, tag, body} = do
   eventTag <- strDecode $ B.singleton tag
   chatMsgEvent <- parseAll (msg eventTag) body
-  pure ChatMessage {chatVRange = chatInitialVRange, msgId, chatMsgEvent}
+  pure ChatMessage {chatVRange = chatInitialVRange, msgId, chatMsgEvent, groupEvent = Nothing}
   where
     msg :: CMEventTag 'Binary -> A.Parser (ChatMsgEvent 'Binary)
     msg = \case
@@ -785,7 +868,7 @@ appJsonToCM :: AppMessageJson -> Either String (ChatMessage 'Json)
 appJsonToCM AppMessageJson {v, msgId, event, params} = do
   eventTag <- strDecode $ encodeUtf8 event
   chatMsgEvent <- msg eventTag
-  pure ChatMessage {chatVRange = maybe chatInitialVRange fromChatVRange v, msgId, chatMsgEvent}
+  pure ChatMessage {chatVRange = maybe chatInitialVRange fromChatVRange v, msgId, chatMsgEvent, groupEvent = Nothing}
   where
     p :: FromJSON a => J.Key -> Either String a
     p key = JT.parseEither (.: key) params
@@ -843,7 +926,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
   SBinary ->
     let (binaryMsgId, body) = toBody chatMsgEvent
      in AMBinary AppMessageBinary {msgId = binaryMsgId, tag = B.head $ strEncode tag, body}
-  SJson -> AMJson AppMessageJson {v = Just $ ChatVersionRange chatVRange, msgId, event = textEncode tag, params = params chatMsgEvent}
+  SJson -> AMJson AppMessageJson {v = Just $ ChatVersionRange chatVRange, msgId, event = textEncode tag, params = params chatMsgEvent, groupEvent = Nothing}
   where
     tag = toCMEventTag chatMsgEvent
     o :: [(J.Key, J.Value)] -> J.Object

src/Simplex/Chat/Store/Migrations.hs

@@ -87,6 +87,7 @@ import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
 import Simplex.Chat.Migrations.M20231010_member_settings
 import Simplex.Chat.Migrations.M20231019_indexes
 import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
+import Simplex.Chat.Migrations.M20231101_group_events
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -173,7 +174,8 @@ schemaMigrations =
     ("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash),
     ("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings),
     ("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes),
-    ("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received)
+    ("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received),
+    ("20231101_group_events", m20231101_group_events, Just down_m20231101_group_events)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Types.hs

@@ -710,14 +710,14 @@ instance ToJSON GroupMember where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
-data GroupMemberRef = GroupMemberRef {groupMemberId :: Int64, profile :: Profile}
+data GroupMemberRef = GroupMemberRef {groupMemberId :: Int64, role :: GroupMemberRole, profile :: Profile}
   deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON GroupMemberRef where toEncoding = J.genericToEncoding J.defaultOptions
 
 groupMemberRef :: GroupMember -> GroupMemberRef
-groupMemberRef GroupMember {groupMemberId, memberProfile = p} =
+groupMemberRef GroupMember {groupMemberId, memberRole, memberProfile = p} =
-  GroupMemberRef {groupMemberId, profile = fromLocalProfile p}
+  GroupMemberRef {groupMemberId, role = memberRole, profile = fromLocalProfile p}
 
 memberConn :: GroupMember -> Maybe Connection
 memberConn GroupMember{activeConn} = activeConn
@@ -791,6 +791,8 @@ fromInvitedBy userCtId = \case
   IBContact ctId -> Just ctId
   IBUser -> Just userCtId
 
+-- add:
+-- | GRUnknown -- used for unconfirmed members (learnt through group event parent)
 data GroupMemberRole
   = GRObserver -- connects to all group members and receives all messages, can't send messages
   | GRAuthor -- reserved, unused
@@ -897,6 +899,8 @@ instance TextEncoding GroupMemberCategory where
     GCPreMember -> "pre"
     GCPostMember -> "post"
 
+-- add:
+-- | GSMemUnconfirmed -- used for unconfirmed members (learnt through group event parent)
 data GroupMemberStatus
   = GSMemRemoved -- member who was removed from the group
   | GSMemLeft -- member who left the group

tests/ProtocolTests.hs

@@ -76,10 +76,10 @@ s ##==## msg = do
   s ==## msg
 
 (==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
-s ==# msg = s ==## ChatMessage chatInitialVRange Nothing msg
+s ==# msg = s ==## ChatMessage chatInitialVRange Nothing msg Nothing
 
 (#==) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
-s #== msg = s ##== ChatMessage chatInitialVRange Nothing msg
+s #== msg = s ##== ChatMessage chatInitialVRange Nothing msg Nothing
 
 (#==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
 s #==# msg = do
@@ -120,37 +120,40 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
       #==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing))
   it "x.msg.new chat message" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
-      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
+      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) Nothing
   it "x.msg.new chat message with chat version range" $
     "{\"v\":\"1-3\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
-      ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
+      ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) Nothing
   it "x.msg.new quote" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}"
       ##==## ChatMessage
         chatInitialVRange
         (Just $ SharedMsgId "\1\2\3\4")
         (XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing)))
+        Nothing
   it "x.msg.new quote - timed message TTL" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"ttl\":3600}}"
       ##==## ChatMessage
         chatInitialVRange
         (Just $ SharedMsgId "\1\2\3\4")
         (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing (Just 3600) Nothing)))
+        Nothing
   it "x.msg.new quote - live message" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"live\":true}}"
       ##==## ChatMessage
         chatInitialVRange
         (Just $ SharedMsgId "\1\2\3\4")
         (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing Nothing (Just True))))
+        Nothing
   it "x.msg.new forward" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}"
-      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing))
+      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing)) Nothing
   it "x.msg.new forward - timed message TTL" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"ttl\":3600}}"
-      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing))
+      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) Nothing
   it "x.msg.new forward - live message" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"live\":true}}"
-      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True)))
+      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) Nothing
   it "x.msg.new simple text with file" $
     "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
       #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})))
@@ -171,9 +174,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
                 )
             )
         )
+        Nothing
   it "x.msg.new forward with file" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
-      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})))
+      ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) Nothing
   it "x.msg.update" $
     "{\"v\":\"1\",\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
       #==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") Nothing Nothing