From 0152832f8e4f198261d851253bd13f283a5f30a8 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Thu, 25 Aug 2022 16:19:42 +0100 Subject: [PATCH] add agent SWITCH event, update DH e2e key in reply queue address --- src/Simplex/Messaging/Agent.hs | 40 ++++++++++++++++--------- src/Simplex/Messaging/Agent/Protocol.hs | 35 +++++++++++++++++++--- 2 files changed, 57 insertions(+), 18 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index b88324077..0d94356d8 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -836,14 +836,18 @@ deleteConnection' c connId = atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCDelete) getConnectionServers' :: AgentMonad m => AgentClient -> ConnId -> m ConnectionStats -getConnectionServers' c connId = connServers <$> withStore c (`getConn` connId) +getConnectionServers' c connId = do + SomeConn _ conn <- withStore c (`getConn` connId) + -- TODO load next queues + pure $ connectionStats conn Nothing Nothing + +connectionStats :: Connection c -> Maybe RcvQueue -> Maybe SndQueue -> ConnectionStats +connectionStats conn nextRq_ nextSq_ = case conn of + RcvConnection _ rq -> ConnectionStats {rcvServers = rcvSrvs rq, sndServers = [], nextRcvServers = [], nextSndServers = []} + SndConnection _ sq -> ConnectionStats {rcvServers = [], sndServers = sndSrvs sq, nextRcvServers = [], nextSndServers = []} + DuplexConnection _ rq sq -> ConnectionStats {rcvServers = rcvSrvs rq, sndServers = sndSrvs sq, nextRcvServers = maybe [] rcvSrvs nextRq_, nextSndServers = maybe [] sndSrvs nextSq_} + ContactConnection _ rq -> ConnectionStats {rcvServers = rcvSrvs rq, sndServers = [], nextRcvServers = [], nextSndServers = []} where - connServers :: SomeConn -> ConnectionStats - connServers = \case - SomeConn _ (RcvConnection _ rq) -> ConnectionStats {rcvServers = rcvSrvs rq, sndServers = []} - SomeConn _ (SndConnection _ sq) -> ConnectionStats {rcvServers = [], sndServers = sndSrvs sq} - SomeConn _ (DuplexConnection _ rq sq) -> ConnectionStats {rcvServers = rcvSrvs rq, sndServers = sndSrvs sq} - SomeConn _ (ContactConnection _ rq) -> ConnectionStats {rcvServers = rcvSrvs rq, sndServers = []} rcvSrvs RcvQueue {server} = [server] sndSrvs SndQueue {server} = [server] @@ -1296,16 +1300,19 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm -- processed by queue sender rqNewMsg :: (SMPServer, SMP.SenderId) -> SMPQueueUri -> m () rqNewMsg _currAddr nextQUri = case conn of - DuplexConnection _ _ sq -> do + DuplexConnection _ rq sq -> do clientVRange <- asks $ smpClientVRange . config case (nextQUri `compatibleVersion` clientVRange) of - Just qInfo@(Compatible nextQueueInfo) -> do - sq'@SndQueue {sndPublicKey} <- newSndQueue qInfo + Just qInfo@(Compatible nextQInfo) -> do + sq'@SndQueue {sndPublicKey, e2ePubKey} <- newSndQueue qInfo withStore' c $ \db -> dbCreateNextSndQueue db sq sq' - case sndPublicKey of - Just nextSenderKey -> + rq' <- withStore' c (`getNextRcvQueue` dbNextRcvQueueId rq) + case (sndPublicKey, e2ePubKey) of + (Just nextSenderKey, Just dhPublicKey) -> do + let qAddr = (queueAddress (nextQInfo :: SMPQueueInfo)) {dhPublicKey} + nextQueueInfo = (nextQInfo :: SMPQueueInfo) {queueAddress = qAddr} void . enqueueMessage c cData sq SMP.noMsgFlags $ QKEYS {nextSenderKey, nextQueueInfo} - -- TODO possibly, notify user that send queue is rotating + notify . SWITCH SPStarted $ connectionStats conn rq' (Just sq') _ -> do -- TODO notify user: internal error pure () @@ -1318,7 +1325,12 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm -- processed by queue recipient rqKeys :: SndPublicVerifyKey -> SMPQueueInfo -> m () -> m () - rqKeys _sKey _nextQInfo ackDelete = do + rqKeys _sKey (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey}) ackDelete = do + -- withStore c (`getNextRcvQueue` dbNextRcvQueueId rq) >>= \case + -- Just rq' + -- | -> do + -- | otherwise + -- store sender keys -- new rcv queue status = Confirmed -- old rcv_queue_action = RQASecureNewQueue diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 60f17098b..f7a6b893d 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -45,6 +45,7 @@ module Simplex.Messaging.Agent.Protocol SAParty (..), MsgHash, MsgMeta (..), + SwitchPhase (..), ConnectionStats (..), SMPConfirmation (..), AgentMsgEnvelope (..), @@ -235,6 +236,7 @@ data ACommand (p :: AParty) where DISCONNECT :: AProtocolType -> TransportHost -> ACommand Agent DOWN :: SMPServer -> [ConnId] -> ACommand Agent UP :: SMPServer -> [ConnId] -> ACommand Agent + SWITCH :: SwitchPhase -> ConnectionStats -> ACommand Agent SEND :: MsgFlags -> MsgBody -> ACommand Client MID :: AgentMsgId -> ACommand Agent SENT :: AgentMsgId -> ACommand Agent @@ -253,19 +255,41 @@ deriving instance Eq (ACommand p) deriving instance Show (ACommand p) +data SwitchPhase = SPStarted | SPCompleted + deriving (Eq, Show) + +instance StrEncoding SwitchPhase where + strEncode = \case + SPStarted -> "started" + SPCompleted -> "completed" + strP = + A.takeTill (== ' ') >>= \case + "started" -> pure SPStarted + "completed" -> pure SPCompleted + _ -> fail "bad SwitchPhase" + data ConnectionStats = ConnectionStats { rcvServers :: [SMPServer], - sndServers :: [SMPServer] + sndServers :: [SMPServer], + nextRcvServers :: [SMPServer], + nextSndServers :: [SMPServer] } deriving (Eq, Show, Generic) instance StrEncoding ConnectionStats where - strEncode ConnectionStats {rcvServers, sndServers} = - "rcv=" <> strEncodeList rcvServers <> " snd=" <> strEncodeList sndServers + strEncode s = + B.unwords + [ "rcv=" <> strEncodeList (rcvServers s), + "snd=" <> strEncodeList (sndServers s), + "next_rcv=" <> strEncodeList (nextRcvServers s), + "next_snd=" <> strEncodeList (nextSndServers s) + ] strP = do rcvServers <- "rcv=" *> strListP sndServers <- " snd=" *> strListP - pure ConnectionStats {rcvServers, sndServers} + nextRcvServers <- " next_rcv=" *> strListP + nextSndServers <- " next_snd=" *> strListP + pure ConnectionStats {rcvServers, sndServers, nextRcvServers, nextSndServers} instance ToJSON ConnectionStats where toEncoding = J.genericToEncoding J.defaultOptions @@ -1010,6 +1034,7 @@ commandP = <|> "DISCONNECT " *> disconnectResp <|> "DOWN " *> downResp <|> "UP " *> upResp + <|> "SWITCH " *> switchResp <|> "SEND " *> sendCmd <|> "MID " *> msgIdResp <|> "SENT " *> sentResp @@ -1037,6 +1062,7 @@ commandP = disconnectResp = ACmd SAgent .: DISCONNECT <$> strP_ <*> strP downResp = ACmd SAgent .: DOWN <$> strP_ <*> connections upResp = ACmd SAgent .: UP <$> strP_ <*> connections + switchResp = ACmd SAgent .: SWITCH <$> strP_ <*> strP sendCmd = ACmd SClient .: SEND <$> smpP <* A.space <*> A.takeByteString msgIdResp = ACmd SAgent . MID <$> A.decimal sentResp = ACmd SAgent . SENT <$> A.decimal @@ -1075,6 +1101,7 @@ serializeCommand = \case DISCONNECT p h -> B.unwords ["DISCONNECT", strEncode p, strEncode h] DOWN srv conns -> B.unwords ["DOWN", strEncode srv, connections conns] UP srv conns -> B.unwords ["UP", strEncode srv, connections conns] + SWITCH phase srvs -> B.unwords ["SWITCH", strEncode phase, strEncode srvs] SEND msgFlags msgBody -> "SEND " <> smpEncode msgFlags <> " " <> serializeBinary msgBody MID mId -> "MID " <> bshow mId SENT mId -> "SENT " <> bshow mId