From e1a80994743da3dd7f1b32c02147b97b7090bdc8 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 20 Nov 2023 00:06:45 +0000 Subject: [PATCH] fix for GHC 8.10.7 --- src/Simplex/Chat.hs | 24 ++++++++++++------------ src/Simplex/Chat/Store/Groups.hs | 2 +- src/Simplex/Chat/View.hs | 2 +- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 58495727a..68b73fccb 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3529,19 +3529,19 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do forM_ (invitedByGroupMemberId membership) $ \hostId -> do host <- withStore $ \db -> getGroupMember db user groupId hostId forM_ (memberConn host) $ \hostConn -> - void $ sendDirectMessage hostConn (XGrpMemCon m.memberId) (GroupId groupId) + void $ sendDirectMessage hostConn (XGrpMemCon $ memberId (m :: GroupMember)) (GroupId groupId) GCPostMember -> forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do im <- withStore $ \db -> getGroupMember db user groupId invitingMemberId forM_ (memberConn im) $ \imConn -> - void $ sendDirectMessage imConn (XGrpMemCon m.memberId) (GroupId groupId) + void $ sendDirectMessage imConn (XGrpMemCon $ memberId (m :: GroupMember)) (GroupId groupId) _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected" MSG msgMeta _msgFlags msgBody -> do cmdId <- createAckCmd conn tryChatError (processChatMessage cmdId) >>= \case Right (ACMsg _ chatMsg, withRcpt) -> do ackMsg agentConnId cmdId msgMeta $ if withRcpt then Just "" else Nothing - when (membership.memberRole >= GRAdmin) $ forwardMsg_ chatMsg + when (memberRole (membership :: GroupMember) >= GRAdmin) $ forwardMsg_ chatMsg Left e -> ackMsg agentConnId cmdId msgMeta Nothing >> throwError e where processChatMessage :: Int64 -> m (AChatMessage, Bool) @@ -3619,7 +3619,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- invited members to which this member was introduced invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db user m highlyAvailable let ms = introducedMembers <> invitedMembers - msg = XGrpMsgForward m.memberId chatMsg' brokerTs + msg = XGrpMsgForward (memberId (m :: GroupMember)) chatMsg' brokerTs unless (null ms) $ void $ sendGroupMessage user gInfo ms msg RCVD msgMeta msgRcpt -> @@ -5135,8 +5135,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> m () - xGrpMsgForward gInfo@GroupInfo {groupId} m memberId msg msgTs = do - when (m.memberRole < GRAdmin) $ throwChatError (CEGroupContactRole m.localDisplayName) + xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId msg msgTs = do + when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole localDisplayName) author <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memberId processForwardedMsg author msg where @@ -5502,7 +5502,7 @@ sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do forwardSupported = do let mcvr = memberChatVRange' m isCompatibleRange mcvr groupForwardVRange && invitingMemberSupportsForward - invitingMemberSupportsForward = case m.invitedByGroupMemberId of + invitingMemberSupportsForward = case invitedByGroupMemberId m of Just invMemberId -> -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember case find (\m' -> groupMemberId' m' == invMemberId) members of @@ -5547,13 +5547,13 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta let agentMsgId = fst $ recipient agentMsgMeta newMsg = NewMessage {chatMsgEvent, msgBody} rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} - amId = Just am'.groupMemberId + amId = Just $ groupMemberId' am' msg <- withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery amId) `catchChatError` \e -> case e of ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do fm <- withStore $ \db -> getGroupMember db user groupId forwardedByGroupMemberId forM_ (memberConn fm) $ \fmConn -> - void $ sendDirectMessage fmConn (XGrpMemCon am'.memberId) (GroupId groupId) + void $ sendDirectMessage fmConn (XGrpMemCon $ memberId (am' :: GroupMember)) (GroupId groupId) throwError e _ -> throwError e pure (am', conn', msg) @@ -5567,9 +5567,9 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember msgBody ChatMes `catchChatError` \e -> case e of ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do am <- withStore $ \db -> getGroupMember db user groupId authorGroupMemberId - if sameMemberId refAuthorMember.memberId am + if sameMemberId (memberId (refAuthorMember :: GroupMember)) am then forM_ (memberConn forwardingMember) $ \fmConn -> - void $ sendDirectMessage fmConn (XGrpMemCon am.memberId) (GroupId groupId) + void $ sendDirectMessage fmConn (XGrpMemCon $ memberId (am :: GroupMember)) (GroupId groupId) else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id" throwError e _ -> throwError e @@ -5599,7 +5599,7 @@ saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content ciFile itemTimed live (ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt pure (ciId, quotedItem) - liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs msg.forwardedByGroupMemberId createdAt + liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs (forwardedByGroupMemberId (msg :: RcvMessage)) createdAt mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> IO (ChatItem c d) mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs forwardedByGroupMemberId currentTs = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 6361f7a6f..d71ea80c8 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -354,7 +354,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)" (profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs) insertedRowId db - let JVersionRange hostVRange = hostConn.peerChatVRange + let JVersionRange hostVRange = peerChatVRange hostConn 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 supportedChatVRange let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 7918d68ff..03c8d86c7 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -488,7 +488,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of Nothing -> item Just t -> item <> styled (colored Red) (" [" <> t <> "]") - withGroupMsgForwarded item = case meta.forwardedByGroupMemberId of + withGroupMsgForwarded item = case forwardedByGroupMemberId (meta :: CIMeta c d) of Nothing -> item Just _ -> item <> styled (colored Yellow) (" [>>]" :: String) withSndFile = withFile viewSentFileInvitation