@@ -1194,6 +1194,25 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
1194
1194
notify . SWITCH QDRcv SPSecured $ connectionStats conn'
1195
1195
_ -> internalErr " ICQSecure: no switching queue found"
1196
1196
_ -> internalErr " ICQSecure: queue address not found in connection"
1197
+ ICQSndSecure sId ->
1198
+ withServer $ \ srv -> tryWithLock " ICQSndSecure" . withDuplexConn $ \ (DuplexConnection cData rqs sqs) ->
1199
+ case find (sameQueue (srv, sId)) sqs of
1200
+ Just sq'@ SndQueue {server, sndId, sndSecure, status, smpClientVersion, e2ePubKey = Just dhPublicKey, dbReplaceQueueId = Just replaceQId} ->
1201
+ case find ((replaceQId == ) . dbQId) sqs of
1202
+ Just sq1 -> when (status == New ) $ do
1203
+ secureSndQueue c sq'
1204
+ withStore' c $ \ db -> setSndQueueStatus db sq' Secured
1205
+ let sq'' = (sq' :: SndQueue ) {status = Secured }
1206
+ queueAddress = SMPQueueAddress {smpServer = server, senderId = sndId, dhPublicKey, sndSecure}
1207
+ qInfo = SMPQueueInfo {clientVersion = smpClientVersion, queueAddress}
1208
+ -- sending QSEC to the new queue only, the old one will be removed if sent successfully
1209
+ void . enqueueMessages c cData [sq''] SMP. noMsgFlags $ QSEC [qInfo]
1210
+ sq1' <- withStore' c $ \ db -> setSndSwitchStatus db sq1 $ Just SSSendingQSEC
1211
+ let sqs' = updatedQs sq1' sqs
1212
+ conn' = DuplexConnection cData rqs sqs'
1213
+ notify . SWITCH QDSnd SPCompleted $ connectionStats conn'
1214
+ _ -> internalErr " ICQSndSecure: no switching queue found"
1215
+ _ -> internalErr " ICQSndSecure: queue address not found in connection"
1197
1216
ICQDelete rId -> do
1198
1217
withServer $ \ srv -> tryWithLock " ICQDelete" . withDuplexConn $ \ (DuplexConnection cData rqs sqs) -> do
1199
1218
case removeQ (srv, rId) rqs of
@@ -1392,6 +1411,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
1392
1411
AM_QCONT_ -> notifyDel msgId err
1393
1412
AM_QADD_ -> qError msgId " QADD: AUTH"
1394
1413
AM_QKEY_ -> qError msgId " QKEY: AUTH"
1414
+ AM_QSEC_ -> qError msgId " QKEY: AUTH"
1395
1415
AM_QUSE_ -> qError msgId " QUSE: AUTH"
1396
1416
AM_QTEST_ -> qError msgId " QTEST: AUTH"
1397
1417
AM_EREADY_ -> notifyDel msgId err
@@ -1445,8 +1465,13 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
1445
1465
AM_QKEY_ -> do
1446
1466
SomeConn _ conn <- withStore c (`getConn` connId)
1447
1467
notify . SWITCH QDSnd SPConfirmed $ connectionStats conn
1468
+ AM_QSEC_ -> withConnLock c connId " runSmpQueueMsgDelivery AM_QSEC_" $ completeConnSwitch " QSEC" SSSendingQSEC
1448
1469
AM_QUSE_ -> pure ()
1449
- AM_QTEST_ -> withConnLock c connId " runSmpQueueMsgDelivery AM_QTEST_" $ do
1470
+ AM_QTEST_ -> withConnLock c connId " runSmpQueueMsgDelivery AM_QTEST_" $ completeConnSwitch " QTEST" SSSendingQTEST
1471
+ AM_EREADY_ -> pure ()
1472
+ delMsgKeep (msgType == AM_A_MSG_ ) msgId
1473
+ where
1474
+ completeConnSwitch msgTag expectedStatus = do
1450
1475
withStore' c $ \ db -> setSndQueueStatus db sq Active
1451
1476
SomeConn _ conn <- withStore c (`getConn` connId)
1452
1477
case conn of
@@ -1458,9 +1483,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
1458
1483
Just SndQueue {dbReplaceQueueId = Just replacedId, primary} ->
1459
1484
-- second part of this condition is a sanity check because dbReplaceQueueId cannot point to the same queue, see switchConnection'
1460
1485
case removeQP (\ sq' -> dbQId sq' == replacedId && not (sameQueue addr sq')) sqs of
1461
- Nothing -> internalErr msgId " sent QTEST : queue not found in connection"
1486
+ Nothing -> internalErr msgId $ " sent " <> msgTag <> " : queue not found in connection"
1462
1487
Just (sq', sq'' : sqs') -> do
1463
- checkSQSwchStatus sq' SSSendingQTEST
1488
+ checkSQSwchStatus sq' expectedStatus
1464
1489
-- remove the delivery from the map to stop the thread when the delivery loop is complete
1465
1490
atomically $ TM. delete (qAddress sq') $ smpDeliveryWorkers c
1466
1491
withStore' c $ \ db -> do
@@ -1470,12 +1495,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
1470
1495
let sqs'' = sq'' :| sqs'
1471
1496
conn' = DuplexConnection cData' rqs sqs''
1472
1497
notify . SWITCH QDSnd SPCompleted $ connectionStats conn'
1473
- _ -> internalErr msgId " sent QTEST: there is only one queue in connection"
1474
- _ -> internalErr msgId " sent QTEST: queue not in connection or not replacing another queue"
1475
- _ -> internalErr msgId " QTEST sent not in duplex connection"
1476
- AM_EREADY_ -> pure ()
1477
- delMsgKeep (msgType == AM_A_MSG_ ) msgId
1478
- where
1498
+ _ -> internalErr msgId $ " sent " <> msgTag <> " : there is only one queue in connection"
1499
+ _ -> internalErr msgId $ " sent " <> msgTag <> " : queue not in connection or not replacing another queue"
1500
+ _ -> internalErr msgId $ msgTag <> " sent not in duplex connection"
1479
1501
setStatus status = do
1480
1502
withStore' c $ \ db -> do
1481
1503
setSndQueueStatus db sq status
@@ -2249,8 +2271,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
2249
2271
(DuplexConnection _ rqs _, Just replacedId) -> do
2250
2272
when primary . withStore' c $ \ db -> setRcvQueuePrimary db connId rq
2251
2273
case find ((replacedId == ) . dbQId) rqs of
2252
- Just rq'@ RcvQueue {server, rcvId} -> do
2253
- checkRQSwchStatus rq' RSSendingQUSE
2274
+ Just rq'@ RcvQueue {server, rcvId, rcvSwchStatus} -> do
2275
+ unless (rcvSwchStatus == Just RSSendingQUSE || rcvSwchStatus == Just RSSendingQADD ) $
2276
+ switchStatusError rq RSSendingQUSE rcvSwchStatus
2254
2277
void $ withStore' c $ \ db -> setRcvSwitchStatus db rq' $ Just RSReceivedMessage
2255
2278
enqueueCommand c " " connId (Just server) $ AInternalCommand $ ICQDelete rcvId
2256
2279
_ -> notify . ERR . AGENT $ A_QUEUE " replaced RcvQueue not found in connection"
@@ -2271,6 +2294,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
2271
2294
A_QCONT addr -> qDuplexAckDel conn'' " QCONT" $ continueSending srvMsgId addr
2272
2295
QADD qs -> qDuplexAckDel conn'' " QADD" $ qAddMsg srvMsgId qs
2273
2296
QKEY qs -> qDuplexAckDel conn'' " QKEY" $ qKeyMsg srvMsgId qs
2297
+ QSEC qs -> qDuplexAckDel conn'' " QSEC" $ qSecMsg srvMsgId qs
2274
2298
QUSE qs -> qDuplexAckDel conn'' " QUSE" $ qUseMsg srvMsgId qs
2275
2299
-- no action needed for QTEST
2276
2300
-- any message in the new queue will mark it active and trigger deletion of the old queue
@@ -2543,14 +2567,20 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
2543
2567
let (delSqs, keepSqs) = L. partition ((Just dbQueueId == ) . dbReplaceQId) sqs
2544
2568
case L. nonEmpty keepSqs of
2545
2569
Just sqs' -> do
2546
- (sq_@ SndQueue {sndPublicKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo
2570
+ (sq_@ SndQueue {sndId, sndPublicKey, sndSecure = sndSecure' }, dhPublicKey) <- lift $ newSndQueue userId connId qInfo
2547
2571
sq2 <- withStore c $ \ db -> do
2548
2572
liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
2549
2573
addConnSndQueue db connId (sq_ :: NewSndQueue ) {primary = True , dbReplaceQueueId = Just dbQueueId}
2550
2574
logServer " <--" c srv rId $ " MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
2551
- let sqInfo' = (sqInfo :: SMPQueueInfo ) {queueAddress = queueAddress {dhPublicKey}}
2552
- void . enqueueMessages c cData' sqs SMP. noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
2553
- sq1 <- withStore' c $ \ db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
2575
+ sq1 <-
2576
+ if sndSecure'
2577
+ then do
2578
+ enqueueCommand c " " connId (Just $ qServer sq2) $ AInternalCommand $ ICQSndSecure sndId
2579
+ withStore' c $ \ db -> setSndSwitchStatus db sq $ Just SSSecuringQueue
2580
+ else do
2581
+ let sqInfo' = (sqInfo :: SMPQueueInfo ) {queueAddress = queueAddress {dhPublicKey}}
2582
+ void . enqueueMessages c cData' sqs SMP. noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
2583
+ withStore' c $ \ db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
2554
2584
let sqs'' = updatedQs sq1 sqs' <> [sq2]
2555
2585
conn' = DuplexConnection cData' rqs sqs''
2556
2586
notify . SWITCH QDSnd SPStarted $ connectionStats conn'
@@ -2578,6 +2608,24 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
2578
2608
where
2579
2609
SMPQueueInfo cVer' SMPQueueAddress {smpServer, senderId, dhPublicKey} = qInfo
2580
2610
2611
+ qSecMsg :: SMP. MsgId -> NonEmpty SMPQueueInfo -> Connection 'CDuplex -> AM ()
2612
+ qSecMsg srvMsgId (qInfo :| _) conn'@ (DuplexConnection cData' rqs _) = do
2613
+ when (ratchetSyncSendProhibited cData') $ throwE $ AGENT (A_QUEUE " ratchet is not synchronized" )
2614
+ clientVRange <- asks $ smpClientVRange . config
2615
+ unless (qInfo `isCompatible` clientVRange) . throwE $ AGENT A_VERSION
2616
+ case findRQ (smpServer, senderId) rqs of
2617
+ Just rq'@ RcvQueue {e2ePrivKey = dhPrivKey, smpClientVersion = cVer, status = status'}
2618
+ | status' == New || status' == Confirmed -> do
2619
+ checkRQSwchStatus rq RSSendingQADD
2620
+ logServer " <--" c srv rId $ " MSG <QSEC>:" <> logSecret srvMsgId <> " " <> logSecret senderId
2621
+ let dhSecret = C. dh' dhPublicKey dhPrivKey
2622
+ withStore' c $ \ db -> setRcvQueueConfirmedE2E db rq' dhSecret $ min cVer cVer'
2623
+ notify . SWITCH QDRcv SPCompleted $ connectionStats conn'
2624
+ | otherwise -> qError " QSEC: queue already secured"
2625
+ _ -> qError " QSEC: queue address not found in connection"
2626
+ where
2627
+ SMPQueueInfo cVer' SMPQueueAddress {smpServer, senderId, dhPublicKey} = qInfo
2628
+
2581
2629
-- processed by queue sender
2582
2630
-- mark queue as Secured and to start sending messages to it
2583
2631
qUseMsg :: SMP. MsgId -> NonEmpty ((SMPServer , SMP. SenderId ), Bool ) -> Connection 'CDuplex -> AM ()
0 commit comments