From ab070962351cbfd1c373549bddee5ca8a358812d Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Fri, 24 May 2024 20:17:21 +0300 Subject: [PATCH] remove unused code --- src/Simplex/Chat.hs | 162 +++----------------------- src/Simplex/Chat/Store/Connections.hs | 18 +-- 2 files changed, 18 insertions(+), 162 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index f22a0aded2..6d10985e63 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3334,163 +3334,27 @@ subscribeUserConnections vr onlyNeeded user = do -- ce <- asks $ subscriptionEvents . config conns <- if onlyNeeded - then do - (conns, entities) <- withStore' (`getConnectionsToSubscribe` vr) - -- let (cts, ucs, ms, sfts, rfts, pcs) = foldl' addEntity (M.empty, M.empty, M.empty, M.empty, M.empty, M.empty) entities - pure conns + then withStore' getConnectionsToSubscribe else do withStore' unsetConnectionToSubscribe - (ctConns, cts) <- getContactConns - (ucConns, ucs) <- getUserContactLinkConns - (gs, mConns, ms) <- getGroupMemberConns - (sftConns, sfts) <- getSndFileTransferConns - (rftConns, rfts) <- getRcvFileTransferConns - (pcConns, pcs) <- getPendingContactConns + ctConns <- getContactConns + ucConns <- getUserContactLinkConns + mConns <- getGroupMemberConns + sftConns <- getSndFileTransferConns + rftConns <- getRcvFileTransferConns + pcConns <- getPendingContactConns pure $ concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns] -- subscribe using batched commands void $ withAgent (`Agent.subscribeConnections` conns) - -- -- send connection events to view - -- contactSubsToView rs cts ce - -- -- TODO possibly, we could either disable these events or replace with less noisy for API - -- contactLinkSubsToView rs ucs - -- groupSubsToView rs gs ms ce - -- sndFileSubsToView rs sfts - -- rcvFileSubsToView rs rfts - -- pendingConnSubsToView rs pcs where - -- addEntity (cts, ucs, ms, sfts, rfts, pcs) = \case - -- RcvDirectMsgConnection c (Just ct) -> let cts' = addConn c ct cts in (cts', ucs, ms, sfts, rfts, pcs) - -- RcvDirectMsgConnection c Nothing -> let pcs' = addConn c (toPCC c) pcs in (cts, ucs, ms, sfts, rfts, pcs') - -- RcvGroupMsgConnection c _g m -> let ms' = addConn c m ms in (cts, ucs, ms', sfts, rfts, pcs) - -- SndFileConnection c sft -> let sfts' = addConn c sft sfts in (cts, ucs, ms, sfts', rfts, pcs) - -- RcvFileConnection c rft -> let rfts' = addConn c rft rfts in (cts, ucs, ms, sfts, rfts', pcs) - -- UserContactConnection c uc -> let ucs' = addConn c uc ucs in (cts, ucs', ms, sfts, rfts, pcs) - -- addConn :: Connection -> a -> Map ConnId a -> Map ConnId a - -- addConn = M.insert . aConnId - -- toPCC Connection {connId, agentConnId, connStatus, viaUserContactLink, groupLinkId, customUserProfileId, localAlias, createdAt} = - -- PendingContactConnection - -- { pccConnId = connId, - -- pccAgentConnId = agentConnId, - -- pccConnStatus = connStatus, - -- viaContactUri = False, - -- viaUserContactLink, - -- groupLinkId, - -- customUserProfileId, - -- connReqInv = Nothing, - -- localAlias, - -- createdAt, - -- updatedAt = createdAt - -- } - getContactConns :: CM ([ConnId], Map ConnId Contact) - getContactConns = do - cts <- withStore_ (`getUserContacts` vr) - let cts' = mapMaybe (\ct -> (,ct) <$> contactConnId ct) $ filter contactActive cts - pure (map fst cts', M.fromList cts') - getUserContactLinkConns :: CM ([ConnId], Map ConnId UserContact) - getUserContactLinkConns = do - (cs, ucs) <- unzip <$> withStore_ (`getUserContactLinks` vr) - let connIds = map aConnId cs - pure (connIds, M.fromList $ zip connIds ucs) - getGroupMemberConns :: CM ([Group], [ConnId], Map ConnId GroupMember) - getGroupMemberConns = do - gs <- withStore_ (`getUserGroups` vr) - let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) (filter (not . memberRemoved) ms)) gs - pure (gs, map fst mPairs, M.fromList mPairs) - getSndFileTransferConns :: CM ([ConnId], Map ConnId SndFileTransfer) - getSndFileTransferConns = do - sfts <- withStore_ getLiveSndFileTransfers - let connIds = map sndFileTransferConnId sfts - pure (connIds, M.fromList $ zip connIds sfts) - getRcvFileTransferConns :: CM ([ConnId], Map ConnId RcvFileTransfer) - getRcvFileTransferConns = do - rfts <- withStore_ getLiveRcvFileTransfers - let rftPairs = mapMaybe (\ft -> (,ft) <$> liveRcvFileTransferConnId ft) rfts - pure (map fst rftPairs, M.fromList rftPairs) - getPendingContactConns :: CM ([ConnId], Map ConnId PendingContactConnection) - getPendingContactConns = do - pcs <- withStore_ getPendingContactConnections - let connIds = map aConnId' pcs - pure (connIds, M.fromList $ zip connIds pcs) - -- contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> CM () - -- contactSubsToView rs cts ce = do - -- chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses) - -- ifM (asks $ coreApi . config) (notifyAPI statuses) notifyCLI - -- where - -- notifyCLI = do - -- let cRs = resultsFor rs cts - -- cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs - -- toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs - -- when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors - -- notifyAPI = toView . CRNetworkStatuses (Just user) . map (uncurry ConnNetworkStatus) - -- statuses = M.foldrWithKey' addStatus [] cts - -- where - -- addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)] - -- addStatus _ Contact {activeConn = Nothing} nss = nss - -- addStatus connId Contact {activeConn = Just Connection {agentConnId}} nss = - -- let ns = (agentConnId, netStatus $ resultErr connId rs) - -- in ns : nss - -- netStatus :: Maybe ChatError -> NetworkStatus - -- netStatus = maybe NSConnected $ NSError . errorNetworkStatus - -- errorNetworkStatus :: ChatError -> String - -- errorNetworkStatus = \case - -- ChatErrorAgent (BROKER _ NETWORK) _ -> "network" - -- ChatErrorAgent (SMP _ SMP.AUTH) _ -> "contact deleted" - -- e -> show e - -- -- TODO possibly below could be replaced with less noisy events for API - -- contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM () - -- contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs - -- groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> CM () - -- groupSubsToView rs gs ms ce = do - -- mapM_ groupSub $ - -- sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs - -- toView . CRMemberSubSummary user $ map (uncurry MemberSubStatus) mRs - -- where - -- mRs = resultsFor rs ms - -- groupSub :: Group -> CM () - -- groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do - -- when ce $ mapM_ (toView . uncurry (CRMemberSubError user g)) mErrors - -- toView groupEvent - -- where - -- mErrors :: [(GroupMember, ChatError)] - -- mErrors = - -- sortOn (\(GroupMember {localDisplayName = n}, _) -> n) - -- . filterErrors - -- $ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs - -- groupEvent :: ChatResponse - -- groupEvent - -- | memberStatus membership == GSMemInvited = CRGroupInvitation user g - -- | all (\GroupMember {activeConn} -> isNothing activeConn) members = - -- if memberActive membership - -- then CRGroupEmpty user g - -- else CRGroupRemoved user g - -- | otherwise = CRGroupSubscribed user g - -- sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> CM () - -- sndFileSubsToView rs sfts = do - -- let sftRs = resultsFor rs sfts - -- forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do - -- forM_ err_ $ toView . CRSndFileSubError user ft - -- void . forkIO $ do - -- threadDelay 1000000 - -- when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withChatLock "subscribe sendFileChunk" $ - -- sendFileChunk user ft - -- rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> CM () - -- rcvFileSubsToView rs = mapM_ (toView . uncurry (CRRcvFileSubError user)) . filterErrors . resultsFor rs - -- pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> CM () - -- pendingConnSubsToView rs = toView . CRPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs + getContactConns = mapMaybe (\ct -> if contactActive ct then contactConnId ct else Nothing) <$> withStore_ (`getUserContacts` vr) + getUserContactLinkConns = map (aConnId . fst) <$> withStore_ (`getUserContactLinks` vr) + getGroupMemberConns = concatMap (\(Group _ ms) -> mapMaybe memberConnId (filter (not . memberRemoved) ms)) <$> withStore_ (`getUserGroups` vr) + getSndFileTransferConns = map sndFileTransferConnId <$> withStore_ getLiveSndFileTransfers + getRcvFileTransferConns = mapMaybe (\ft -> liveRcvFileTransferConnId ft) <$> withStore_ getLiveRcvFileTransfers + getPendingContactConns = map aConnId' <$> withStore_ getPendingContactConnections withStore_ :: (DB.Connection -> User -> IO [a]) -> CM [a] withStore_ a = withStore' (`a` user) `catchChatError` \e -> toView (CRChatError (Just user) e) $> [] - filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)] - filterErrors = mapMaybe (\(a, e_) -> (a,) <$> e_) - resultsFor :: Map ConnId (Either AgentErrorType ()) -> Map ConnId a -> [(a, Maybe ChatError)] - resultsFor rs = M.foldrWithKey' addResult [] - where - addResult :: ConnId -> a -> [(a, Maybe ChatError)] -> [(a, Maybe ChatError)] - addResult connId = (:) . (,resultErr connId rs) - resultErr :: ConnId -> Map ConnId (Either AgentErrorType ()) -> Maybe ChatError - resultErr connId rs = case M.lookup connId rs of - Just (Left e) -> Just $ ChatErrorAgent e Nothing - Just _ -> Nothing - _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId cleanupManager :: CM () cleanupManager = do diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 1c3e949562..a327eb109c 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -18,16 +18,14 @@ module Simplex.Chat.Store.Connections where import Control.Applicative ((<|>)) -import Control.Monad import Control.Monad.Except import Data.Int (Int64) -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (fromMaybe) import Database.SQLite.Simple (Only (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) import Simplex.Chat.Protocol import Simplex.Chat.Store.Files import Simplex.Chat.Store.Groups -import Simplex.Chat.Store.Profiles import Simplex.Chat.Store.Shared import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (ConnId) @@ -212,16 +210,10 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2 (userId, cReqHash1, cReqHash2, ConnDeleted) maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_ -getConnectionsToSubscribe :: DB.Connection -> VersionRangeChat -> IO ([ConnId], [ConnectionEntity]) -getConnectionsToSubscribe db vr = do - aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1" - entities <- forM aConnIds $ \acId -> do - getUserByAConnId db acId >>= \case - Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId) - Nothing -> pure Nothing - unsetConnectionToSubscribe db - let connIds = map (\(AgentConnId connId) -> connId) aConnIds - pure (connIds, catMaybes entities) +getConnectionsToSubscribe :: DB.Connection -> IO [ConnId] +getConnectionsToSubscribe db = do + connIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1" + connIds <$ unsetConnectionToSubscribe db unsetConnectionToSubscribe :: DB.Connection -> IO () unsetConnectionToSubscribe db = DB.execute_ db "UPDATE connections SET to_subscribe = 0 WHERE to_subscribe = 1"