mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-01 20:18:26 +00:00
Evgeny Poberezkinandspacedandy
ddc2da8fe4
* xftp: agent API for xftp commands and events * fix tests * fix tests 2 * xftp: update agent send api * update API to make temp path optional * revert tmp path changes (fixes send) --------- Co-authored-by: spacedandy <8711996+spaced4ndy@users.noreply.github.com>
66 lines
2.1 KiB
Haskell
66 lines
2.1 KiB
Haskell
module Simplex.Messaging.Agent.TRcvQueues
|
|
( TRcvQueues,
|
|
empty,
|
|
clear,
|
|
deleteConn,
|
|
hasConn,
|
|
getConns,
|
|
addQueue,
|
|
deleteQueue,
|
|
getSessQueues,
|
|
getDelSessQueues,
|
|
)
|
|
where
|
|
|
|
import Control.Concurrent.STM
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Set (Set)
|
|
import qualified Data.Set as S
|
|
import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
|
|
import Simplex.Messaging.Agent.Store (RcvQueue (..))
|
|
import Simplex.Messaging.Protocol (RecipientId, SMPServer)
|
|
import Simplex.Messaging.TMap (TMap)
|
|
import qualified Simplex.Messaging.TMap as TM
|
|
|
|
newtype TRcvQueues = TRcvQueues (TMap (UserId, SMPServer, RecipientId) RcvQueue)
|
|
|
|
empty :: STM TRcvQueues
|
|
empty = TRcvQueues <$> TM.empty
|
|
|
|
clear :: TRcvQueues -> STM ()
|
|
clear (TRcvQueues qs) = TM.clear qs
|
|
|
|
deleteConn :: ConnId -> TRcvQueues -> STM ()
|
|
deleteConn cId (TRcvQueues qs) = modifyTVar' qs $ M.filter (\rq -> cId /= connId rq)
|
|
|
|
hasConn :: ConnId -> TRcvQueues -> STM Bool
|
|
hasConn cId (TRcvQueues qs) = any (\rq -> cId == connId rq) <$> readTVar qs
|
|
|
|
getConns :: TRcvQueues -> STM (Set ConnId)
|
|
getConns (TRcvQueues qs) = M.foldr' (S.insert . connId) S.empty <$> readTVar qs
|
|
|
|
addQueue :: RcvQueue -> TRcvQueues -> STM ()
|
|
addQueue rq (TRcvQueues qs) = TM.insert (qKey rq) rq qs
|
|
|
|
deleteQueue :: RcvQueue -> TRcvQueues -> STM ()
|
|
deleteQueue rq (TRcvQueues qs) = TM.delete (qKey rq) qs
|
|
|
|
getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM [RcvQueue]
|
|
getSessQueues tSess (TRcvQueues qs) = M.foldl' addQ [] <$> readTVar qs
|
|
where
|
|
addQ qs' rq = if rq `isSession` tSess then rq : qs' else qs'
|
|
|
|
getDelSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM [RcvQueue]
|
|
getDelSessQueues tSess (TRcvQueues qs) = stateTVar qs $ M.foldl' addQ ([], M.empty)
|
|
where
|
|
addQ (removed, qs') rq
|
|
| rq `isSession` tSess = (rq : removed, qs')
|
|
| otherwise = (removed, M.insert (qKey rq) rq qs')
|
|
|
|
isSession :: RcvQueue -> (UserId, SMPServer, Maybe ConnId) -> Bool
|
|
isSession rq (uId, srv, connId_) =
|
|
userId rq == uId && server rq == srv && maybe True (connId rq ==) connId_
|
|
|
|
qKey :: RcvQueue -> (UserId, SMPServer, ConnId)
|
|
qKey rq = (userId rq, server rq, connId rq)
|