remove unused

This commit is contained in:
Evgeny Poberezkin
2026-07-01 21:29:43 +01:00
parent 5825ad84de
commit 189aa0617e
16 changed files with 36 additions and 102 deletions
+1 -1
View File
@@ -54,7 +54,7 @@ import Data.Time (addUTCTime)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds, secondsToDiffTime)
import Simplex.Chat.Badges (BadgeCredential (..), ProofPresHeader (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), badgeProof, mkBadgeStatus, verifyBadge)
import Simplex.Chat.Names (SimplexNameClaim (..), claimName, mkSimplexNameClaim)
import Simplex.Chat.Names (claimName, mkSimplexNameClaim)
import Simplex.Chat.Call
import Simplex.Chat.Controller
import Simplex.Chat.Files
+9 -9
View File
@@ -1397,13 +1397,13 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
CFSetShortLink ->
case (ucGroupId_, auData) of
(Just groupId, UserContactLinkData UserContactData {relays = relayLinks}) -> do
(gInfo, gLink, relays, relaysChanged, newlyActiveLinks, newlyActiveGMIds) <- withStore $ \db -> do
(gInfo, gLink, relays, relaysChanged, newlyActiveLinks) <- withStore $ \db -> do
gInfo <- getGroupInfo db cxt user groupId
gLink <- getGroupLink db user gInfo
relays <- liftIO $ getGroupRelays db gInfo
(relays', changed, newlyActiveLinks, newlyActiveGMIds) <- liftIO $ foldrM (updateRelay db) ([], False, [], []) relays
(relays', changed, newlyActiveLinks) <- liftIO $ foldrM (updateRelay db) ([], False, []) relays
liftIO $ setGroupInProgressDone db gInfo
pure (gInfo, gLink, relays', changed, newlyActiveLinks, newlyActiveGMIds)
pure (gInfo, gLink, relays', changed, newlyActiveLinks)
toView $ CEvtGroupLinkDataUpdated user gInfo gLink relays relaysChanged
let GroupSummary {publicMemberCount} = groupSummary gInfo
-- Owner is counted in publicMemberCount; > 1 means at least one subscriber.
@@ -1421,16 +1421,16 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
unless (null recipients) $
void $ sendGroupMessages user gInfo Nothing False recipients events
where
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId]) -> IO ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId])
updateRelay db relay@GroupRelay {groupMemberId, relayLink, relayStatus} (acc, changed, newlyActiveLinks, newlyActiveGMIds) =
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact]) -> IO ([GroupRelay], Bool, [ShortLinkContact])
updateRelay db relay@GroupRelay {groupMemberId, relayLink, relayStatus} (acc, changed, newlyActiveLinks) =
case relayLink of
Just rLink
-- version is gated upstream at publish (getPublishableGroupRelays): an RSAccepted relay
-- whose link is in the published data is necessarily pre-roster, so activate it too
| rLink `elem` relayLinks && (relayStatus == RSAcknowledgedRoster || relayStatus == RSAccepted) -> do
relay' <- updateRelayStatus db relay RSActive
pure (relay' : acc, True, rLink : newlyActiveLinks, groupMemberId : newlyActiveGMIds)
| rLink `elem` relayLinks -> pure (relay : acc, changed, newlyActiveLinks, newlyActiveGMIds)
pure (relay' : acc, True, rLink : newlyActiveLinks)
| rLink `elem` relayLinks -> pure (relay : acc, changed, newlyActiveLinks)
| relayStatus == RSActive -> do
-- Relay link absent from link data — deactivate.
-- RSAccepted relays are not deactivated: their own link data update
@@ -1439,8 +1439,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
-- TODO the SMP server, but this owner won't receive a LINK callback for it
-- TODO (LINK only fires in response to own setConnShortLink calls).
relay' <- updateRelayStatus db relay RSInactive
pure (relay' : acc, True, newlyActiveLinks, newlyActiveGMIds)
_ -> pure (relay : acc, changed, newlyActiveLinks, newlyActiveGMIds)
pure (relay' : acc, True, newlyActiveLinks)
_ -> pure (relay : acc, changed, newlyActiveLinks)
_ -> throwChatError $ CECommandError "LINK event expected for a group link only"
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
MERR _ err -> do
+2 -3
View File
@@ -110,12 +110,11 @@ import Data.Type.Equality
import Simplex.Chat.Badges (badgeToRow)
import Simplex.Chat.Messages
import Simplex.Chat.Store.Shared
import Simplex.Chat.Names (claimName, claimProof, mkSimplexNameClaim, setClaimProof)
import Simplex.Chat.Names (claimName, claimProof, setClaimProof)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionLink (..), ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), SConnectionMode (..), SimplexNameInfo, UserId)
import Simplex.Messaging.Encoding.String (StrJSON (..))
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), SConnectionMode (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
+1 -2
View File
@@ -233,11 +233,10 @@ import Simplex.Chat.Types.MemberRelations (IntroductionDirection (..), MemberRel
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConfirmationId, ConnId, ConnectionLink (..), CreatedConnLink (..), InvitationId, OwnerAuth (..), SConnectionMode (..), SimplexNameInfo, UserId)
import Simplex.Messaging.Agent.Protocol (ConfirmationId, ConnId, CreatedConnLink (..), InvitationId, OwnerAuth (..), SimplexNameInfo, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import qualified Simplex.FileTransfer.Description as FD
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
import Simplex.Messaging.Encoding.String (StrJSON (..))
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import Simplex.Messaging.Agent.Store.Entity (DBEntityId)
import qualified Simplex.Messaging.Agent.Store.DB as DB
+1 -1
View File
@@ -106,7 +106,7 @@ import Simplex.Chat.Operators
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Names (SimplexNameClaim (..), claimName, mkSimplexNameClaim)
import Simplex.Chat.Names (claimName, mkSimplexNameClaim)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
-2
View File
@@ -30,7 +30,6 @@ import Data.Int (Int64)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Type.Equality
import Simplex.Chat.Badges (BadgeRow, badgeToRow, rowToBadge, verifyBadge_)
@@ -50,7 +49,6 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..))
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding.String (StrJSON (..))
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (AnyError (..))
+8 -16
View File
@@ -4,6 +4,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -1802,6 +1803,7 @@ deriving instance Eq (ConnectTarget m)
deriving instance Show (ConnectTarget m)
data AConnectTarget = forall m. ConnectionModeI m => ACTarget (SConnectionMode m) (ConnectTarget m)
deriving (ToJSON, FromJSON) via (StrJSON "AConnectTarget" AConnectTarget)
instance Eq AConnectTarget where
ACTarget m t == ACTarget m' t' = case testEquality m m' of
@@ -1818,25 +1820,15 @@ instance StrEncoding AConnectTarget where
CTInv l -> strEncode l
strP =
(ACTarget SCMContact . CTShortContact . CTName <$> (lookAhead nameStart *> strP))
<|> ((\(ACL m cl) -> aConnectTarget m cl) <$> strP)
<|> (aConnectTarget <$> strP)
where
nameStart = "@" <|> "#" <|> "simplex:/name"
aConnectTarget :: SConnectionMode m -> ConnectionLink m -> AConnectTarget
aConnectTarget m cl = case (m, cl) of
(SCMContact, CLFull cr) -> ACTarget SCMContact (CTFullContact cr)
(SCMContact, CLShort sl) -> ACTarget SCMContact (CTShortContact (CTLink sl))
(SCMInvitation, _) -> ACTarget SCMInvitation (CTInv cl)
aConnectTargetLink :: AConnectionLink -> AConnectTarget
aConnectTargetLink (ACL m cl) = aConnectTarget m cl
instance ToJSON AConnectTarget where
toEncoding = strToJEncoding
toJSON = strToJSON
instance FromJSON AConnectTarget where
parseJSON = strParseJSON "AConnectTarget"
aConnectTarget :: AConnectionLink -> AConnectTarget
aConnectTarget (ACL SCMInvitation cl) = ACTarget SCMInvitation (CTInv cl)
aConnectTarget (ACL SCMContact cl) = ACTarget SCMContact $ case cl of
CLFull cr -> CTFullContact cr
CLShort sl -> CTShortContact (CTLink sl)
type CreatedLinkInvitation = CreatedConnLink 'CMInvitation