core: group integrity status types (#3302)

2023-11-02 20:07:14 +04:00 · 2023-11-02 20:07:14 +04:00 · 212f193a4c
commit 212f193a4c
parent 7473da36a6
5 changed files with 148 additions and 49 deletions
--- a/src/Simplex/Chat/Messages.hs
+++ b/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,8 +342,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
    itemTimed :: Maybe CITimed,
    itemLive :: Maybe Bool,
    editable :: Bool,
-    -- receivedFromAuthor :: Bool,
-    -- groupDagError :: [GroupEventIntegrityError],
+    groupIntegrityStatus :: GroupIntegrityStatus,
    createdAt :: UTCTime,
    updatedAt :: UTCTime
  }
@ -353,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
--- a/src/Simplex/Chat/Messages/Events.hs
+++ b/src/Simplex/Chat/Messages/Events.hs
@ -1,21 +1,26 @@
 {-# 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,
-    dagErrors :: [GroupEventIntegrityError],
+    integrityErrors :: [GroupEventIntegrityError],
+    integrityConfirmations :: [GroupEventIntegrityConfirmation],
    sharedHash :: ByteString,
    eventDir :: GEDirection d,
    parents :: [AStoredGroupEvent]
@ -23,10 +28,25 @@ data StoredGroupEvent d = StoredGroupEvent

 data AStoredGroupEvent = forall d. MsgDirectionI d => AStoredGroupEvent (StoredGroupEvent d)

-data GroupEventIntegrityError
-  = GEErrInvalidHash
-  | GEErrMissingParent SharedMsgId
-  | GEErrParentHashMismatch SharedMsgId
+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
@ -37,17 +57,24 @@ data StoredGroupEventData = SGEData (ChatMsgEvent 'Json) | SGEAvailable [GroupMe
 data ReceivedEventInfo = ReceivedEventInfo
  { authorMemberId :: MemberId,
    authorMemberName :: ContactName,
-    authorMember :: Maybe GroupMemberRef,
+    authorMember :: GroupMemberRef,
    receivedFrom :: GroupMemberRef,
    processing :: EventProcessing
  }

 data ReceivedFromRole = RFAuthor | RFSufficientPrivilege | RFLower

-receviedFromRole :: ReceivedEventInfo -> ReceivedFromRole
-receviedFromRole = undefined
+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)
--- a/src/Simplex/Chat/Migrations/M20231101_group_events.hs
+++ b/src/Simplex/Chat/Migrations/M20231101_group_events.hs
@ -18,24 +18,27 @@ CREATE TABLE group_events (
  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
-  rcvd_author_member_id BLOB,                   -- ReceivedEventInfo authorMemberId :: MemberId
-  rcvd_author_member_name TEXT,                 -- ReceivedEventInfo authorMemberName :: ContactName
-  -- ReceivedEventInfo authorMember :: Maybe GroupMemberRef; can be null even for received event
-  rcvd_author_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
-  rcvd_author_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
-  -- rcvd_author_role TEXT NOT NULL,            -- ReceivedFromRole - store in case it changes?
-  -- ReceivedEventInfo receivedFrom :: GroupMemberRef
-  rcvd_from_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
-  rcvd_from_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
-  rcvd_processing TEXT NOT NULL,                -- ReceivedEventInfo processing :: EventProcessing
-  rcvd_processed INTEGER NOT NULL DEFAULT 0,    -- 1 for processed; when retrieving unprocessed
-  -- rcvd_scheduled_at TEXT,                    -- EPScheduled UTCTime; when retrieving scheduled at near time?
+  -- 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);
@ -52,15 +55,34 @@ CREATE TABLE group_events_availabilities (
 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_dag_errors (
+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,
-  dag_error TEXT NOT NULL,
+  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_dag_errors_group_event_id ON group_events_dag_errors(group_event_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 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,
@ -79,24 +101,28 @@ 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_dag_errors_group_event_id;
+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 TABLE group_events_dag_errors;
+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;
 |]
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@ -530,18 +530,20 @@ CREATE TABLE group_events(
  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
-  rcvd_author_member_id BLOB, -- ReceivedEventInfo authorMemberId :: MemberId
-  rcvd_author_member_name TEXT, -- ReceivedEventInfo authorMemberName :: ContactName
-  -- ReceivedEventInfo authorMember :: Maybe GroupMemberRef; can be null even for received event
-  rcvd_author_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
-  rcvd_author_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
-  -- rcvd_author_role TEXT NOT NULL, -- ReceivedFromRole - store in case it changes?
-  -- ReceivedEventInfo receivedFrom :: GroupMemberRef
-  rcvd_from_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
-  rcvd_from_contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
-  rcvd_processing TEXT NOT NULL, -- ReceivedEventInfo processing :: EventProcessing
-  rcvd_processed INTEGER NOT NULL DEFAULT 0, -- 1 for processed; when retrieving unprocessed
-  -- rcvd_scheduled_at TEXT, -- EPScheduled UTCTime; when retrieving scheduled at near time?
+  -- 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'))
 );
@ -552,10 +554,22 @@ CREATE TABLE group_events_availabilities(
  created_at TEXT NOT NULL DEFAULT(datetime('now')),
  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
-CREATE TABLE group_events_dag_errors(
+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,
-  dag_error TEXT NOT NULL,
+  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'))
 );
@ -796,6 +810,7 @@ CREATE INDEX idx_connections_via_contact_uri_hash ON connections(
 );
 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
 );
@ -814,9 +829,24 @@ CREATE INDEX idx_group_events_availabilities_group_event_id ON group_events_avai
 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_dag_errors_group_event_id ON group_events_dag_errors(
+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
 );
--- a/src/Simplex/Chat/Types.hs
+++ b/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 {groupMemberId, profile = fromLocalProfile p}
+groupMemberRef GroupMember {groupMemberId, memberRole, memberProfile = 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