Skip to content

Commit a1277bf

Browse files
authored
agent: remove service queue association when service ID changed, process ENDS event, test migrating to/from service (#1677)
* agent: remove service queue association when service ID changed * agent: process ENDS event * agent: send service subscription error event * agent: test migrating to/from service subscriptions, fixes * agent: always remove service when disabled, fix service subscriptions
1 parent c8a7243 commit a1277bf

File tree

11 files changed

+338
-125
lines changed

11 files changed

+338
-125
lines changed

src/Simplex/Messaging/Agent.hs

Lines changed: 52 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -221,7 +221,9 @@ import Simplex.Messaging.Protocol
221221
SMPMsgMeta,
222222
SParty (..),
223223
SProtocolType (..),
224-
ServiceSubResult,
224+
ServiceSub (..),
225+
ServiceSubResult (..),
226+
ServiceSubError (..),
225227
SndPublicAuthKey,
226228
SubscriptionMode (..),
227229
UserProtocol,
@@ -1040,10 +1042,10 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
10401042
createRcvQueue nonce_ qd e2eKeys = do
10411043
AgentConfig {smpClientVRange = vr} <- asks config
10421044
ntfServer_ <- if enableNtfs then newQueueNtfServer else pure Nothing
1043-
(rq, qUri, tSess, sessId) <- newRcvQueue_ c nm userId connId srvWithAuth vr qd (isJust ntfServer_) subMode nonce_ e2eKeys `catchAllErrors` \e -> liftIO (print e) >> throwE e
1045+
(rq, qUri, tSess, sessId, serviceId_) <- newRcvQueue_ c nm userId connId srvWithAuth vr qd (isJust ntfServer_) subMode nonce_ e2eKeys `catchAllErrors` \e -> liftIO (print e) >> throwE e
10441046
atomically $ incSMPServerStat c userId srv connCreated
10451047
rq' <- withStore c $ \db -> updateNewConnRcv db connId rq subMode
1046-
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
1048+
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId serviceId_
10471049
mapM_ (newQueueNtfSubscription c rq') ntfServer_
10481050
pure (rq', qUri)
10491051
createConnReq :: SMPQueueUri -> AM (ConnectionRequestUri c)
@@ -1291,11 +1293,11 @@ joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode
12911293
createReplyQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
12921294
createReplyQueue c nm ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
12931295
ntfServer_ <- if enableNtfs then newQueueNtfServer else pure Nothing
1294-
(rq, qUri, tSess, sessId) <- newRcvQueue c nm userId connId srv (versionToRange smpClientVersion) SCMInvitation (isJust ntfServer_) subMode
1296+
(rq, qUri, tSess, sessId, serviceId_) <- newRcvQueue c nm userId connId srv (versionToRange smpClientVersion) SCMInvitation (isJust ntfServer_) subMode
12951297
atomically $ incSMPServerStat c userId (qServer rq) connCreated
12961298
let qInfo = toVersionT qUri smpClientVersion
12971299
rq' <- withStore c $ \db -> upgradeSndConnToDuplex db connId rq subMode
1298-
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
1300+
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId serviceId_
12991301
mapM_ (newQueueNtfSubscription c rq') ntfServer_
13001302
pure qInfo
13011303

@@ -1451,22 +1453,14 @@ subscribeAllConnections' c onlyNeeded activeUserId_ = handleErr $ do
14511453
Just activeUserId -> sortOn (\(uId, _) -> if uId == activeUserId then 0 else 1 :: Int) userSrvs
14521454
Nothing -> userSrvs
14531455
useServices <- readTVarIO $ useClientServices c
1454-
-- These options are possible below:
1455-
-- 1) services fully disabled:
1456-
-- No service subscriptions will be attempted, and existing services and association will remain in in the database,
1457-
-- but they will be ignored because of hasService parameter set to False.
1458-
-- This approach preserves performance for all clients that do not use services.
1459-
-- 2) at least one user ID has services enabled:
1460-
-- Service will be loaded for all user/server combinations:
1461-
-- a) service is enabled for user ID and service record exists: subscription will be attempted,
1462-
-- b) service is disabled and record exists: service record and all associations will be removed,
1463-
-- c) service is disabled or no record: no subscription attempt.
1456+
-- Service will be loaded for all user/server combinations:
1457+
-- a) service is enabled for user ID and service record exists: subscription will be attempted,
1458+
-- b) service is disabled and record exists: service record and all associations will be removed,
1459+
-- c) service is disabled or no record: no subscription attempt.
14641460
-- On successful service subscription, only unassociated queues will be subscribed.
1465-
userSrvs'' <-
1466-
if any id useServices
1467-
then lift $ mapConcurrently (subscribeService useServices) userSrvs'
1468-
else pure $ map (,False) userSrvs'
1469-
rs <- lift $ mapConcurrently (subscribeUserServer maxPending currPending) userSrvs''
1461+
userSrvs2 <- withStore' c $ \db -> mapM (getService db useServices) userSrvs'
1462+
userSrvs3 <- lift $ mapConcurrently subscribeService userSrvs2
1463+
rs <- lift $ mapConcurrently (subscribeUserServer maxPending currPending) userSrvs3
14701464
let (errs, oks) = partitionEithers rs
14711465
logInfo $ "subscribed " <> tshow (sum oks) <> " queues"
14721466
forM_ (L.nonEmpty errs) $ notifySub c . ERRS . L.map ("",)
@@ -1475,16 +1469,30 @@ subscribeAllConnections' c onlyNeeded activeUserId_ = handleErr $ do
14751469
resumeAllCommands c
14761470
where
14771471
handleErr = (`catchAllErrors` \e -> notifySub' c "" (ERR e) >> throwE e)
1478-
subscribeService :: Map UserId Bool -> (UserId, SMPServer) -> AM' ((UserId, SMPServer), ServiceAssoc)
1479-
subscribeService useServices us@(userId, srv) = fmap ((us,) . fromRight False) $ tryAllErrors' $ do
1480-
withStore' c (\db -> getSubscriptionService db userId srv) >>= \case
1472+
getService :: DB.Connection -> Map UserId Bool -> (UserId, SMPServer) -> IO ((UserId, SMPServer), Maybe ServiceSub)
1473+
getService db useServices us@(userId, srv) =
1474+
fmap (us,) $ getSubscriptionService db userId srv >>= \case
14811475
Just serviceSub -> case M.lookup userId useServices of
1482-
Just True -> tryAllErrors (subscribeClientService c True userId srv serviceSub) >>= \case
1483-
Left e | clientServiceError e -> unassocQueues $> False
1476+
Just True -> pure $ Just serviceSub
1477+
_ -> Nothing <$ unassocUserServerRcvQueueSubs' db userId srv
1478+
_ -> pure Nothing
1479+
subscribeService :: ((UserId, SMPServer), Maybe ServiceSub) -> AM' ((UserId, SMPServer), ServiceAssoc)
1480+
subscribeService (us@(userId, srv), serviceSub_) = fmap ((us,) . fromRight False) $ tryAllErrors' $
1481+
case serviceSub_ of
1482+
Just serviceSub -> tryAllErrors (subscribeClientService c True userId srv serviceSub) >>= \case
1483+
Right (ServiceSubResult e _) -> case e of
1484+
Just SSErrorServiceId {} -> unassocQueues
1485+
-- Possibly, we should always resubscribe all when expected is greater than subscribed
1486+
Just SSErrorQueueCount {expectedQueueCount = n, subscribedQueueCount = n'} | n > 0 && n' == 0 -> unassocQueues
14841487
_ -> pure True
1485-
_ -> unassocQueues $> False
1488+
Left e -> do
1489+
atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR e)
1490+
if clientServiceError e
1491+
then unassocQueues
1492+
else pure True
14861493
where
1487-
unassocQueues = withStore' c $ \db -> unassocUserServerRcvQueueSubs db userId srv
1494+
unassocQueues :: AM Bool
1495+
unassocQueues = False <$ withStore' c (\db -> unassocUserServerRcvQueueSubs' db userId srv)
14881496
_ -> pure False
14891497
subscribeUserServer :: Int -> TVar Int -> ((UserId, SMPServer), ServiceAssoc) -> AM' (Either AgentErrorType Int)
14901498
subscribeUserServer maxPending currPending ((userId, srv), hasService) = do
@@ -2219,10 +2227,10 @@ switchDuplexConnection c nm (DuplexConnection cData@ConnData {connId, userId} rq
22192227
srv' <- if srv == server then getNextSMPServer c userId [server] else pure srvAuth
22202228
-- TODO [notications] possible improvement would be to create ntf credentials here, to avoid creating them after rotation completes.
22212229
-- The problem is that currently subscription already exists, and we do not support queues with credentials but without subscriptions.
2222-
(q, qUri, tSess, sessId) <- newRcvQueue c nm userId connId srv' clientVRange SCMInvitation False SMSubscribe
2230+
(q, qUri, tSess, sessId, serviceId_) <- newRcvQueue c nm userId connId srv' clientVRange SCMInvitation False SMSubscribe
22232231
let rq' = (q :: NewRcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
22242232
rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq' SMSubscribe
2225-
lift $ addNewQueueSubscription c rq'' tSess sessId
2233+
lift $ addNewQueueSubscription c rq'' tSess sessId serviceId_
22262234
void . enqueueMessages c cData sqs SMP.noMsgFlags $ QADD [(qUri, Just (server, sndId))]
22272235
rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSendingQADD
22282236
let rqs' = updatedQs rq1 rqs <> [rq'']
@@ -2908,7 +2916,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
29082916
processSubOk :: RcvQueue -> TVar [ConnId] -> TVar [RcvQueue] -> Maybe SMP.ServiceId -> IO ()
29092917
processSubOk rq@RcvQueue {connId} upConnIds serviceRQs serviceId_ =
29102918
atomically . whenM (isPendingSub rq) $ do
2911-
SS.addActiveSub tSess sessId rq $ currentSubs c
2919+
SS.addActiveSub tSess sessId serviceId_ rq $ currentSubs c
29122920
modifyTVar' upConnIds (connId :)
29132921
when (isJust serviceId_ && serviceId_ == clientServiceId_) $ modifyTVar' serviceRQs (rq :)
29142922
clientServiceId_ = (\THClientService {serviceId} -> serviceId) <$> (clientService =<< thAuth)
@@ -3115,16 +3123,26 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
31153123
notifyEnd removed
31163124
| removed = notify END >> logServer "<--" c srv rId "END"
31173125
| otherwise = logServer "<--" c srv rId "END from disconnected client - ignored"
3118-
-- TODO [certs rcv]
3119-
r@(SMP.ENDS _) -> unexpected r
3126+
SMP.ENDS n idsHash ->
3127+
atomically (ifM (activeClientSession c tSess sessId) (SS.deleteServiceSub tSess (currentSubs c) $> True) (pure False))
3128+
>>= notifyEnd
3129+
where
3130+
notifyEnd removed
3131+
| removed = do
3132+
forM_ clientServiceId_ $ \serviceId ->
3133+
notify_ B.empty $ SERVICE_END srv $ ServiceSub serviceId n idsHash
3134+
logServer "<--" c srv rId "ENDS"
3135+
| otherwise = logServer "<--" c srv rId "ENDS from disconnected client - ignored"
31203136
-- TODO [certs rcv] Possibly, we need to add some flag to connection that it was deleted
31213137
SMP.DELD -> atomically (removeSubscription c tSess connId rq) >> notify DELD
31223138
SMP.ERR e -> notify $ ERR $ SMP (B.unpack $ strEncode srv) e
31233139
r -> unexpected r
31243140
where
31253141
notify :: forall e m. (AEntityI e, MonadIO m) => AEvent e -> m ()
3126-
notify msg =
3127-
let t = ("", connId, AEvt (sAEntity @e) msg)
3142+
notify = notify_ connId
3143+
notify_ :: forall e m. (AEntityI e, MonadIO m) => ConnId -> AEvent e -> m ()
3144+
notify_ connId' msg =
3145+
let t = ("", connId', AEvt (sAEntity @e) msg)
31283146
in atomically $ ifM (isFullTBQueue subQ) (modifyTVar' pendingMsgs (t :)) (writeTBQueue subQ t)
31293147

31303148
prohibited :: Text -> AM ()

src/Simplex/Messaging/Agent/Client.hs

Lines changed: 25 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -266,7 +266,6 @@ import Simplex.Messaging.Protocol
266266
NetworkError (..),
267267
MsgFlags (..),
268268
MsgId,
269-
IdsHash,
270269
NtfServer,
271270
NtfServerWithAuth,
272271
ProtoServer,
@@ -283,6 +282,7 @@ import Simplex.Messaging.Protocol
283282
SProtocolType (..),
284283
ServiceSub (..),
285284
ServiceSubResult (..),
285+
ServiceSubError (..),
286286
SndPublicAuthKey,
287287
SubscriptionMode (..),
288288
NewNtfCreds (..),
@@ -1420,7 +1420,7 @@ getSessionMode :: AgentClient -> STM TransportSessionMode
14201420
getSessionMode = fmap (sessionMode . snd) . readTVar . useNetworkConfig
14211421
{-# INLINE getSessionMode #-}
14221422

1423-
newRcvQueue :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> Bool -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
1423+
newRcvQueue :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> Bool -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId, Maybe ServiceId)
14241424
newRcvQueue c nm userId connId srv vRange cMode enableNtfs subMode = do
14251425
let qrd = case cMode of SCMInvitation -> CQRMessaging Nothing; SCMContact -> CQRContact Nothing
14261426
e2eKeys <- atomically . C.generateKeyPair =<< asks random
@@ -1441,7 +1441,7 @@ queueReqData = \case
14411441
CQRMessaging d -> QRMessaging $ srvReq <$> d
14421442
CQRContact d -> QRContact $ srvReq <$> d
14431443

1444-
newRcvQueue_ :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> Bool -> SubscriptionMode -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
1444+
newRcvQueue_ :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> Bool -> SubscriptionMode -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId, Maybe ServiceId)
14451445
newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enableNtfs subMode nonce_ (e2eDhKey, e2ePrivKey) = do
14461446
C.AuthAlg a <- asks (rcvAuthAlg . config)
14471447
g <- asks random
@@ -1483,7 +1483,7 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
14831483
deleteErrors = 0
14841484
}
14851485
qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey queueMode
1486-
pure (rq, qUri, tSess, sessionId thParams')
1486+
pure (rq, qUri, tSess, sessionId thParams', sessServiceId)
14871487
where
14881488
mkNtfCreds :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> TVar ChaChaDRG -> SMPClient -> IO (Maybe (C.AAuthKeyPair, C.PrivateKeyX25519), Maybe NewNtfCreds)
14891489
mkNtfCreds a g smp
@@ -1526,23 +1526,23 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
15261526

15271527
processSubResults :: AgentClient -> SMPTransportSession -> SessionId -> Maybe ServiceId -> NonEmpty (RcvQueueSub, Either SMPClientError (Maybe ServiceId)) -> STM ([RcvQueueSub], [(RcvQueueSub, Maybe ClientNotice)])
15281528
processSubResults c tSess@(userId, srv, _) sessId serviceId_ rs = do
1529-
pending <- SS.getPendingSubs tSess $ currentSubs c
1530-
let (failed, subscribed@(qs, sQs), notices, ignored) = foldr (partitionResults pending) (M.empty, ([], []), [], 0) rs
1529+
pendingSubs <- SS.getPendingQueueSubs tSess $ currentSubs c
1530+
let (failed, subscribed@(qs, sQs), notices, ignored) = foldr (partitionResults pendingSubs) (M.empty, ([], []), [], 0) rs
15311531
unless (M.null failed) $ do
15321532
incSMPServerStat' c userId srv connSubErrs $ M.size failed
15331533
failSubscriptions c tSess failed
15341534
unless (null qs && null sQs) $ do
15351535
incSMPServerStat' c userId srv connSubscribed $ length qs + length sQs
1536-
SS.batchAddActiveSubs tSess sessId subscribed $ currentSubs c
1536+
SS.batchAddActiveSubs tSess sessId serviceId_ subscribed $ currentSubs c
15371537
unless (ignored == 0) $ incSMPServerStat' c userId srv connSubIgnored ignored
15381538
pure (sQs, notices)
15391539
where
15401540
partitionResults ::
1541-
(Map SMP.RecipientId RcvQueueSub, Maybe ServiceSub) ->
1541+
Map SMP.RecipientId RcvQueueSub ->
15421542
(RcvQueueSub, Either SMPClientError (Maybe ServiceId)) ->
15431543
(Map SMP.RecipientId SMPClientError, ([RcvQueueSub], [RcvQueueSub]), [(RcvQueueSub, Maybe ClientNotice)], Int) ->
15441544
(Map SMP.RecipientId SMPClientError, ([RcvQueueSub], [RcvQueueSub]), [(RcvQueueSub, Maybe ClientNotice)], Int)
1545-
partitionResults (pendingSubs, pendingSS) (rq@RcvQueueSub {rcvId, clientNoticeId}, r) acc@(failed, subscribed@(qs, sQs), notices, ignored) = case r of
1545+
partitionResults pendingSubs (rq@RcvQueueSub {rcvId, clientNoticeId}, r) acc@(failed, subscribed@(qs, sQs), notices, ignored) = case r of
15461546
Left e -> case smpErrorClientNotice e of
15471547
Just notice_ -> (failed', subscribed, (rq, notice_) : notices, ignored)
15481548
where
@@ -1554,8 +1554,8 @@ processSubResults c tSess@(userId, srv, _) sessId serviceId_ rs = do
15541554
failed' = M.insert rcvId e failed
15551555
Right serviceId_'
15561556
| rcvId `M.member` pendingSubs ->
1557-
let subscribed' = case (serviceId_, serviceId_', pendingSS) of
1558-
(Just sId, Just sId', Just ServiceSub {smpServiceId}) | sId == sId' && sId == smpServiceId -> (qs, rq : sQs)
1557+
let subscribed' = case (serviceId_, serviceId_') of
1558+
(Just sId, Just sId') | sId == sId' -> (qs, rq : sQs)
15591559
_ -> (rq : qs, sQs)
15601560
in (failed, subscribed', notices', ignored)
15611561
| otherwise -> (failed, subscribed, notices', ignored + 1)
@@ -1726,11 +1726,18 @@ processClientNotices c@AgentClient {presetServers} tSess notices = do
17261726

17271727
resubscribeClientService :: AgentClient -> SMPTransportSession -> ServiceSub -> AM ServiceSubResult
17281728
resubscribeClientService c tSess@(userId, srv, _) serviceSub =
1729-
withServiceClient c tSess (\smp _ -> subscribeClientService_ c True tSess smp serviceSub) `catchE` \e -> do
1730-
when (clientServiceError e) $ do
1729+
tryAllErrors (withServiceClient c tSess $ \smp _ -> subscribeClientService_ c True tSess smp serviceSub) >>= \case
1730+
Right r@(ServiceSubResult e _) -> case e of
1731+
Just SSErrorServiceId {} -> unassocSubscribeQueues $> r
1732+
_ -> pure r
1733+
Left e -> do
1734+
when (clientServiceError e) $ unassocSubscribeQueues
1735+
atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR e)
1736+
throwE e
1737+
where
1738+
unassocSubscribeQueues = do
17311739
qs <- withStore' c $ \db -> unassocUserServerRcvQueueSubs db userId srv
17321740
void $ lift $ subscribeUserServerQueues c userId srv qs
1733-
throwE e
17341741

17351742
-- TODO [certs rcv] update service in the database if it has different ID and re-associate queues, and send event
17361743
subscribeClientService :: AgentClient -> Bool -> UserId -> SMPServer -> ServiceSub -> AM ServiceSubResult
@@ -1751,7 +1758,7 @@ withServiceClient c tSess subscribe =
17511758

17521759
-- TODO [certs rcv] send subscription error event?
17531760
subscribeClientService_ :: AgentClient -> Bool -> SMPTransportSession -> SMPClient -> ServiceSub -> ExceptT SMPClientError IO ServiceSubResult
1754-
subscribeClientService_ c withEvent tSess@(userId, srv, _) smp expected@(ServiceSub _ n idsHash) = do
1761+
subscribeClientService_ c withEvent tSess@(_, srv, _) smp expected@(ServiceSub _ n idsHash) = do
17551762
subscribed <- subscribeService smp SMP.SRecipientService n idsHash
17561763
let sessId = sessionId $ thParams smp
17571764
r = serviceSubResult expected subscribed
@@ -1821,14 +1828,14 @@ getRemovedSubs AgentClient {removedSubs} k = TM.lookup k removedSubs >>= maybe n
18211828
TM.insert k s removedSubs
18221829
pure s
18231830

1824-
addNewQueueSubscription :: AgentClient -> RcvQueue -> SMPTransportSession -> SessionId -> AM' ()
1825-
addNewQueueSubscription c rq' tSess sessId = do
1831+
addNewQueueSubscription :: AgentClient -> RcvQueue -> SMPTransportSession -> SessionId -> Maybe ServiceId -> AM' ()
1832+
addNewQueueSubscription c rq' tSess sessId serviceId_ = do
18261833
let rq = rcvQueueSub rq'
18271834
same <- atomically $ do
18281835
modifyTVar' (subscrConns c) $ S.insert $ qConnId rq
18291836
active <- activeClientSession c tSess sessId
18301837
if active
1831-
then SS.addActiveSub tSess sessId rq' $ currentSubs c
1838+
then SS.addActiveSub tSess sessId serviceId_ rq' $ currentSubs c
18321839
else SS.addPendingSub tSess rq $ currentSubs c
18331840
pure active
18341841
unless same $ resubscribeSMPSession c tSess

src/Simplex/Messaging/Agent/Protocol.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -393,6 +393,7 @@ data AEvent (e :: AEntity) where
393393
SERVICE_ALL :: SMPServer -> AEvent AENone -- all service messages are delivered
394394
SERVICE_DOWN :: SMPServer -> ServiceSub -> AEvent AENone
395395
SERVICE_UP :: SMPServer -> ServiceSubResult -> AEvent AENone
396+
SERVICE_END :: SMPServer -> ServiceSub -> AEvent AENone
396397
SWITCH :: QueueDirection -> SwitchPhase -> ConnectionStats -> AEvent AEConn
397398
RSYNC :: RatchetSyncState -> Maybe AgentCryptoError -> ConnectionStats -> AEvent AEConn
398399
SENT :: AgentMsgId -> Maybe SMPServer -> AEvent AEConn
@@ -467,6 +468,7 @@ data AEventTag (e :: AEntity) where
467468
SERVICE_ALL_ :: AEventTag AENone
468469
SERVICE_DOWN_ :: AEventTag AENone
469470
SERVICE_UP_ :: AEventTag AENone
471+
SERVICE_END_ :: AEventTag AENone
470472
SWITCH_ :: AEventTag AEConn
471473
RSYNC_ :: AEventTag AEConn
472474
SENT_ :: AEventTag AEConn
@@ -525,6 +527,7 @@ aEventTag = \case
525527
SERVICE_ALL _ -> SERVICE_ALL_
526528
SERVICE_DOWN {} -> SERVICE_DOWN_
527529
SERVICE_UP {} -> SERVICE_UP_
530+
SERVICE_END {} -> SERVICE_END_
528531
SWITCH {} -> SWITCH_
529532
RSYNC {} -> RSYNC_
530533
SENT {} -> SENT_

0 commit comments

Comments
 (0)