blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: track network statuses, use in commands/events (#3211)

Browse Source 
* core: track network statuses, use in commands/events

* ui types, test

* remove comment
This commit is contained in:
Evgeny Poberezkin
2023-10-13 11:51:01 +01:00
committed by GitHub
parent 675fc19745
commit ab290fb068
13 changed files with 275 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+14 -1
View File
@@ -32,6 +32,7 @@ import Data.Char (ord)
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.String
import Data.Text (Text)
import Data.Time (NominalDiffTime, UTCTime)
@@ -124,7 +125,8 @@ data ChatConfig = ChatConfig
initialCleanupManagerDelay :: Int64,
cleanupManagerInterval :: NominalDiffTime,
cleanupManagerStepDelay :: Int64,
ciExpirationInterval :: Int64 -- microseconds
ciExpirationInterval :: Int64, -- microseconds
coreApi :: Bool
}
data DefaultAgentServers = DefaultAgentServers
@@ -164,6 +166,7 @@ data ChatController = ChatController
idsDrg :: TVar ChaChaDRG,
inputQ :: TBQueue String,
outputQ :: TBQueue (Maybe CorrId, ChatResponse),
connNetworkStatuses :: TMap AgentConnId NetworkStatus,
subscriptionMode :: TVar SubscriptionMode,
chatLock :: Lock,
sndFiles :: TVar (Map Int64 Handle),
@@ -251,6 +254,7 @@ data ChatCommand
| APIEndCall ContactId
| APIGetCallInvitations
| APICallStatus ContactId WebRTCCallStatus
| APIGetNetworkStatuses
| APIUpdateProfile UserId Profile
| APISetContactPrefs ContactId Preferences
| APISetContactAlias ContactId LocalAlias
@@ -528,6 +532,8 @@ data ChatResponse
| CRContactSubError {user :: User, contact :: Contact, chatError :: ChatError}
| CRContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
| CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
| CRNetworkStatus {networkStatus :: NetworkStatus, connections :: [AgentConnId]}
| CRNetworkStatuses {user_ :: Maybe User, networkStatuses :: [ConnNetworkStatus]}
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRGroupInvitation {user :: User, groupInfo :: GroupInfo}
@@ -1044,6 +1050,13 @@ chatWriteVar :: ChatMonad' m => (ChatController -> TVar a) -> a -> m ()
chatWriteVar f value = asks f >>= atomically . (`writeTVar` value)
{-# INLINE chatWriteVar #-}
chatModifyVar :: ChatMonad' m => (ChatController -> TVar a) -> (a -> a) -> m ()
chatModifyVar f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
{-# INLINE chatModifyVar #-}
setContactNetworkStatus :: ChatMonad' m => Contact -> NetworkStatus -> m ()
setContactNetworkStatus ct = chatModifyVar connNetworkStatuses . M.insert (contactAgentConnId ct)
tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
tryChatError = tryAllErrors mkChatError
{-# INLINE tryChatError #-}