From c2e1ef09d60f62155e8a33753c94e2c7d88aff2a Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 17 Jul 2025 13:52:20 +0400 Subject: [PATCH] core: create banner item --- src/Simplex/Chat/Library/Commands.hs | 8 +++++++- src/Simplex/Chat/Library/Internal.hs | 6 +++++- src/Simplex/Chat/Library/Subscriber.hs | 12 +++++++++--- src/Simplex/Chat/Messages/CIContent.hs | 9 +++++++++ src/Simplex/Chat/Store/Groups.hs | 14 +++++++------- 5 files changed, 37 insertions(+), 12 deletions(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 328b59769f..388c384b99 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1766,6 +1766,7 @@ processChatCommand vr nm = \case groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences groupProfile = businessGroupProfile profile groupPreferences (gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user groupProfile True ccLink welcomeSharedMsgId + createInternalChatItem user (CDGroupSnd gInfo Nothing) CIChatBanner (Just epochStart) let cd = CDGroupRcv gInfo Nothing hostMember createItem sharedMsgId content = createChatItem user cd True content sharedMsgId Nothing cInfo = GroupChat gInfo Nothing @@ -1777,7 +1778,9 @@ processChatCommand vr nm = \case pure $ CRNewPreparedChat user $ AChat SCTGroup chat ACCL _ (CCLink cReq _) -> do ct <- withStore $ \db -> createPreparedContact db user profile accLink welcomeSharedMsgId - let createItem sharedMsgId content = createChatItem user (CDDirectRcv ct) False content sharedMsgId Nothing + createInternalChatItem user (CDDirectSnd ct) CIChatBanner (Just epochStart) + let cd = CDDirectRcv ct + createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing cInfo = DirectChat ct void $ createItem Nothing $ CIRcvDirectE2EEInfo $ E2EInfo $ connRequestPQEncryption cReq void $ createFeatureEnabledItems_ user ct @@ -1790,6 +1793,7 @@ processChatCommand vr nm = \case let GroupShortLinkData {groupProfile = gp@GroupProfile {description}} = groupSLinkData welcomeSharedMsgId <- forM description $ \_ -> getSharedMsgId (gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user gp False ccLink welcomeSharedMsgId + createInternalChatItem user (CDGroupSnd gInfo Nothing) CIChatBanner (Just epochStart) let cd = CDGroupRcv gInfo Nothing hostMember cInfo = GroupChat gInfo Nothing void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo @@ -2111,6 +2115,7 @@ processChatCommand vr nm = \case incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing gInfo <- withFastStore $ \db -> createNewGroup db vr gVar user gProfile incognitoProfile let cd = CDGroupSnd gInfo Nothing + createInternalChatItem user cd CIChatBanner (Just epochStart) createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = Just PQEncOff}) Nothing createGroupFeatureItems user cd CISndGroupFeature gInfo pure $ CRGroupCreated user gInfo @@ -2565,6 +2570,7 @@ processChatCommand vr nm = \case (connId, (CCLink cReq _, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId user) True SCMInvitation Nothing Nothing IKPQOff subMode -- [incognito] reuse membership incognito profile ct <- withFastStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode + createInternalChatItem user (CDDirectSnd ct) CIChatBanner (Just epochStart) -- TODO not sure it is correct to set connections status here? lift $ setContactNetworkStatus ct NSConnected pure $ CRNewMemberContact user ct g m diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 6d6cf33b96..b38c1ebbf3 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -48,7 +48,8 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Time (addUTCTime) -import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds) +import Data.Time.Calendar (fromGregorian) +import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds, secondsToDiffTime) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Files @@ -2529,3 +2530,6 @@ timeItToView s action = do let diff = diffToMilliseconds $ diffUTCTime t2 t1 toView' $ CEvtTimedAction s diff pure a + +epochStart :: UTCTime +epochStart = UTCTime (fromGregorian 1970 1 1) (secondsToDiffTime 0) diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 6a6f406a75..123eec6e4b 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -1337,6 +1337,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- they will be updated after connection is accepted. upsertDirectRequestItem cd (requestMsg_, prevSharedMsgId_) Nothing -> do + createInternalChatItem user (CDDirectSnd ct) CIChatBanner (Just epochStart) let e2eContent = CIRcvDirectE2EEInfo $ E2EInfo $ Just $ CR.pqSupportToEnc $ reqPQSup void $ createChatItem user cd False e2eContent Nothing Nothing void $ createFeatureEnabledItems_ user ct @@ -2248,7 +2249,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile - (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership}, hostId) <- withStore $ \db -> createGroupInvitation db vr user ct inv customUserProfileId + (gInfo, hostMember) <- withStore $ \db -> createGroupInvitation db vr user ct inv customUserProfileId + let GroupInfo {groupId, localDisplayName, groupProfile, membership} = gInfo + GroupMember {groupMemberId = hostGMId} = hostMember + createInternalChatItem user (CDGroupSnd gInfo Nothing) CIChatBanner (Just epochStart) let GroupMember {groupMemberId, memberId = membershipMemId} = membership if sameGroupLinkId groupLinkId groupLinkId' then do @@ -2257,8 +2261,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = connIds <- joinAgentConnectionAsync user True connRequest dm subMode withStore' $ \db -> do setViaGroupLinkHash db groupId connId - createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode - updateGroupMemberStatusById db userId hostId GSMemAccepted + createMemberConnectionAsync db user hostGMId connIds connChatVersion peerChatVRange subMode + updateGroupMemberStatusById db userId hostGMId GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted toView $ CEvtUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) else do @@ -2710,6 +2714,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case chatMsgEvent of XInfo p -> do ct <- withStore $ \db -> createDirectContact db user conn' p + -- TODO create banner toView $ CEvtContactConnecting user ct pure (conn', False) XGrpLinkInv glInv -> do @@ -3089,6 +3094,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = dm <- encodeConnInfo $ XInfo p joinAgentConnectionAsync user True connReq dm subMode createItems mCt' m' = do + createInternalChatItem user (CDDirectSnd mCt') CIChatBanner (Just epochStart) (g', m'', scopeInfo) <- mkGroupChatScope g m' createInternalChatItem user (CDGroupRcv g' scopeInfo m'') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing toView $ CEvtNewMemberContactReceivedInv user mCt' g' m'' diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index e0bff73e0c..a52133110a 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -165,6 +165,7 @@ data CIContent (d :: MsgDirection) where CIRcvDirectE2EEInfo :: E2EInfo -> CIContent 'MDRcv CISndGroupE2EEInfo :: E2EInfo -> CIContent 'MDSnd -- when new group is created CIRcvGroupE2EEInfo :: E2EInfo -> CIContent 'MDRcv -- when enabled with some member + CIChatBanner :: CIContent 'MDSnd CIInvalidJSON :: Text -> CIContent d -- this is also used for logical database errors, e.g. SEBadChatItem -- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API @@ -292,6 +293,7 @@ ciContentToText = \case CIRcvDirectE2EEInfo e2eeInfo -> directE2EInfoToText e2eeInfo CISndGroupE2EEInfo e2eeInfo -> groupE2EInfoToText e2eeInfo CIRcvGroupE2EEInfo e2eeInfo -> groupE2EInfoToText e2eeInfo + CIChatBanner -> "chat banner" CIInvalidJSON _ -> "invalid content JSON" directE2EInfoToText :: E2EInfo -> Text @@ -471,6 +473,7 @@ data JSONCIContent | JCIRcvDirectE2EEInfo {e2eeInfo :: E2EInfo} | JCISndGroupE2EEInfo {e2eeInfo :: E2EInfo} | JCIRcvGroupE2EEInfo {e2eeInfo :: E2EInfo} + | JCIChatBanner | JCIInvalidJSON {direction :: MsgDirection, json :: Text} jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent @@ -505,6 +508,7 @@ jsonCIContent = \case CIRcvDirectE2EEInfo e2eeInfo -> JCIRcvDirectE2EEInfo e2eeInfo CISndGroupE2EEInfo e2eeInfo -> JCISndGroupE2EEInfo e2eeInfo CIRcvGroupE2EEInfo e2eeInfo -> JCIRcvGroupE2EEInfo e2eeInfo + CIChatBanner -> JCIChatBanner CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json aciContentJSON :: JSONCIContent -> ACIContent @@ -539,6 +543,7 @@ aciContentJSON = \case JCIRcvDirectE2EEInfo {e2eeInfo} -> ACIContent SMDRcv $ CIRcvDirectE2EEInfo e2eeInfo JCISndGroupE2EEInfo {e2eeInfo} -> ACIContent SMDSnd $ CISndGroupE2EEInfo e2eeInfo JCIRcvGroupE2EEInfo {e2eeInfo} -> ACIContent SMDRcv $ CIRcvGroupE2EEInfo e2eeInfo + JCIChatBanner -> ACIContent SMDSnd CIChatBanner JCIInvalidJSON dir json -> case fromMsgDirection dir of AMsgDirection d -> ACIContent d $ CIInvalidJSON json @@ -574,6 +579,7 @@ data DBJSONCIContent | DBJCIRcvDirectE2EEInfo {e2eeInfo :: E2EInfo} | DBJCISndGroupE2EEInfo {e2eeInfo :: E2EInfo} | DBJCIRcvGroupE2EEInfo {e2eeInfo :: E2EInfo} + | DBJCIChatBanner | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text} dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent @@ -608,6 +614,7 @@ dbJsonCIContent = \case CIRcvDirectE2EEInfo e2eeInfo -> DBJCIRcvDirectE2EEInfo e2eeInfo CISndGroupE2EEInfo e2eeInfo -> DBJCISndGroupE2EEInfo e2eeInfo CIRcvGroupE2EEInfo e2eeInfo -> DBJCIRcvGroupE2EEInfo e2eeInfo + CIChatBanner -> DBJCIChatBanner CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json aciContentDBJSON :: DBJSONCIContent -> ACIContent @@ -642,6 +649,7 @@ aciContentDBJSON = \case DBJCIRcvDirectE2EEInfo e2eeInfo -> ACIContent SMDRcv $ CIRcvDirectE2EEInfo e2eeInfo DBJCISndGroupE2EEInfo e2eeInfo -> ACIContent SMDSnd $ CISndGroupE2EEInfo e2eeInfo DBJCIRcvGroupE2EEInfo e2eeInfo -> ACIContent SMDRcv $ CIRcvGroupE2EEInfo e2eeInfo + DBJCIChatBanner -> ACIContent SMDSnd CIChatBanner DBJCIInvalidJSON dir json -> case fromMsgDirection dir of AMsgDirection d -> ACIContent d $ CIInvalidJSON json @@ -749,4 +757,5 @@ toCIContentTag ciContent = case ciContent of CIRcvDirectE2EEInfo _ -> "rcvDirectE2EEInfo" CISndGroupE2EEInfo _ -> "sndGroupE2EEInfo" CIRcvGroupE2EEInfo _ -> "rcvGroupE2EEInfo" + CIChatBanner -> "chatBanner" CIInvalidJSON _ -> "invalidJSON" diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 8a4c5461b6..ab6a123ede 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -370,14 +370,14 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc } -- | creates a new group record for the group the current user was invited to, or returns an existing one -createGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) +createGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMember) createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just Connection {peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile, business} incognitoProfileId = do liftIO getInvitationGroupId_ >>= \case Nothing -> createGroupInvitation_ Just gId -> do gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db vr user gId - hostId <- getHostMemberId_ db user gId + hostMember <- getHostMember db vr user gId let GroupMember {groupMemberId, memberId, memberRole} = membership MemberIdRole {memberId = invMemberId, memberRole = memberRole'} = invitedMember liftIO . when (memberId /= invMemberId || memberRole /= memberRole') $ @@ -386,13 +386,13 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ if p' == groupProfile then pure gInfo else updateGroupProfile db user gInfo groupProfile - pure (gInfo', hostId) + pure (gInfo', hostMember) where getInvitationGroupId_ :: IO (Maybe Int64) getInvitationGroupId_ = maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1" (connRequest, userId) - createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMemberId) + createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMember) createGroupInvitation_ = do let GroupProfile {displayName, fullName, shortDescr, description, image, groupPreferences, memberAdmission} = groupProfile fullGroupPreferences = mergeGroupPreferences groupPreferences @@ -416,8 +416,8 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ ((profileId, localDisplayName, connRequest, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business) insertedRowId db let hostVRange = adjustedMemberVRange vr peerChatVRange - GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange - membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr + hostMember@GroupMember {groupMemberId = hostGMId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange + membership <- createContactMemberInv_ db user groupId (Just hostGMId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} pure ( GroupInfo @@ -440,7 +440,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ customData = Nothing, membersRequireAttention = 0 }, - groupMemberId + hostMember ) businessChatInfoRow :: Maybe BusinessChatInfo -> BusinessChatInfoRow