From 0470f9cf3621c66a89c5c872c1662d2aecf2cfc2 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 25 Apr 2022 09:17:12 +0100 Subject: [PATCH] core: batch contact disconnections and re-subscriptions to one event per server (#564) * core: batch contact disconnections and re-subscriptions to one event per server * update simplexmq * update query to use temp table * remove old code --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 18 ++++++++++-------- src/Simplex/Chat/Controller.hs | 4 ++-- src/Simplex/Chat/Store.hs | 23 +++++++++++++++++++++++ src/Simplex/Chat/Types.hs | 8 ++++++++ src/Simplex/Chat/View.hs | 8 ++++++-- stack.yaml | 2 +- 8 files changed, 52 insertions(+), 15 deletions(-) diff --git a/cabal.project b/cabal.project index 5617a6ab4f..f8d20085ae 100644 --- a/cabal.project +++ b/cabal.project @@ -3,7 +3,7 @@ packages: . source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 633cd675b5cd9476dc9624512d552f3851fab34c + tag: c6dde772b459a2d8f392ad5455d6f8fd6f16e867 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index a9a3364278..ff3b87c194 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."633cd675b5cd9476dc9624512d552f3851fab34c" = "0kpljb1ys7ym2lzq7xm56z6hfzkkq6j6z2b7zh5z87jr8zyxfhvk"; + "https://github.com/simplex-chat/simplexmq.git"."c6dde772b459a2d8f392ad5455d6f8fd6f16e867" = "08crpg2jnpvj08cl372znbhf3n0frm8ldbl2bwva0f0jq5j364nk"; "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp"; "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj"; "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index fefff17157..a40773e9ff 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -836,7 +836,7 @@ subscribeUserConnections user@User {userId} = do contacts <- withStore (`getUserContacts` user) toView . CRContactSubSummary =<< pooledForConcurrentlyN n contacts (\ct -> ContactSubStatus ct <$> subscribeContact ce ct) subscribeContact ce ct = - (subscribe (contactConnId ct) >> when ce (toView $ CRContactSubscribed ct) $> Nothing) + (subscribe (contactConnId ct) $> Nothing) `catchError` (\e -> when ce (toView $ CRContactSubError ct e) $> Just e) subscribeGroups n ce = do groups <- withStore (`getUserGroups` user) @@ -898,6 +898,15 @@ subscribeUserConnections user@User {userId} = do processAgentMessage :: forall m. ChatMonad m => Maybe User -> ConnId -> ACommand 'Agent -> m () processAgentMessage Nothing _ _ = throwChatError CENoActiveUser +processAgentMessage (Just User {userId}) "" agentMessage = case agentMessage of + DOWN srv conns -> serverEvent srv conns CRContactsDisconnected "disconnected" + UP srv conns -> serverEvent srv conns CRContactsSubscribed "connected" + _ -> pure () + where + serverEvent srv@SMP.ProtocolServer {host, port} conns event str = do + cs <- withStore $ \st -> getConnectionsContacts st userId conns + toView $ event srv cs + showToast ("server " <> str) (safeDecodeUtf8 . strEncode $ SrvLoc host port) processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage = (withStore (\st -> getConnectionEntity st user agentConnId) >>= updateConnStatus) >>= \case RcvDirectMsgConnection conn contact_ -> @@ -1011,13 +1020,6 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage toView $ CRContactAnotherClient ct showToast (c <> "> ") "connected to another client" unsetActive $ ActiveC c - DOWN -> do - toView $ CRContactDisconnected ct - showToast (c <> "> ") "disconnected" - UP -> do - toView $ CRContactSubscribed ct - showToast (c <> "> ") "is active" - setActive $ ActiveC c -- TODO print errors MERR msgId err -> do chatItemId_ <- withStore $ \st -> getChatItemIdByAgentMsgId st connId msgId diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 9d08c72bd3..7adf8e2182 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -221,8 +221,8 @@ data ChatResponse | CRContactConnecting {contact :: Contact} | CRContactConnected {contact :: Contact} | CRContactAnotherClient {contact :: Contact} - | CRContactDisconnected {contact :: Contact} - | CRContactSubscribed {contact :: Contact} + | CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]} + | CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]} | CRContactSubError {contact :: Contact, chatError :: ChatError} | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]} | CRGroupInvitation {groupInfo :: GroupInfo} diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 0041312313..257fde2257 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -53,6 +53,7 @@ module Simplex.Chat.Store getPendingConnections, getContactConnections, getConnectionEntity, + getConnectionsContacts, getGroupAndMember, updateConnectionStatus, createNewGroup, @@ -1193,6 +1194,28 @@ getConnectionEntity st User {userId, userContactId} agentConnId = userContact_ [Only cReq] = Right UserContact {userContactLinkId, connReqContact = cReq} userContact_ _ = Left SEUserContactLinkNotFound +getConnectionsContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> [ConnId] -> m [ContactRef] +getConnectionsContacts st userId agentConnIds = + liftIO . withTransaction st $ \db -> do + DB.execute_ db "DROP TABLE IF EXISTS temp.conn_ids" + DB.execute_ db "CREATE TABLE temp.conn_ids (conn_id BLOB)" + DB.executeMany db "INSERT INTO temp.conn_ids (conn_id) VALUES (?)" $ map Only agentConnIds + conns <- + map (uncurry ContactRef) + <$> DB.query + db + [sql| + SELECT ct.contact_id, ct.local_display_name + FROM contacts ct + JOIN connections c ON c.contact_id = ct.contact_id + WHERE ct.user_id = ? AND c.agent_conn_id IN (SELECT conn_id FROM temp.conn_ids) + AND c.conn_type = ? + AND (c.conn_status = ? OR c.conn_status = ?) + |] + (userId, ConnContact, ConnReady, ConnSndReady) + DB.execute_ db "DROP TABLE temp.conn_ids" + pure conns + getGroupAndMember :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (GroupInfo, GroupMember) getGroupAndMember st User {userId, userContactId} groupMemberId = liftIOEither . withTransaction st $ \db -> diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 9d8626e92d..e8f064c2d5 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -84,6 +84,14 @@ contactConn = activeConn contactConnId :: Contact -> ConnId contactConnId Contact {activeConn} = aConnId activeConn +data ContactRef = ContactRef + { contactId :: Int64, + localDisplayName :: ContactName + } + deriving (Eq, Show, Generic) + +instance ToJSON ContactRef where toEncoding = J.genericToEncoding J.defaultOptions + data UserContact = UserContact { userContactLinkId :: Int64, connReqContact :: ConnReqContact diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 7d4ed007d7..703bcf6b59 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -111,8 +111,8 @@ responseToView testView = \case CRContactConnecting _ -> [] CRContactConnected ct -> [ttyFullContact ct <> ": contact is connected"] CRContactAnotherClient c -> [ttyContact' c <> ": contact is connected to another client"] - CRContactDisconnected c -> [ttyContact' c <> ": disconnected from server (messages will be queued)"] - CRContactSubscribed c -> [ttyContact' c <> ": connected to server"] + CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> smpServer srv <> " (" <> contactList cs <> ")"] + CRContactsSubscribed srv cs -> [plain $ "server connected " <> smpServer srv <> " (" <> contactList cs <> ")"] CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e] CRContactSubSummary summary -> [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors" @@ -174,6 +174,10 @@ responseToView testView = \case _ -> Nothing viewErrorsSummary :: [a] -> StyledString -> [StyledString] viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)] + smpServer :: SMPServer -> String + smpServer SMP.ProtocolServer {host, port} = B.unpack . strEncode $ SrvLoc host port + contactList :: [ContactRef] -> String + contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString] viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case chat of diff --git a/stack.yaml b/stack.yaml index f5ac78d328..715e40f2cf 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 633cd675b5cd9476dc9624512d552f3851fab34c + commit: c6dde772b459a2d8f392ad5455d6f8fd6f16e867 # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977 - github: simplex-chat/aeson commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7