IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

refactor closure (#177)

Browse Source
This commit is contained in:
Evgeny Poberezkin 2022-01-06 20:29:57 +00:00 committed by GitHub
parent 1bfa7f1104
commit 44845ad563
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 20 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Simplex/Chat.hs
View File

@ -253,29 +253,27 @@ processChatCommand user@User {userId, profile} = \case
AddMember gName cName memRole -> do AddMember gName cName memRole -> do
(group, contact) <- withStore $ \st -> (,) <$> getGroup st user gName <*> getContact st userId cName (group, contact) <- withStore $ \st -> (,) <$> getGroup st user gName <*> getContact st userId cName
let Group {groupId, groupProfile, membership, members} = group let Group {groupId, groupProfile, membership, members} = group
userRole = memberRole membership GroupMember {memberRole = userRole, memberId = userMemberId} = membership
userMemberId = memberId membership
when (userRole < GRAdmin || userRole < memRole) $ chatError CEGroupUserRole when (userRole < GRAdmin || userRole < memRole) $ chatError CEGroupUserRole
when (memberStatus membership == GSMemInvited) $ chatError (CEGroupNotJoined gName) when (memberStatus membership == GSMemInvited) $ chatError (CEGroupNotJoined gName)
unless (memberActive membership) $ chatError CEGroupMemberNotActive unless (memberActive membership) $ chatError CEGroupMemberNotActive
let sendInvitation memberId cReq = do
sendDirectMessage (contactConn contact) $
XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
showSentGroupInvitation gName cName
setActive $ ActiveG gName
case contactMember contact members of case contactMember contact members of
Nothing -> do Nothing -> do
gVar <- asks idsDrg gVar <- asks idsDrg
(agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation) (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
GroupMember {memberId} <- withStore $ \st -> createContactGroupMemberWithInvitation st gVar user groupId contact memRole agentConnId cReq GroupMember {memberId} <- withStore $ \st -> createContactMember st gVar user groupId contact memRole agentConnId cReq
sendInvitation contact userMemberId userRole memberId groupProfile cReq sendInvitation memberId cReq
Just GroupMember {groupMemberId, memberId, memberStatus} Just GroupMember {groupMemberId, memberId, memberStatus}
| memberStatus == GSMemInvited -> | memberStatus == GSMemInvited ->
withStore (\st -> getContactGroupMemberInvitation st user groupMemberId) >>= \case withStore (\st -> getMemberInvitation st user groupMemberId) >>= \case
Just cReq -> sendInvitation contact userMemberId userRole memberId groupProfile cReq Just cReq -> sendInvitation memberId cReq
Nothing -> showCannotResendInvitation gName cName Nothing -> showCannotResendInvitation gName cName
| otherwise -> chatError (CEGroupDuplicateMember cName) | otherwise -> chatError (CEGroupDuplicateMember cName)
where
sendInvitation contact userMemberId userRole memberId groupProfile cReq = do
let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
sendDirectMessage (contactConn contact) msg
showSentGroupInvitation gName cName
setActive $ ActiveG gName
JoinGroup gName -> do JoinGroup gName -> do
ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember

20
src/Simplex/Chat/Store.hs
View File

@ -51,8 +51,8 @@ module Simplex.Chat.Store
getUserGroups, getUserGroups,
getUserGroupDetails, getUserGroupDetails,
getGroupInvitation, getGroupInvitation,
createContactGroupMemberWithInvitation, createContactMember,
getContactGroupMemberInvitation, getMemberInvitation,
createMemberConnection, createMemberConnection,
updateGroupMemberStatus, updateGroupMemberStatus,
createNewGroupMember, createNewGroupMember,
@ -1031,16 +1031,16 @@ toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, membe
activeConn = Nothing activeConn = Nothing
in GroupMember {..} in GroupMember {..}
createContactGroupMemberWithInvitation :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> m GroupMember createContactMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> m GroupMember
createContactGroupMemberWithInvitation st gVar user groupId contact memberRole agentConnId connRequest = createContactMember st gVar user groupId contact memberRole agentConnId connRequest =
liftIOEither . withTransaction st $ \db -> liftIOEither . withTransaction st $ \db ->
createWithRandomId gVar $ \memId -> do createWithRandomId gVar $ \memId -> do
member@GroupMember {groupMemberId} <- createContactMemberWithInvitation_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest) member@GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest)
void $ createMemberConnection_ db (userId user) groupMemberId agentConnId Nothing 0 void $ createMemberConnection_ db (userId user) groupMemberId agentConnId Nothing 0
pure member pure member
getContactGroupMemberInvitation :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Maybe ConnReqInvitation) getMemberInvitation :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Maybe ConnReqInvitation)
getContactGroupMemberInvitation st User {userId} groupMemberId = getMemberInvitation st User {userId} groupMemberId =
liftIO . withTransaction st $ \db -> liftIO . withTransaction st $ \db ->
join . listToMaybe . map fromOnly join . listToMaybe . map fromOnly
<$> DB.query db "SELECT inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?;" (groupMemberId, userId) <$> DB.query db "SELECT inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?;" (groupMemberId, userId)
@ -1271,10 +1271,10 @@ createMemberConnection_ db userId groupMemberId = createConnection_ db userId Co
createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
createContactMember_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy = createContactMember_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy =
createContactMemberWithInvitation_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy Nothing createContactMemberInv_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy Nothing
createContactMemberWithInvitation_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
createContactMemberWithInvitation_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy connRequest = do createContactMemberInv_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy connRequest = do
insertMember_ insertMember_
groupMemberId <- insertedRowId db groupMemberId <- insertedRowId db
let memberProfile = profile' userOrContact let memberProfile = profile' userOrContact