rfc: faster handshake protocol (#1203)

* rfc: faster handshake protocol

* update

* 1 message

* SKEY

* use SKEY for both parties

* test

* update doc

* NEW command parameter

* add k=s param to queue URI

* fix

* add sndSecure field to queues

* make sender key non-optional in SndQueue (WIP, tests fail)

* fast handshake sometimes works (many tests fail)

* correctly handle SKEY retries, avoiding to re-generate the keys

* handle SKEY retries during async connection

* fix most tests (1 test fails)

* remove do

* fix contact requests encoding/tests

* export

* fix: ignore duplicate confirmations, fixes testBatchedPendingMessages

* do not store sndSecure in store log if it is false to allow server downgrade

* add connection invitation encoding tests
This commit is contained in:
Evgeny Poberezkin
2024-06-30 08:36:24 +01:00
committed by GitHub
parent c788692687
commit 9ee684b0f4
30 changed files with 1184 additions and 779 deletions
@@ -0,0 +1,63 @@
sequenceDiagram
participant A as Alice
participant AA as Alice's<br>agent
participant AS as Alice's<br>server
participant BS as Bob's<br>server
participant BA as Bob's<br>agent
participant B as Bob
note over AA, BA: status (receive/send): NONE/NONE
note over A, AA: 1. request connection<br>from agent
A ->> AA: NEW: create<br>duplex connection
note over AA, AS: 2. create Alice's SMP queue
AA ->> AS: NEW: create SMP queue
AS ->> AA: IDS: SMP queue IDs
note over AA: status: NEW/NONE
AA ->> A: INV: invitation<br>to connect
note over A, B: 3. out-of-band invitation
A ->> B: OOB: invitation to connect
note over BA, B: 4. accept connection
B ->> BA: JOIN:<br>via invitation info
note over BA: status: NONE/NEW
note over BA, AS: 5. secure Alice's SMP queue
BA ->> AS: SKEY: secure queue (this command needs to be proxied)
note over BA: status: NONE/SECURED
note over BA, BS: 6. create Bob's SMP queue
BA ->> BS: NEW: create SMP queue
BS ->> BA: IDS: SMP queue IDs
note over BA: status: NEW/SECURED
note over BA, AA: 7. confirm Alice's SMP queue
BA ->> AS: SEND: Bob's info without sender's key (SMP confirmation with reply queues)
note over BA: status: NEW/CONFIRMED
AS ->> AA: MSG: Bob's info without<br>sender server key
note over AA: status: CONFIRMED/NEW
AA ->> AS: ACK: confirm message
note over AA, BS: 8. secure Bob's SMP queue
AA ->> BS: SKEY: secure queue (this command needs to be proxied)
note over BA: status: CONFIRMED/SECURED
AA ->> BS: SEND: Alice's info without sender's server key (SMP confirmation without reply queues)
note over AA: status: CONFIRMED/CONFIRMED
note over AA, A: 9. notify Alice<br>about connection success<br>(no HELLO needed in v6)
AA ->> A: CON: connected
note over AA: status: ACTIVE/ACTIVE
BS ->> BA: MSG: Alice's info without<br>sender's server key
note over BA: status: CONFIRMED/CONFIRMED
BA ->> B: INFO: Alice's info
BA ->> BS: ACK: confirm message
note over BA, B: 10. notify Bob<br>about connection success
BA ->> B: CON: connected
note over BA: status: ACTIVE/ACTIVE
+42
View File
@@ -0,0 +1,42 @@
# Faster connection establishment
## Problem
SMP protocol is unidirectional, and to create a connection users have to agree two messaging queues.
V1 of handshake protocol required 5 messages and multiple HELLO sent between the users, which consumed a lot of traffic.
V2 of handshake protocol was optimized to remove multiple HELLO and also REPLY message, thanks to including queue address together with the key to secure this queue into the confirmation message.
This eliminated unnecessary traffic from repeated HELLOs, but still requires 4 messages in total and 2 times of each client being online. It is perceived by the users as "it didn't work" (because they see "connecting" after using the link) or "we have to be online at the same time" (and even in this case it is slow on bad network). This hurts usability and creates churn of the new users, as unless people are onboarded by the friends who know how the app works, they cannot figure out how to connect.
Ideally, we want to have handshake protocol design when an accepting user can send messages straight after using the link (their client says "connected") and the initiating client can send messages as soon as it received confirmation message with the profile.
This RFC proposes modifications to SMP and SMP Agent protocols to reduce the number of required messages to 2 and allows accepting client to send messages straight after using the link (and sending the confirmation), before receiving the profile of the initiating client in the second message, and the initiating client can send the messages straight after processing the confirmation and sending its own confirmation.
## Solution
The current protocol design allows additional confirmation step where the initiating client can confirm the connection having received the profile of the sender. We don't use it in the UI - this confirmation is done automatically and unconditionally.
Instead of requiring the initiating client to secure its queue with sender's key, we can allow the accepting client to secure it with the additional SKEY command. This would avoid "connecting" state but would introduce "Profile unknown" state where the accepting client does not yet have the profile of the initiating client. In this case we could also use the non-optional alias created during the connection (or have something like "Add alias to be able to send messages immediately" and show warning if the user proceeds without it).
The additional advantage here is that if the queue of the initiating client was removed, the connection will not procede to create additional queue, failing faster.
These are the proposed changes:
1. Modify NEW command to add flag allowing sender to secure the queue (it should not be allowed if queue is created for the contact address).
2. Include flag into the invitation link URI and in reply address encoding that queue(s) can be secured by the sender (to avoid coupling with the protocol version and preserve the possibility of the longer handshakes).
3. Add SKEY command to SMP protocol to allow the sender securing the message queue.
4. This command has to be supported by SMP proxy as well, so that the sender does not connect to the recipient's server directly.
5. Accepting client will secure the messaging queue before sending the confirmation to it.
6. Initiating client will secure the messaging queue before sending the confirmation.
See [this sequence diagram](../protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd) for the updated handshake protocol.
Changes to threat model: the attacker who compromised TLS and knows the queue address can block the connection, as the protocol no longer requires the recipient to decrypt the confirmation to secure the queue.
Possibly, "fast connection" should be an option in Privacy & security settings.
## Implementation questions
Currently we store received confirmations in the database, so that the client can confirm them. This becomes unnecessary.
+1
View File
@@ -134,6 +134,7 @@ library
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
Simplex.Messaging.Agent.TRcvQueues
Simplex.Messaging.Client
Simplex.Messaging.Client.Agent
+131 -79
View File
@@ -175,7 +175,7 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfReg
import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
import Simplex.Messaging.Notifications.Types
import Simplex.Messaging.Parsers (parse)
import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, XFTPServerWithAuth)
import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, XFTPServerWithAuth, sndAuthKeySMPClientVersion)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Server.QueueStore.QueueInfo
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
@@ -751,7 +751,8 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
(SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
_ -> pure ()
AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
(rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srvWithAuth smpClientVRange subMode `catchAgentError` \e -> liftIO (print e) >> throwE e
let sndSecure = case cMode of SCMInvitation -> True; SCMContact -> False
(rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srvWithAuth smpClientVRange subMode sndSecure `catchAgentError` \e -> liftIO (print e) >> throwE e
atomically $ incSMPServerStat c userId srv connCreated
rq' <- withStore c $ \db -> updateNewConnRcv db connId rq
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
@@ -771,7 +772,7 @@ newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> Connection
newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
CRInvitationUri {} ->
lift (compatibleInvitationUri cReq) >>= \case
Just (_, (Compatible (CR.E2ERatchetParams v _ _ _)), aVersion) -> create aVersion (Just v)
Just (_, Compatible (CR.E2ERatchetParams v _ _ _), aVersion) -> create aVersion (Just v)
Nothing -> throwE $ AGENT A_VERSION
CRContactUri {} ->
lift (compatibleContactUri cReq) >>= \case
@@ -793,10 +794,10 @@ joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do
_ -> getSMPServer c userId
joinConnSrv c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode srv
startJoinInvitation :: UserId -> ConnId -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, NewSndQueue, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448)
startJoinInvitation userId connId enableNtfs cReqUri pqSup =
startJoinInvitation :: UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, NewSndQueue, C.PublicKeyX25519, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448)
startJoinInvitation userId connId sq_ enableNtfs cReqUri pqSup =
lift (compatibleInvitationUri cReqUri) >>= \case
Just (qInfo, (Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_)), Compatible connAgentVersion) -> do
Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_), Compatible connAgentVersion) -> do
g <- asks random
let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
(pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
@@ -805,9 +806,13 @@ startJoinInvitation userId connId enableNtfs cReqUri pqSup =
maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
let rcVs = CR.RatchetVersions {current = v, maxSupported}
rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
q <- lift $ newSndQueue userId "" qInfo
-- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out
-- e2ePubKey is always present, it's Maybe historically
(q, e2ePubKey) <- case sq_ of
Just sq@SndQueue {e2ePubKey = Just k} -> pure ((sq :: SndQueue) {dbQueueId = DBNewQueue}, k)
_ -> lift $ newSndQueue userId "" qInfo
let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
pure (cData, q, rc, e2eSndParams)
pure (cData, q, e2ePubKey, rc, e2eSndParams)
Nothing -> throwE $ AGENT A_VERSION
connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport))
@@ -843,7 +848,7 @@ versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && ma
joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId
joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv =
withInvLock c (strEncode inv) "joinConnSrv" $ do
(cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSup
(cData, q, _, rc, e2eSndParams) <- startJoinInvitation userId connId Nothing enableNtfs inv pqSup
g <- asks random
(connId', sq) <- withStore c $ \db -> runExceptT $ do
r@(connId', _) <-
@@ -853,7 +858,10 @@ joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo p
liftIO $ createRatchet db connId' rc
pure r
let cData' = (cData :: ConnData) {connId = connId'}
tryError (confirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
-- joinConnSrv is only used on user interaction, and its failure is permanent,
-- otherwise we would need to manage retries here to avoid SndQueue recreated with a different key,
-- similar to how joinConnAsync does that.
tryError (secureConfirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
Right _ -> pure connId'
Left e -> do
-- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
@@ -869,17 +877,26 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ()
joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do
(cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSupport
q' <- withStore c $ \db -> runExceptT $ do
liftIO $ createRatchet db connId rc
ExceptT $ updateNewConnSnd db connId q
confirmQueueAsync c cData q' srv cInfo (Just e2eSndParams) subMode
SomeConn cType conn <- withStore c (`getConn` connId)
case conn of
NewConnection _ -> doJoin Nothing
SndConnection _ sq -> doJoin $ Just sq
_ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType
where
doJoin :: Maybe SndQueue -> AM ()
doJoin sq_ = do
(cData, sq, _, rc, e2eSndParams) <- startJoinInvitation userId connId sq_ enableNtfs inv pqSupport
sq' <- withStore c $ \db -> runExceptT $ do
liftIO $ createRatchet db connId rc
maybe (ExceptT $ updateNewConnSnd db connId sq) pure sq_
secureConfirmQueueAsync c cData sq' srv cInfo (Just e2eSndParams) subMode
joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do
throwE $ CMD PROHIBITED "joinConnSrvAsync"
createReplyQueue :: AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
(rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) subMode
let sndSecure = smpClientVersion >= sndAuthKeySMPClientVersion
(rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) subMode sndSecure
let qInfo = toVersionT qUri smpClientVersion
rq' <- withStore c $ \db -> upgradeSndConnToDuplex db connId rq
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
@@ -1156,8 +1173,11 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
withStore c $ \db -> runExceptT $ (,) <$> ExceptT (getConn db connId) <*> ExceptT (getAcceptedConfirmation db connId)
case conn of
RcvConnection cData rq -> do
secure rq senderKey
mapM_ (connectReplyQueues c cData ownConnInfo) (L.nonEmpty $ smpReplyQueues senderConf)
mapM_ (secure rq) senderKey
mapM_ (connectReplyQueues c cData ownConnInfo Nothing) (L.nonEmpty $ smpReplyQueues senderConf)
-- duplex connection is matched to handle SKEY retries
DuplexConnection cData _ (sq :| _) ->
mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)
_ -> throwE $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
secure rq senderKey
@@ -1332,7 +1352,7 @@ submitPendingMsg c cData sq = do
void $ getDeliveryWorker True c cData sq
runSmpQueueMsgDelivery :: AgentClient -> ConnData -> SndQueue -> (Worker, TMVar ()) -> AM ()
runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userId, server} (Worker {doWork}, qLock) = do
runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userId, server, sndSecure} (Worker {doWork}, qLock) = do
AgentConfig {messageRetryInterval = ri, messageTimeout, helloTimeout, quotaExceededTimeout} <- asks config
forever $ do
atomically $ endAgentOperation c AOSndNetwork
@@ -1380,7 +1400,6 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
Just _ -> connError msgId NOT_AVAILABLE
-- party joining connection
_ -> connError msgId NOT_ACCEPTED
AM_REPLY_ -> notifyDel msgId err
AM_A_MSG_ -> notifyDel msgId err
AM_A_RCVD_ -> notifyDel msgId err
AM_QCONT_ -> notifyDel msgId err
@@ -1409,10 +1428,11 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
retrySndOp c $ loop riMode
Right proxySrv_ -> do
case msgType of
AM_CONN_INFO -> setConfirmed
AM_CONN_INFO_REPLY -> setConfirmed
AM_CONN_INFO
| sndSecure -> notify (CON pqEncryption) >> setStatus Active
| otherwise -> setStatus Confirmed
AM_CONN_INFO_REPLY -> setStatus Confirmed
AM_RATCHET_INFO -> pure ()
AM_REPLY_ -> pure ()
AM_HELLO_ -> do
withStore' c $ \db -> setSndQueueStatus db sq Active
case rq_ of
@@ -1469,9 +1489,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
AM_EREADY_ -> pure ()
delMsgKeep (msgType == AM_A_MSG_) msgId
where
setConfirmed = do
setStatus status = do
withStore' c $ \db -> do
setSndQueueStatus db sq Confirmed
setSndQueueStatus db sq status
when (isJust rq_) $ removeConfirmations db connId
where
notifyDelMsgs :: InternalId -> AgentErrorType -> UTCTime -> AM ()
@@ -1558,13 +1578,14 @@ switchConnection' c connId =
_ -> throwE $ CMD PROHIBITED "switchConnection: not duplex"
switchDuplexConnection :: AgentClient -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBQueueId dbQueueId, sndId} = do
switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId, connAgentVersion} rqs sqs) rq@RcvQueue {server, dbQueueId = DBQueueId dbQueueId, sndId} = do
checkRQSwchStatus rq RSSwitchStarted
clientVRange <- asks $ smpClientVRange . config
-- try to get the server that is different from all queues, or at least from the primary rcv queue
srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
srv' <- if srv == server then getNextServer c userId [server] else pure srvAuth
(q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SMSubscribe
let sndSecure = connAgentVersion >= sndAuthKeySMPAgentVersion
(q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SMSubscribe sndSecure
let rq' = (q :: NewRcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq'
lift $ addNewQueueSubscription c rq'' tSess sessId
@@ -2191,7 +2212,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
notifyErr connId = notify' connId . ERR . protocolClientError SMP (B.unpack $ strEncode srv)
processSMP :: forall c. RcvQueue -> Connection c -> ConnData -> BrokerMsg -> AM ()
processSMP
rq@RcvQueue {rcvId = rId, e2ePrivKey, e2eDhSecret, status}
rq@RcvQueue {rcvId = rId, sndSecure, e2ePrivKey, e2eDhSecret, status}
conn
cData@ConnData {userId, connId, connAgentVersion, ratchetSyncState = rss}
smpMsg =
@@ -2220,7 +2241,10 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
let e2eDh = C.dh' e2ePubKey e2ePrivKey
decryptClientMessage e2eDh clientMsg >>= \case
(SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) ->
smpConfirmation srvMsgId conn senderKey e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack
smpConfirmation srvMsgId conn (Just senderKey) e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack
(SMP.PHEmpty, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion})
| sndSecure -> smpConfirmation srvMsgId conn Nothing e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack
| otherwise -> prohibited "handshake: missing sender key" >> ack
(SMP.PHEmpty, AgentInvitation {connReq, connInfo}) ->
smpInvitation srvMsgId conn connReq connInfo >> ack
_ -> prohibited "handshake: incorrect state" >> ack
@@ -2348,7 +2372,12 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
pure $ Just (internalId, msgMeta, aMessage, rc)
_ -> pure Nothing
_ -> prohibited "msg: bad client msg" >> ack
_ -> prohibited "msg: no keys" >> ack
(Just e2eDh, Just _) ->
decryptClientMessage e2eDh clientMsg >>= \case
-- this is a repeated confirmation delivery because ack failed to be sent
(_, AgentConfirmation {}) -> ack
_ -> prohibited "msg: public header" >> ack
(Nothing, Nothing) -> prohibited "msg: no keys" >> ack
updateConnVersion :: Connection c -> ConnData -> VersionSMPA -> AM (Connection c)
updateConnVersion conn' cData' msgAgentVersion = do
aVRange <- asks $ smpAgentVRange . config
@@ -2385,8 +2414,10 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
notify :: forall e m. (AEntityI e, MonadIO m) => AEvent e -> m ()
notify = notify' connId
prohibited :: String -> AM ()
prohibited = notify . ERR . AGENT . A_PROHIBITED
prohibited :: Text -> AM ()
prohibited s = do
logError $ "prohibited: " <> s
notify . ERR . AGENT $ A_PROHIBITED $ T.unpack s
enqueueCmd :: InternalCommand -> AM ()
enqueueCmd = enqueueCommand c "" connId (Just srv) . AInternalCommand
@@ -2413,7 +2444,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
parseMessage :: Encoding a => ByteString -> AM a
parseMessage = liftEither . parse smpP (AGENT A_MESSAGE)
smpConfirmation :: SMP.MsgId -> Connection c -> C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM ()
smpConfirmation :: SMP.MsgId -> Connection c -> Maybe C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM ()
smpConfirmation srvMsgId conn' senderKey e2ePubKey e2eEncryption encConnInfo smpClientVersion agentVersion = do
logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret srvMsgId
AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
@@ -2436,8 +2467,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
case (agentMsgBody_, skipped) of
(Right agentMsgBody, CR.SMDNoChange) ->
parseMessage agentMsgBody >>= \case
AgentConnInfoReply smpQueues connInfo ->
AgentConnInfoReply smpQueues connInfo -> do
processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion}
withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody)
_ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2
where
processConf connInfo senderConf = do
@@ -2450,14 +2482,21 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
notify $ CONF confId pqSupport' srvs connInfo
_ -> prohibited "conf: decrypt error or skipped"
-- party accepting connection
(DuplexConnection _ (RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do
(DuplexConnection _ (rq'@RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do
g <- asks random
withStore c (\db -> runExceptT $ agentRatchetDecrypt g db connId encConnInfo) >>= parseMessage . fst >>= \case
(agentMsgBody, pqEncryption) <- withStore c $ \db -> runExceptT $ agentRatchetDecrypt g db connId encConnInfo
parseMessage agentMsgBody >>= \case
AgentConnInfo connInfo -> do
notify $ INFO pqSupport connInfo
let dhSecret = C.dh' e2ePubKey e2ePrivKey
withStore' c $ \db -> setRcvQueueConfirmedE2E db rq dhSecret $ min v' smpClientVersion
enqueueCmd $ ICDuplexSecure rId senderKey
withStore' c $ \db -> do
setRcvQueueConfirmedE2E db rq dhSecret $ min v' smpClientVersion
updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody)
case senderKey of
Just k -> enqueueCmd $ ICDuplexSecure rId k
Nothing -> do
notify $ CON pqEncryption
withStore' c $ \db -> setRcvQueueStatus db rq' Active
_ -> prohibited "conf: not AgentConnInfo"
_ -> prohibited "conf: incorrect state"
_ -> prohibited "conf: status /= new"
@@ -2533,21 +2572,17 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
let (delSqs, keepSqs) = L.partition ((Just dbQueueId ==) . dbReplaceQId) sqs
case L.nonEmpty keepSqs of
Just sqs' -> do
-- move inside case?
sq_@SndQueue {sndPublicKey, e2ePubKey} <- lift $ newSndQueue userId connId qInfo
(sq_@SndQueue {sndPublicKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo
sq2 <- withStore c $ \db -> do
liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
case (sndPublicKey, e2ePubKey) of
(Just sndPubKey, Just dhPublicKey) -> do
logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPubKey)]
sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
let sqs'' = updatedQs sq1 sqs' <> [sq2]
conn' = DuplexConnection cData' rqs sqs''
notify . SWITCH QDSnd SPStarted $ connectionStats conn'
_ -> qError "absent sender keys"
logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
let sqs'' = updatedQs sq1 sqs' <> [sq2]
conn' = DuplexConnection cData' rqs sqs''
notify . SWITCH QDSnd SPStarted $ connectionStats conn'
_ -> qError "QADD: won't delete all snd queues in connection"
_ -> qError "QADD: replaced queue address is not found in connection"
_ -> throwE $ AGENT A_VERSION
@@ -2717,23 +2752,30 @@ switchStatusError q expected actual =
<> (", expected=" <> show expected)
<> (", actual=" <> show actual)
connectReplyQueues :: AgentClient -> ConnData -> ConnInfo -> NonEmpty SMPQueueInfo -> AM ()
connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo (qInfo :| _) = do
connectReplyQueues :: AgentClient -> ConnData -> ConnInfo -> Maybe SndQueue -> NonEmpty SMPQueueInfo -> AM ()
connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _) = do
clientVRange <- asks $ smpClientVRange . config
case qInfo `proveCompatible` clientVRange of
Nothing -> throwE $ AGENT A_VERSION
Just qInfo' -> do
sq <- lift $ newSndQueue userId connId qInfo'
sq' <- withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
-- in case of SKEY retry the connection is already duplex
sq' <- maybe upgradeConn pure sq_
agentSecureSndQueue c sq'
enqueueConfirmation c cData sq' ownConnInfo Nothing
where
upgradeConn = do
(sq, _) <- lift $ newSndQueue userId connId qInfo'
withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
confirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
confirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
secureConfirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
agentSecureSndQueue c sq
storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode
lift $ submitPendingMsg c cData sq
confirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
confirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
agentSecureSndQueue c sq
msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode
void $ sendConfirmation c sq msg
withStore' c $ \db -> setSndQueueStatus db sq Confirmed
@@ -2742,11 +2784,19 @@ confirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connI
mkConfirmation aMessage = do
currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
withStore c $ \db -> runExceptT $ do
void . liftIO $ updateSndIds db connId
let agentMsgBody = smpEncode aMessage
(_, internalSndId, _) <- liftIO $ updateSndIds db connId
liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody)
let pqEnc = CR.pqSupportToEnc pqSupport
(encConnInfo, _) <- agentRatchetEncrypt db cData (smpEncode aMessage) e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
(encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo}
agentSecureSndQueue :: AgentClient -> SndQueue -> AM ()
agentSecureSndQueue c sq@SndQueue {sndSecure, status} =
when (sndSecure && status == New) $ do
secureSndQueue c sq
withStore' c $ \db -> setSndQueueStatus db sq Secured
mkAgentConfirmation :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> AM AgentMessage
mkAgentConfirmation c cData sq srv connInfo subMode = do
qInfo <- createReplyQueue c cData sq subMode srv
@@ -2822,26 +2872,28 @@ agentRatchetDecrypt' g db connId rc encAgentMsg = do
liftIO $ updateRatchet db connId rc' skippedDiff
liftEither $ bimap (SEAgentError . cryptoError) (,CR.rcRcvKEM rc') agentMsgBody_
newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> AM' NewSndQueue
newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey = rcvE2ePubDhKey})) = do
newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> AM' (NewSndQueue, C.PublicKeyX25519)
newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, sndSecure, dhPublicKey = rcvE2ePubDhKey})) = do
C.AuthAlg a <- asks $ sndAuthAlg . config
g <- asks random
(sndPublicKey, sndPrivateKey) <- atomically $ C.generateAuthKeyPair a g
(e2ePubKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
pure
SndQueue
{ userId,
connId,
server = smpServer,
sndId = senderId,
sndPublicKey = Just sndPublicKey,
sndPrivateKey,
e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
e2ePubKey = Just e2ePubKey,
status = New,
dbQueueId = DBNewQueue,
primary = True,
dbReplaceQueueId = Nothing,
sndSwchStatus = Nothing,
smpClientVersion
}
let sq =
SndQueue
{ userId,
connId,
server = smpServer,
sndId = senderId,
sndSecure,
sndPublicKey,
sndPrivateKey,
e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
e2ePubKey = Just e2ePubKey,
status = New,
dbQueueId = DBNewQueue,
primary = True,
dbReplaceQueueId = Nothing,
sndSwchStatus = Nothing,
smpClientVersion
}
pure (sq, e2ePubKey)
+23 -12
View File
@@ -53,6 +53,7 @@ module Simplex.Messaging.Agent.Client
temporaryOrHostError,
serverHostError,
secureQueue,
secureSndQueue,
enableQueueNotifications,
enableQueuesNtfs,
disableQueueNotifications,
@@ -73,7 +74,6 @@ module Simplex.Messaging.Agent.Client
agentXFTPUploadChunk,
agentXFTPAddRecipients,
agentXFTPDeleteChunk,
agentCbEncrypt,
agentCbDecrypt,
cryptoError,
sendAck,
@@ -240,6 +240,7 @@ import Simplex.Messaging.Protocol
RcvNtfPublicDhKey,
SMPMsgMeta (..),
SProtocolType (..),
SenderCanSecure,
SndPublicAuthKey,
SubscriptionMode (..),
UserProtocol,
@@ -1196,11 +1197,14 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
Right smp -> do
rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
(sKey, _) <- atomically $ C.generateAuthKeyPair sa g
(sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
(dhKey, _) <- atomically $ C.generateKeyPair g
r <- runExceptT $ do
SMP.QIK {rcvId} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp rKeys dhKey auth SMSubscribe
liftError (testErr TSSecureQueue) $ secureSMPQueue smp rpKey rcvId sKey
SMP.QIK {rcvId, sndId, sndSecure} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp rKeys dhKey auth SMSubscribe True
liftError (testErr TSSecureQueue) $
if sndSecure
then secureSndSMPQueue smp spKey sndId sKey
else secureSMPQueue smp rpKey rcvId sKey
liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp rpKey rcvId
ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient smp
pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
@@ -1307,8 +1311,8 @@ getSessionMode :: AgentClient -> IO TransportSessionMode
getSessionMode = atomically . fmap sessionMode . getNetworkConfig
{-# INLINE getSessionMode #-}
newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SubscriptionMode -> SenderCanSecure -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode senderCanSecure = do
C.AuthAlg a <- asks (rcvAuthAlg . config)
g <- asks random
rKeys@(_, rcvPrivateKey) <- atomically $ C.generateAuthKeyPair a g
@@ -1316,9 +1320,9 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
(e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
logServer "-->" c srv "" "NEW"
tSess <- liftIO $ mkTransportSession c userId srv connId
(sessId, QIK {rcvId, sndId, rcvPublicDhKey}) <-
(sessId, QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}) <-
withClient c tSess "NEW" $ \(SMPConnectedClient smp _) ->
(sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode
(sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode senderCanSecure
liftIO . logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
let rq =
RcvQueue
@@ -1331,6 +1335,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
e2ePrivKey,
e2eDhSecret = Nothing,
sndId,
sndSecure,
status = New,
dbQueueId = DBNewQueue,
primary = True,
@@ -1340,7 +1345,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
clientNtfCreds = Nothing,
deleteErrors = 0
}
qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey
qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey sndSecure
pure (rq, qUri, tSess, sessId)
processSubResult :: AgentClient -> RcvQueue -> Either SMPClientError () -> STM ()
@@ -1524,10 +1529,11 @@ logSecret bs = encode $ B.take 3 bs
{-# INLINE logSecret #-}
sendConfirmation :: AgentClient -> SndQueue -> ByteString -> AM (Maybe SMPServer)
sendConfirmation c sq@SndQueue {userId, server, sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
sendConfirmation c sq@SndQueue {userId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
let (privHdr, spKey) = if sndSecure then (SMP.PHEmpty, Just sndPrivateKey) else (SMP.PHConfirmation sndPublicKey, Nothing)
clientMsg = SMP.ClientMessage privHdr agentConfirmation
msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
sendOrProxySMPMessage c userId server "<CONF>" Nothing sndId (MsgFlags {notification = True}) msg
sendOrProxySMPMessage c userId server "<CONF>" spKey sndId (MsgFlags {notification = True}) msg
sendConfirmation _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
sendInvitation :: AgentClient -> UserId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
@@ -1568,6 +1574,11 @@ secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
withSMPClient c rq "KEY <key>" $ \smp ->
secureSMPQueue smp rcvPrivateKey rcvId senderKey
secureSndQueue :: AgentClient -> SndQueue -> AM ()
secureSndQueue c sq@SndQueue {sndId, sndPrivateKey, sndPublicKey} =
withSMPClient c sq "SKEY <key>" $ \smp ->
secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey
enableQueueNotifications :: AgentClient -> RcvQueue -> SMP.NtfPublicAuthKey -> SMP.RcvNtfPublicDhKey -> AM (SMP.NotifierId, SMP.RcvNtfPublicDhKey)
enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtfPublicDhKey =
withSMPClient c rq "NKEY <nkey>" $ \smp ->
+39 -21
View File
@@ -41,6 +41,7 @@ module Simplex.Messaging.Agent.Protocol
ratchetSyncSMPAgentVersion,
deliveryRcptsSMPAgentVersion,
pqdrSMPAgentVersion,
sndAuthKeySMPAgentVersion,
currentSMPAgentVersion,
supportedSMPAgentVRange,
e2eEncConnInfoLength,
@@ -208,6 +209,7 @@ import Simplex.Messaging.Protocol
legacyStrEncodeServer,
noAuthSrv,
sameSrvAddr,
sndAuthKeySMPClientVersion,
srvHostnamesSMPClientVersion,
pattern ProtoServerWithAuth,
pattern SMPServer,
@@ -227,6 +229,7 @@ import UnliftIO.Exception (Exception)
-- 3 - support ratchet renegotiation (6/30/2023)
-- 4 - delivery receipts (7/13/2023)
-- 5 - post-quantum double ratchet (3/14/2024)
-- 6 - secure reply queues with provided keys (6/14/2024)
data SMPAgentVersion
@@ -251,11 +254,17 @@ deliveryRcptsSMPAgentVersion = VersionSMPA 4
pqdrSMPAgentVersion :: VersionSMPA
pqdrSMPAgentVersion = VersionSMPA 5
sndAuthKeySMPAgentVersion :: VersionSMPA
sndAuthKeySMPAgentVersion = VersionSMPA 6
minSupportedSMPAgentVersion :: VersionSMPA
minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion
currentSMPAgentVersion :: VersionSMPA
currentSMPAgentVersion = VersionSMPA 5
currentSMPAgentVersion = VersionSMPA 6
supportedSMPAgentVRange :: VersionRangeSMPA
supportedSMPAgentVRange = mkVersionRange duplexHandshakeSMPAgentVersion currentSMPAgentVersion
supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion
-- it is shorter to allow all handshake headers,
-- including E2E (double-ratchet) parameters and
@@ -685,7 +694,7 @@ data MsgMeta = MsgMeta
data SMPConfirmation = SMPConfirmation
{ -- | sender's public key to use for authentication of sender's commands at the recepient's server
senderKey :: SndPublicAuthKey,
senderKey :: Maybe SndPublicAuthKey,
-- | sender's DH public key for simple per-queue e2e encryption
e2ePubKey :: C.PublicKeyX25519,
-- | sender's information to be associated with the connection, e.g. sender's profile information
@@ -775,12 +784,12 @@ instance Encoding AgentMessage where
'M' -> AgentMessage <$> smpP <*> smpP
_ -> fail "bad AgentMessage"
-- internal type for storing message type in the database
data AgentMessageType
= AM_CONN_INFO
| AM_CONN_INFO_REPLY
| AM_RATCHET_INFO
| AM_HELLO_
| AM_REPLY_
| AM_A_MSG_
| AM_A_RCVD_
| AM_QCONT_
@@ -797,7 +806,6 @@ instance Encoding AgentMessageType where
AM_CONN_INFO_REPLY -> "D"
AM_RATCHET_INFO -> "S"
AM_HELLO_ -> "H"
AM_REPLY_ -> "R"
AM_A_MSG_ -> "M"
AM_A_RCVD_ -> "V"
AM_QCONT_ -> "QC"
@@ -812,7 +820,6 @@ instance Encoding AgentMessageType where
'D' -> pure AM_CONN_INFO_REPLY
'S' -> pure AM_RATCHET_INFO
'H' -> pure AM_HELLO_
'R' -> pure AM_REPLY_
'M' -> pure AM_A_MSG_
'V' -> pure AM_A_RCVD_
'Q' ->
@@ -1004,7 +1011,8 @@ instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
where
queryStr =
strEncode . QSP QEscape $
[("v", strEncode crAgentVRange), ("smp", strEncode crSmpQueues)]
-- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
[("v", strEncode crAgentVRange), ("smp", B.intercalate ";" $ map strEncode $ L.toList crSmpQueues)]
<> maybe [] (\e2e -> [("e2e", strEncode e2e)]) e2eParams
<> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData
strP = connReqUriP' (Just SSSimplex)
@@ -1026,7 +1034,7 @@ connReqUriP overrideScheme = do
crMode <- A.char '/' *> crModeP <* optional (A.char '/') <* "#/?"
query <- strP
aVRange <- queryParam "v" query
crSmpQueues <- queryParam "smp" query
crSmpQueues <- queryParamParser queuesP "smp" query
let crClientData = safeDecodeUtf8 <$> queryParamStr "data" query
crData = ConnReqUriData {crScheme, crAgentVRange = aVRange, crSmpQueues, crClientData}
case crMode of
@@ -1038,8 +1046,10 @@ connReqUriP overrideScheme = do
CMContact -> pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange}
where
crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact
-- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
queuesP = L.fromList <$> (strDecode <$?> A.takeTill (== ';')) `A.sepBy1'` A.char ';'
adjustAgentVRange vr =
let v = max duplexHandshakeSMPAgentVersion $ minVersion vr
let v = max minSupportedSMPAgentVersion $ minVersion vr
in fromMaybe vr $ safeVersionRange v (max v $ maxVersion vr)
instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where
@@ -1117,14 +1127,16 @@ data SMPQueueInfo = SMPQueueInfo {clientVersion :: VersionSMPC, queueAddress ::
deriving (Eq, Show)
instance Encoding SMPQueueInfo where
smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey})
smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure})
| clientVersion >= sndAuthKeySMPClientVersion && sndSecure = smpEncode (clientVersion, smpServer, senderId, dhPublicKey, sndSecure)
| clientVersion > initialSMPClientVersion = smpEncode (clientVersion, smpServer, senderId, dhPublicKey)
| otherwise = smpEncode clientVersion <> legacyEncodeServer smpServer <> smpEncode (senderId, dhPublicKey)
smpP = do
clientVersion <- smpP
smpServer <- if clientVersion > initialSMPClientVersion then smpP else updateSMPServerHosts <$> legacyServerP
(senderId, dhPublicKey) <- smpP
pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey}
sndSecure <- fromMaybe False <$> optional smpP
pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
-- This instance seems contrived and there was a temptation to split a common part of both types.
-- But this is created to allow backward and forward compatibility where SMPQueueUri
@@ -1150,7 +1162,8 @@ data SMPQueueUri = SMPQueueUri {clientVRange :: VersionRangeSMPC, queueAddress :
data SMPQueueAddress = SMPQueueAddress
{ smpServer :: SMPServer,
senderId :: SMP.SenderId,
dhPublicKey :: C.PublicKeyX25519
dhPublicKey :: C.PublicKeyX25519,
sndSecure :: Bool
}
deriving (Eq, Show)
@@ -1177,37 +1190,42 @@ sameQAddress (srv, qId) (srv', qId') = sameSrvAddr srv srv' && qId == qId'
{-# INLINE sameQAddress #-}
instance StrEncoding SMPQueueUri where
strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey})
strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, sndSecure})
| minVersion vr >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams
| otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam)
where
query = strEncode . QSP QEscape
queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)]
queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)] <> [("k", "s") | sndSecure]
srvParam = [("srv", strEncode $ TransportHosts_ hs) | not (null hs)]
hs = L.tail $ host srv
strP = do
srv@ProtocolServer {host = h :| host} <- strP <* A.char '/'
senderId <- strP <* optional (A.char '/') <* A.char '#'
(vr, hs, dhPublicKey) <- unversioned <|> versioned
(vr, hs, dhPublicKey, sndSecure) <- versioned <|> unversioned
let srv' = srv {host = h :| host <> hs}
smpServer = if maxVersion vr < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv'
pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey}
pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
where
unversioned = (versionToRange initialSMPClientVersion,[],) <$> strP <* A.endOfInput
unversioned = (versionToRange initialSMPClientVersion,[],,False) <$> strP <* A.endOfInput
versioned = do
dhKey_ <- optional strP
query <- optional (A.char '/') *> A.char '?' *> strP
vr <- queryParam "v" query
dhKey <- maybe (queryParam "dh" query) pure dhKey_
hs_ <- queryParam_ "srv" query
pure (vr, maybe [] thList_ hs_, dhKey)
let sndSecure = queryParamStr "k" query == Just "s"
pure (vr, maybe [] thList_ hs_, dhKey, sndSecure)
instance Encoding SMPQueueUri where
smpEncode (SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey}) =
smpEncode (clientVRange, smpServer, senderId, dhPublicKey)
smpEncode (SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure})
| maxVersion clientVRange >= sndAuthKeySMPClientVersion && sndSecure =
smpEncode (clientVRange, smpServer, senderId, dhPublicKey, sndSecure)
| otherwise =
smpEncode (clientVRange, smpServer, senderId, dhPublicKey)
smpP = do
(clientVRange, smpServer, senderId, dhPublicKey) <- smpP
pure $ SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey}
sndSecure <- fromMaybe False <$> optional smpP
pure $ SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
data ConnectionRequestUri (m :: ConnectionMode) where
CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation
+5 -2
View File
@@ -24,9 +24,12 @@ instance StrEncoding QueryStringParams where
strP = QSP QEscape . Q.parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
queryParam :: StrEncoding a => ByteString -> QueryStringParams -> Parser a
queryParam name q =
queryParam = queryParamParser strP
queryParamParser :: Parser a -> ByteString -> QueryStringParams -> Parser a
queryParamParser p name q =
case queryParamStr name q of
Just p -> either fail pure $ parseAll strP p
Just s -> either fail pure $ parseAll p s
_ -> fail $ "no qs param " <> B.unpack name
queryParam_ :: StrEncoding a => ByteString -> QueryStringParams -> Parser (Maybe a)
+7 -2
View File
@@ -44,6 +44,7 @@ import Simplex.Messaging.Protocol
RcvPrivateAuthKey,
SndPrivateAuthKey,
SndPublicAuthKey,
SenderCanSecure,
VersionSMPC,
)
import qualified Simplex.Messaging.Protocol as SMP
@@ -83,6 +84,8 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
e2eDhSecret :: Maybe C.DhSecretX25519,
-- | sender queue ID
sndId :: SMP.SenderId,
-- | sender can secure the queue
sndSecure :: SenderCanSecure,
-- | queue status
status :: QueueStatus,
-- | database queue ID (within connection)
@@ -138,9 +141,11 @@ data StoredSndQueue (q :: QueueStored) = SndQueue
server :: SMPServer,
-- | sender queue ID
sndId :: SMP.SenderId,
-- | sender can secure the queue
sndSecure :: SenderCanSecure,
-- | key pair used by the sender to authorize transmissions
-- TODO combine keys to key pair so that types match
sndPublicKey :: Maybe SndPublicAuthKey,
sndPublicKey :: SndPublicAuthKey,
sndPrivateKey :: SndPrivateAuthKey,
-- | DH public key used to negotiate per-queue e2e encryption
e2ePubKey :: Maybe C.PublicKeyX25519,
@@ -372,7 +377,7 @@ instance StrEncoding AgentCommandTag where
data InternalCommand
= ICAck SMP.RecipientId MsgId
| ICAckDel SMP.RecipientId MsgId InternalId
| ICAllowSecure SMP.RecipientId SMP.SndPublicAuthKey
| ICAllowSecure SMP.RecipientId (Maybe SMP.SndPublicAuthKey)
| ICDuplexSecure SMP.RecipientId SMP.SndPublicAuthKey
| ICDeleteConn
| ICDeleteRcvQueue SMP.RecipientId
+36 -27
View File
@@ -102,8 +102,10 @@ module Simplex.Messaging.Agent.Store.SQLite
-- Messages
updateRcvIds,
createRcvMsg,
updateRcvMsgHash,
updateSndIds,
createSndMsg,
updateSndMsgHash,
createSndMsgDelivery,
getSndMsgViaRcpt,
updateSndMsgRcpt,
@@ -811,7 +813,7 @@ setRcvQueueNtfCreds db connId clientNtfCreds =
Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} -> (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret)
Nothing -> (Nothing, Nothing, Nothing, Nothing)
type SMPConfirmationRow = (SndPublicAuthKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe VersionSMPC)
type SMPConfirmationRow = (Maybe SndPublicAuthKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe VersionSMPC)
smpConfirmation :: SMPConfirmationRow -> SMPConfirmation
smpConfirmation (senderKey, e2ePubKey, connInfo, smpReplyQueues_, smpClientVersion_) =
@@ -958,10 +960,10 @@ updateRcvIds db connId = do
pure (internalId, internalRcvId, lastExternalSndId, lastRcvHash)
createRcvMsg :: DB.Connection -> ConnId -> RcvQueue -> RcvMsgData -> IO ()
createRcvMsg db connId rq rcvMsgData = do
createRcvMsg db connId rq rcvMsgData@RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalRcvId, internalHash} = do
insertRcvMsgBase_ db connId rcvMsgData
insertRcvMsgDetails_ db connId rq rcvMsgData
updateHashRcv_ db connId rcvMsgData
updateRcvMsgHash db connId sndMsgId internalRcvId internalHash
updateSndIds :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
updateSndIds db connId = do
@@ -972,10 +974,10 @@ updateSndIds db connId = do
pure (internalId, internalSndId, prevSndHash)
createSndMsg :: DB.Connection -> ConnId -> SndMsgData -> IO ()
createSndMsg db connId sndMsgData = do
createSndMsg db connId sndMsgData@SndMsgData {internalSndId, internalHash} = do
insertSndMsgBase_ db connId sndMsgData
insertSndMsgDetails_ db connId sndMsgData
updateHashSnd_ db connId sndMsgData
updateSndMsgHash db connId internalSndId internalHash
createSndMsgDelivery :: DB.Connection -> ConnId -> SndQueue -> InternalId -> IO ()
createSndMsgDelivery db connId SndQueue {dbQueueId} msgId =
@@ -1866,28 +1868,34 @@ upsertNtfServer_ db ProtocolServer {host, port, keyHash} = do
insertRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> Maybe C.KeyHash -> IO RcvQueue
insertRcvQueue_ db connId' rq@RcvQueue {..} serverKeyHash_ = do
qId <- newQueueId_ <$> DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? ORDER BY rcv_queue_id DESC LIMIT 1" (Only connId')
-- to preserve ID if the queue already exists.
-- possibly, it can be done in one query.
currQId_ <- maybeFirstRow fromOnly $ DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (connId', host server, port server, sndId)
qId <- maybe (newQueueId_ <$> DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? ORDER BY rcv_queue_id DESC LIMIT 1" (Only connId')) pure currQId_
DB.execute
db
[sql|
INSERT INTO rcv_queues
(host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
(host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, snd_secure, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
|]
((host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret) :. (sndId, status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
((host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret) :. (sndId, sndSecure, status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId}
-- * createSndConn helpers
insertSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> Maybe C.KeyHash -> IO SndQueue
insertSndQueue_ db connId' sq@SndQueue {..} serverKeyHash_ = do
qId <- newQueueId_ <$> DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? ORDER BY snd_queue_id DESC LIMIT 1" (Only connId')
-- to preserve ID if the queue already exists.
-- possibly, it can be done in one query.
currQId_ <- maybeFirstRow fromOnly $ DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (connId', host server, port server, sndId)
qId <- maybe (newQueueId_ <$> DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? ORDER BY snd_queue_id DESC LIMIT 1" (Only connId')) pure currQId_
DB.execute
db
[sql|
INSERT OR REPLACE INTO snd_queues
(host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?);
(host, port, snd_id, snd_secure, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
|]
((host server, port server, sndId, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret) :. (status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
((host server, port server, sndId, sndSecure, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret) :. (status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
pure (sq :: NewSndQueue) {connId = connId', dbQueueId = qId}
newQueueId_ :: [Only Int64] -> DBQueueId 'QSStored
@@ -2009,7 +2017,7 @@ rcvQueueQuery :: Query
rcvQueueQuery =
[sql|
SELECT c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status,
q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.snd_secure, q.status,
q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id, q.switch_status, q.smp_client_version, q.delete_errors,
q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret
FROM rcv_queues q
@@ -2018,17 +2026,17 @@ rcvQueueQuery =
|]
toRcvQueue ::
(UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, QueueStatus)
:. (DBQueueId 'QSStored, Bool, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
(UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, SenderCanSecure)
:. (QueueStatus, DBQueueId 'QSStored, Bool, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
:. (Maybe SMP.NtfPublicAuthKey, Maybe SMP.NtfPrivateAuthKey, Maybe SMP.NotifierId, Maybe RcvNtfDhSecret) ->
RcvQueue
toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status) :. (dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, sndSecure) :. (status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
let server = SMPServer host port keyHash
smpClientVersion = fromMaybe initialSMPClientVersion smpClientVersion_
clientNtfCreds = case (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_) of
(Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just $ ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
_ -> Nothing
in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, sndSecure, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
getRcvQueueById db connId dbRcvId =
@@ -2049,7 +2057,7 @@ sndQueueQuery :: Query
sndQueueQuery =
[sql|
SELECT
c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id,
c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id, q.snd_secure,
q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status,
q.snd_queue_id, q.snd_primary, q.replace_snd_queue_id, q.switch_status, q.smp_client_version
FROM snd_queues q
@@ -2058,17 +2066,18 @@ sndQueueQuery =
|]
toSndQueue ::
(UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId)
(UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId, SenderCanSecure)
:. (Maybe SndPublicAuthKey, SndPrivateAuthKey, Maybe C.PublicKeyX25519, C.DhSecretX25519, QueueStatus)
:. (DBQueueId 'QSStored, Bool, Maybe Int64, Maybe SndSwitchStatus, VersionSMPC) ->
SndQueue
toSndQueue
( (userId, keyHash, connId, host, port, sndId)
:. (sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)
( (userId, keyHash, connId, host, port, sndId, sndSecure)
:. (sndPubKey, sndPrivateKey@(C.APrivateAuthKey a pk), e2ePubKey, e2eDhSecret, status)
:. (dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion)
) =
let server = SMPServer host port keyHash
in SndQueue {userId, connId, server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
sndPublicKey = fromMaybe (C.APublicAuthKey a (C.publicKey pk)) sndPubKey
in SndQueue {userId, connId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
getSndQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError SndQueue)
getSndQueueById db connId dbSndId =
@@ -2147,10 +2156,10 @@ insertRcvMsgDetails_ db connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, interna
]
DB.execute db "INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (connId, encryptedMsgHash)
updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
updateHashRcv_ dbConn connId RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalHash, internalRcvId} =
updateRcvMsgHash :: DB.Connection -> ConnId -> AgentMsgId -> InternalRcvId -> MsgHash -> IO ()
updateRcvMsgHash db connId sndMsgId internalRcvId internalHash =
DB.executeNamed
dbConn
db
-- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved
[sql|
UPDATE connections
@@ -2226,10 +2235,10 @@ insertSndMsgDetails_ dbConn connId SndMsgData {..} =
":previous_msg_hash" := prevMsgHash
]
updateHashSnd_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
updateHashSnd_ dbConn connId SndMsgData {..} =
updateSndMsgHash :: DB.Connection -> ConnId -> InternalSndId -> MsgHash -> IO ()
updateSndMsgHash db connId internalSndId internalHash =
DB.executeNamed
dbConn
db
-- last_internal_snd_msg_id equality check prevents race condition in case next id was reserved
[sql|
UPDATE connections
@@ -73,6 +73,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wai
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Transport.Client (TransportHost)
@@ -114,7 +115,8 @@ schemaMigrations =
("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
("m20240518_servers_stats", m20240518_servers_stats, Just down_m20240518_servers_stats)
("m20240518_servers_stats", m20240518_servers_stats, Just down_m20240518_servers_stats),
("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,36 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20240624_snd_secure :: Query
m20240624_snd_secure =
[sql|
ALTER TABLE rcv_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
ALTER TABLE snd_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
PRAGMA writable_schema=1;
UPDATE sqlite_master
SET sql = replace(sql, 'sender_key BLOB NOT NULL,', 'sender_key BLOB,')
WHERE name = 'conn_confirmations' AND type = 'table';
PRAGMA writable_schema=0;
|]
down_m20240624_snd_secure :: Query
down_m20240624_snd_secure =
[sql|
ALTER TABLE rcv_queues DROP COLUMN snd_secure;
ALTER TABLE snd_queues DROP COLUMN snd_secure;
PRAGMA writable_schema=1;
UPDATE sqlite_master
SET sql = replace(sql, 'sender_key BLOB,', 'sender_key BLOB NOT NULL,')
WHERE name = 'conn_confirmations' AND type = 'table';
PRAGMA writable_schema=0;
|]
@@ -55,6 +55,7 @@ CREATE TABLE rcv_queues(
server_key_hash BLOB,
switch_status TEXT,
deleted INTEGER NOT NULL DEFAULT 0,
snd_secure INTEGER NOT NULL DEFAULT 0,
PRIMARY KEY(host, port, rcv_id),
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE,
@@ -77,6 +78,7 @@ CREATE TABLE snd_queues(
replace_snd_queue_id INTEGER NULL,
server_key_hash BLOB,
switch_status TEXT,
snd_secure INTEGER NOT NULL DEFAULT 0,
PRIMARY KEY(host, port, snd_id),
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE
@@ -132,7 +134,7 @@ CREATE TABLE conn_confirmations(
confirmation_id BLOB NOT NULL PRIMARY KEY,
conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
e2e_snd_pub_key BLOB NOT NULL,
sender_key BLOB NOT NULL,
sender_key BLOB,
ratchet_state BLOB NOT NULL,
sender_conn_info BLOB NOT NULL,
accepted INTEGER NOT NULL,
+9 -2
View File
@@ -47,6 +47,7 @@ module Simplex.Messaging.Client
subscribeSMPQueueNotifications,
subscribeSMPQueuesNtfs,
secureSMPQueue,
secureSndSMPQueue,
enableSMPQueueNotifications,
disableSMPQueueNotifications,
enableSMPQueuesNtfs,
@@ -655,9 +656,10 @@ createSMPQueue ::
RcvPublicDhKey ->
Maybe BasicAuth ->
SubscriptionMode ->
Bool ->
ExceptT SMPClientError IO QueueIdsKeys
createSMPQueue c (rKey, rpKey) dhKey auth subMode =
sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth subMode) >>= \case
createSMPQueue c (rKey, rpKey) dhKey auth subMode sndSecure =
sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth subMode sndSecure) >>= \case
IDS qik -> pure qik
r -> throwE $ unexpectedResponse r
@@ -729,6 +731,11 @@ secureSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> SndPublicAuth
secureSMPQueue c rpKey rId senderKey = okSMPCommand (KEY senderKey) c rpKey rId
{-# INLINE secureSMPQueue #-}
-- | Secure the SMP queue via sender queue ID.
secureSndSMPQueue :: SMPClient -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO ()
secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey sId
{-# INLINE secureSndSMPQueue #-}
-- | Enable notifications for the queue for push notifications server.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
+39 -11
View File
@@ -55,6 +55,7 @@ module Simplex.Messaging.Protocol
ProtocolEncoding (..),
Command (..),
SubscriptionMode (..),
SenderCanSecure,
Party (..),
Cmd (..),
DirectParty,
@@ -133,6 +134,7 @@ module Simplex.Messaging.Protocol
FwdTransmission (..),
MsgFlags (..),
initialSMPClientVersion,
currentSMPClientVersion,
userProtocol,
rcvMessageMeta,
noMsgFlags,
@@ -153,6 +155,7 @@ module Simplex.Messaging.Protocol
legacyServerP,
legacyStrEncodeServer,
srvHostnamesSMPClientVersion,
sndAuthKeySMPClientVersion,
sameSrvAddr,
sameSrvAddr',
noAuthSrv,
@@ -240,8 +243,11 @@ initialSMPClientVersion = VersionSMPC 1
srvHostnamesSMPClientVersion :: VersionSMPC
srvHostnamesSMPClientVersion = VersionSMPC 2
sndAuthKeySMPClientVersion :: VersionSMPC
sndAuthKeySMPClientVersion = VersionSMPC 3
currentSMPClientVersion :: VersionSMPC
currentSMPClientVersion = VersionSMPC 2
currentSMPClientVersion = VersionSMPC 3
supportedSMPClientVRange :: VersionRangeSMPC
supportedSMPClientVRange = mkVersionRange initialSMPClientVersion currentSMPClientVersion
@@ -377,7 +383,7 @@ data Command (p :: Party) where
-- v6 of SMP servers only support signature algorithm for command authorization.
-- v7 of SMP servers additionally support additional layer of authenticated encryption.
-- RcvPublicAuthKey is defined as C.APublicKey - it can be either signature or DH public keys.
NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> Command Recipient
NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
SUB :: Command Recipient
KEY :: SndPublicAuthKey -> Command Recipient
NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
@@ -390,6 +396,7 @@ data Command (p :: Party) where
DEL :: Command Recipient
QUE :: Command Recipient
-- SMP sender commands
SKEY :: SndPublicAuthKey -> Command Sender
-- SEND v1 has to be supported for encoding/decoding
-- SEND :: MsgBody -> Command Sender
SEND :: MsgFlags -> MsgBody -> Command Sender
@@ -432,6 +439,8 @@ instance Encoding SubscriptionMode where
'C' -> pure SMOnlyCreate
_ -> fail "bad SubscriptionMode"
type SenderCanSecure = Bool
newtype EncTransmission = EncTransmission ByteString
deriving (Show)
@@ -664,6 +673,7 @@ data CommandTag (p :: Party) where
OFF_ :: CommandTag Recipient
DEL_ :: CommandTag Recipient
QUE_ :: CommandTag Recipient
SKEY_ :: CommandTag Sender
SEND_ :: CommandTag Sender
PING_ :: CommandTag Sender
PRXY_ :: CommandTag ProxiedClient
@@ -712,6 +722,7 @@ instance PartyI p => Encoding (CommandTag p) where
OFF_ -> "OFF"
DEL_ -> "DEL"
QUE_ -> "QUE"
SKEY_ -> "SKEY"
SEND_ -> "SEND"
PING_ -> "PING"
PRXY_ -> "PRXY"
@@ -732,6 +743,7 @@ instance ProtocolMsgTag CmdTag where
"OFF" -> Just $ CT SRecipient OFF_
"DEL" -> Just $ CT SRecipient DEL_
"QUE" -> Just $ CT SRecipient QUE_
"SKEY" -> Just $ CT SSender SKEY_
"SEND" -> Just $ CT SSender SEND_
"PING" -> Just $ CT SSender PING_
"PRXY" -> Just $ CT SProxiedClient PRXY_
@@ -1106,7 +1118,8 @@ instance FromJSON CorrId where
data QueueIdsKeys = QIK
{ rcvId :: RecipientId,
sndId :: SenderId,
rcvPublicDhKey :: RcvPublicDhKey
rcvPublicDhKey :: RcvPublicDhKey,
sndSecure :: SenderCanSecure
}
deriving (Eq, Show)
@@ -1277,7 +1290,8 @@ class ProtocolMsgTag (Tag msg) => ProtocolEncoding v err msg | msg -> err, msg -
instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
type Tag (Command p) = CommandTag p
encodeProtocol v = \case
NEW rKey dhKey auth_ subMode
NEW rKey dhKey auth_ subMode sndSecure
| v >= sndAuthKeySMPVersion -> new <> e (auth_, subMode, sndSecure)
| v >= subModeSMPVersion -> new <> auth <> e subMode
| v == basicAuthSMPVersion -> new <> auth
| otherwise -> new
@@ -1293,6 +1307,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
OFF -> e OFF_
DEL -> e DEL_
QUE -> e QUE_
SKEY k -> e (SKEY_, ' ', k)
SEND flags msg -> e (SEND_, ' ', flags, ' ', Tail msg)
PING -> e PING_
NSUB -> e NSUB_
@@ -1318,6 +1333,9 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
SEND {}
| B.null entId -> Left $ CMD NO_ENTITY
| otherwise -> Right cmd
SKEY _
| isNothing auth || B.null entId -> Left $ CMD NO_AUTH
| otherwise -> Right cmd
PING -> noAuthCmd
PRXY {} -> noAuthCmd
PFWD {}
@@ -1344,9 +1362,10 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
CT SRecipient tag ->
Cmd SRecipient <$> case tag of
NEW_
| v >= subModeSMPVersion -> new <*> auth <*> smpP
| v == basicAuthSMPVersion -> new <*> auth <*> pure SMSubscribe
| otherwise -> new <*> pure Nothing <*> pure SMSubscribe
| v >= sndAuthKeySMPVersion -> new <*> smpP <*> smpP <*> smpP
| v >= subModeSMPVersion -> new <*> auth <*> smpP <*> pure False
| v == basicAuthSMPVersion -> new <*> auth <*> pure SMSubscribe <*> pure False
| otherwise -> new <*> pure Nothing <*> pure SMSubscribe <*> pure False
where
new = NEW <$> _smpP <*> smpP
auth = optional (A.char 'A' *> smpP)
@@ -1361,6 +1380,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
QUE_ -> pure QUE
CT SSender tag ->
Cmd SSender <$> case tag of
SKEY_ -> SKEY <$> _smpP
SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
PING_ -> pure PING
RFWD_ -> RFWD <$> (EncFwdTransmission . unTail <$> _smpP)
@@ -1377,8 +1397,12 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
type Tag BrokerMsg = BrokerMsgTag
encodeProtocol _v = \case
IDS (QIK rcvId sndId srvDh) -> e (IDS_, ' ', rcvId, sndId, srvDh)
encodeProtocol v = \case
IDS (QIK rcvId sndId srvDh sndSecure)
| v >= sndAuthKeySMPVersion -> ids <> e sndSecure
| otherwise -> ids
where
ids = e (IDS_, ' ', rcvId, sndId, srvDh)
MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body} ->
e (MSG_, ' ', msgId, Tail body)
NID nId srvNtfDh -> e (NID_, ' ', nId, srvNtfDh)
@@ -1395,13 +1419,17 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
e :: Encoding a => a -> ByteString
e = smpEncode
protocolP _v = \case
protocolP v = \case
MSG_ -> do
msgId <- _smpP
MSG . RcvMessage msgId <$> bodyP
where
bodyP = EncRcvMsgBody . unTail <$> smpP
IDS_ -> IDS <$> (QIK <$> _smpP <*> smpP <*> smpP)
IDS_
| v >= sndAuthKeySMPVersion -> ids smpP
| otherwise -> ids $ pure False
where
ids p = IDS <$> (QIK <$> _smpP <*> smpP <*> smpP <*> p)
NID_ -> NID <$> _smpP <*> smpP
NMSG_ -> NMSG <$> _smpP <*> smpP
PKEY_ -> PKEY <$> _smpP <*> smpP <*> ((,) <$> C.certChainP <*> (C.getSignedExact <$> smpP))
+24 -14
View File
@@ -607,9 +607,10 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
verifyTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
verifyTransmission auth_ tAuth authorized queueId cmd =
case cmd of
Cmd SRecipient (NEW k _ _ _) -> pure $ Nothing `verifiedWith` k
Cmd SRecipient (NEW k _ _ _ _) -> pure $ Nothing `verifiedWith` k
Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWith` recipientKey q) <$> get SRecipient
-- SEND will be accepted without authorization before the queue is secured with KEY command
-- SEND will be accepted without authorization before the queue is secured with KEY or SKEY command
Cmd SSender (SKEY k) -> verifyQueue (\q -> Just q `verifiedWith` k) <$> get SSender
Cmd SSender SEND {} -> verifyQueue (\q -> Just q `verified` maybe (isNothing tAuth) verify (senderKey q)) <$> get SSender
Cmd SSender PING -> pure $ VRVerified Nothing
Cmd SSender RFWD {} -> pure $ VRVerified Nothing
@@ -768,13 +769,18 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
transportErr :: TransportError -> ErrorType
transportErr = PROXY . BROKER . TRANSPORT
mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> TVar Int) -> m ()
mkIncProxyStats ps psOwn = \own sel -> do
mkIncProxyStats ps psOwn own sel = do
atomically $ modifyTVar' (sel ps) (+ 1)
when own $ atomically $ modifyTVar' (sel psOwn) (+ 1)
processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
processCommand (qr_, (corrId, queueId, cmd)) = case cmd of
Cmd SProxiedClient command -> processProxiedCmd (corrId, queueId, command)
Cmd SSender command -> Just <$> case command of
SKEY sKey -> (corrId,queueId,) <$> case qr_ of
Just QueueRec {sndSecure, recipientId}
| sndSecure -> secureQueue_ "SKEY" recipientId sKey
| otherwise -> pure $ ERR AUTH
Nothing -> pure $ ERR INTERNAL
SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
PING -> pure (corrId, "", PONG)
RFWD encBlock -> (corrId, "",) <$> processForwardedCommand encBlock
@@ -782,10 +788,10 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
Cmd SRecipient command -> do
st <- asks queueStore
Just <$> case command of
NEW rKey dhKey auth subMode ->
NEW rKey dhKey auth subMode sndSecure ->
ifM
allowNew
(createQueue st rKey dhKey subMode)
(createQueue st rKey dhKey subMode sndSecure)
(pure (corrId, queueId, ERR AUTH))
where
allowNew = do
@@ -794,18 +800,20 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
SUB -> withQueue (`subscribeQueue` queueId)
GET -> withQueue getMessage
ACK msgId -> withQueue (`acknowledgeMsg` msgId)
KEY sKey -> secureQueue_ st sKey
KEY sKey -> (corrId,queueId,) <$> case qr_ of
Just QueueRec {recipientId} -> secureQueue_ "KEY" recipientId sKey
Nothing -> pure $ ERR INTERNAL
NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
NDEL -> deleteQueueNotifier_ st
OFF -> suspendQueue_ st
DEL -> delQueueAndMsgs st
QUE -> withQueue getQueueInfo
where
createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> M (Transmission BrokerMsg)
createQueue st recipientKey dhKey subMode = time "NEW" $ do
createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
(rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
let rcvDhSecret = C.dh' dhKey privDhKey
qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey}
qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}
qRec (recipientId, senderId) =
QueueRec
{ recipientId,
@@ -814,7 +822,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
rcvDhSecret,
senderKey = Nothing,
notifier = Nothing,
status = QueueActive
status = QueueActive,
sndSecure
}
(corrId,queueId,) <$> addQueueRetry 3 qik qRec
where
@@ -849,12 +858,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
n <- asks $ queueIdBytes . config
liftM2 (,) (randomId n) (randomId n)
secureQueue_ :: QueueStore -> SndPublicAuthKey -> M (Transmission BrokerMsg)
secureQueue_ st sKey = time "KEY" $ do
withLog $ \s -> logSecureQueue s queueId sKey
secureQueue_ :: T.Text -> RecipientId -> SndPublicAuthKey -> M BrokerMsg
secureQueue_ name rId sKey = time name $ do
withLog $ \s -> logSecureQueue s rId sKey
st <- asks queueStore
stats <- asks serverStats
atomically $ modifyTVar' (qSecured stats) (+ 1)
atomically $ (corrId,queueId,) . either ERR (const OK) <$> secureQueue st queueId sKey
atomically $ either ERR (const OK) <$> secureQueue st rId sKey
addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
@@ -14,6 +14,7 @@ data QueueRec = QueueRec
rcvDhSecret :: !RcvDhSecret,
senderId :: !SenderId,
senderKey :: !(Maybe SndPublicAuthKey),
sndSecure :: !SenderCanSecure,
notifier :: !(Maybe NtfCreds),
status :: !ServerQueueStatus
}
+5 -2
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
@@ -53,7 +54,7 @@ data StoreLogRecord
| DeleteNotifier QueueId
instance StrEncoding QueueRec where
strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} =
strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier} =
B.unwords
[ "rid=" <> strEncode recipientId,
"rk=" <> strEncode recipientKey,
@@ -61,6 +62,7 @@ instance StrEncoding QueueRec where
"sid=" <> strEncode senderId,
"sk=" <> strEncode senderKey
]
<> if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
<> maybe "" notifierStr notifier
where
notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
@@ -71,8 +73,9 @@ instance StrEncoding QueueRec where
rcvDhSecret <- "rdh=" *> strP_
senderId <- "sid=" *> strP_
senderKey <- "sk=" *> strP
sndSecure <- (" sndSecure=" *> strP) <|> pure False
notifier <- optional $ " notifier=" *> strP
pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier, status = QueueActive}
pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive}
instance StrEncoding StoreLogRecord where
strEncode = \case
+7 -3
View File
@@ -46,6 +46,7 @@ module Simplex.Messaging.Transport
subModeSMPVersion,
authCmdsSMPVersion,
sendingProxySMPVersion,
sndAuthKeySMPVersion,
simplexMQVersion,
smpBlockSize,
TransportConfig (..),
@@ -156,14 +157,17 @@ authCmdsSMPVersion = VersionSMP 7
sendingProxySMPVersion :: VersionSMP
sendingProxySMPVersion = VersionSMP 8
sndAuthKeySMPVersion :: VersionSMP
sndAuthKeySMPVersion = VersionSMP 9
currentClientSMPRelayVersion :: VersionSMP
currentClientSMPRelayVersion = VersionSMP 8
currentClientSMPRelayVersion = VersionSMP 9
legacyServerSMPRelayVersion :: VersionSMP
legacyServerSMPRelayVersion = VersionSMP 6
currentServerSMPRelayVersion :: VersionSMP
currentServerSMPRelayVersion = VersionSMP 8
currentServerSMPRelayVersion = VersionSMP 9
-- Max SMP protocol version to be used in e2e encrypted
-- connection between client and server, as defined by SMP proxy.
@@ -171,7 +175,7 @@ currentServerSMPRelayVersion = VersionSMP 8
-- to prevent client version fingerprinting by the
-- destination relays when clients upgrade at different times.
proxiedSMPRelayVersion :: VersionSMP
proxiedSMPRelayVersion = VersionSMP 8
proxiedSMPRelayVersion = VersionSMP 9
-- minimal supported protocol version is 4
-- TODO remove code that supports sending commands without batching
+175 -121
View File
@@ -7,7 +7,12 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module AgentTests.ConnectionRequestTests where
module AgentTests.ConnectionRequestTests
( connectionRequestTests,
connReqData,
queueAddr,
testE2ERatchetParams12,
) where
import Data.ByteString (ByteString)
import Network.HTTP.Types (urlEncode)
@@ -15,179 +20,228 @@ import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ProtocolServer (..), pattern VersionSMPC, supportedSMPClientVRange)
import Simplex.Messaging.Protocol (ProtocolServer (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
import Simplex.Messaging.Version
import Test.Hspec
uri :: String
uri = "smp.simplex.im"
srv :: SMPServer
srv = SMPServer "smp.simplex.im" "5223" (C.KeyHash "\215m\248\251")
srv = SMPServer "smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion" "5223" (C.KeyHash "\215m\248\251")
srv1 :: SMPServer
srv1 = SMPServer "smp.simplex.im" "5223" (C.KeyHash "\215m\248\251")
queueAddr :: SMPQueueAddress
queueAddr =
SMPQueueAddress
{ smpServer = srv,
senderId = "\223\142z\251",
dhPublicKey = testDhKey
dhPublicKey = testDhKey,
sndSecure = False
}
queueAddrSK :: SMPQueueAddress
queueAddrSK = queueAddr {sndSecure = True}
queueAddr1 :: SMPQueueAddress
queueAddr1 = queueAddr {smpServer = srv1}
queueAddrNoPort :: SMPQueueAddress
queueAddrNoPort = queueAddr {smpServer = srv {port = ""}}
queueAddrNoPort1 :: SMPQueueAddress
queueAddrNoPort1 = queueAddr {smpServer = srv1 {port = ""}}
-- current version range includes version 1 and it uses legacy encoding
queue :: SMPQueueUri
queue = SMPQueueUri supportedSMPClientVRange queueAddr
queueSK :: SMPQueueUri
queueSK = SMPQueueUri supportedSMPClientVRange queueAddrSK
queueStr :: ByteString
queueStr = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-3&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
queueStrSK :: ByteString
queueStrSK = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-3&dh=" <> url testDhKeyStr <> "&k=s" <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
queue1 :: SMPQueueUri
queue1 = SMPQueueUri supportedSMPClientVRange queueAddr1
queue1Str :: ByteString
queue1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-3&dh=" <> url testDhKeyStr
queueV1 :: SMPQueueUri
queueV1 = SMPQueueUri (mkVersionRange (VersionSMPC 1) (VersionSMPC 1)) queueAddr
queueV1NoPort :: SMPQueueUri
queueV1NoPort = (queueV1 :: SMPQueueUri) {queueAddress = queueAddrNoPort}
-- version range 2-3 uses new encoding
-- it is fixed/changed in v5.8.2.
queueNew :: SMPQueueUri
queueNew = SMPQueueUri (mkVersionRange (VersionSMPC 2) currentSMPClientVersion) queueAddr
queueNewStr :: ByteString
queueNewStr = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr
queueNewStr' :: ByteString
queueNewStr' = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-3&dh=" <> testDhKeyStr
queueNewNoPort :: SMPQueueUri
queueNewNoPort = (queueNew :: SMPQueueUri) {queueAddress = queueAddrNoPort}
queueNew1 :: SMPQueueUri
queueNew1 = SMPQueueUri (mkVersionRange (VersionSMPC 2) currentSMPClientVersion) queueAddr1
queueNew1Str :: ByteString
queueNew1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr
queueNew1NoPort :: SMPQueueUri
queueNew1NoPort = (queueNew1 :: SMPQueueUri) {queueAddress = queueAddrNoPort1}
testDhKey :: C.PublicKeyX25519
testDhKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
testDhKeyStr :: ByteString
testDhKeyStr = strEncode testDhKey
testDhKeyStrUri :: ByteString
testDhKeyStrUri = urlEncode True testDhKeyStr
connReqData :: ConnReqUriData
connReqData =
ConnReqUriData
{ crScheme = SSSimplex,
crAgentVRange = mkVersionRange (VersionSMPA 2) (VersionSMPA 2),
crSmpQueues = [queueV1],
crAgentVRange = supportedSMPAgentVRange,
crSmpQueues = [queue],
crClientData = Nothing
}
connReqDataSK :: ConnReqUriData
connReqDataSK = connReqData {crSmpQueues = [queueSK]}
connReqData1 :: ConnReqUriData
connReqData1 = connReqData {crSmpQueues = [queue1]}
connReqDataV1 :: ConnReqUriData
connReqDataV1 = connReqData {crAgentVRange = mkVersionRange (VersionSMPA 1) (VersionSMPA 1)}
connReqDataV2 :: ConnReqUriData
connReqDataV2 = connReqData {crAgentVRange = mkVersionRange (VersionSMPA 2) (VersionSMPA 2)}
connReqDataNew :: ConnReqUriData
connReqDataNew = connReqData {crSmpQueues = [queueNew]}
connReqDataNew1 :: ConnReqUriData
connReqDataNew1 = connReqData {crSmpQueues = [queueNew1]}
testDhPubKey :: C.PublicKeyX448
testDhPubKey = "MEIwBQYDK2VvAzkAmKuSYeQ/m0SixPDS8Wq8VBaTS1cW+Lp0n0h4Diu+kUpR+qXx4SDJ32YGEFoGFGSbGPry5Ychr6U="
testE2ERatchetParams :: RcvE2ERatchetParamsUri 'C.X448
testE2ERatchetParams = E2ERatchetParamsUri (mkVersionRange (VersionE2E 1) (VersionE2E 1)) testDhPubKey testDhPubKey Nothing
testE2ERatchetParamsStrUri :: ByteString
testE2ERatchetParamsStrUri = "v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
testE2ERatchetParams12 :: RcvE2ERatchetParamsUri 'C.X448
testE2ERatchetParams12 = E2ERatchetParamsUri supportedE2EEncryptVRange testDhPubKey testDhPubKey Nothing
connectionRequest :: AConnectionRequestUri
connectionRequest =
ACR SCMInvitation $
CRInvitationUri connReqData testE2ERatchetParams
connectionRequest = ACR SCMInvitation $ CRInvitationUri connReqData testE2ERatchetParams
connectionRequestSK :: AConnectionRequestUri
connectionRequestSK = ACR SCMInvitation $ CRInvitationUri connReqDataSK testE2ERatchetParams
connectionRequestV1 :: AConnectionRequestUri
connectionRequestV1 = ACR SCMInvitation $ CRInvitationUri connReqDataV1 testE2ERatchetParams
connectionRequest1 :: AConnectionRequestUri
connectionRequest1 = ACR SCMInvitation $ CRInvitationUri connReqData1 testE2ERatchetParams
connectionRequestNew :: AConnectionRequestUri
connectionRequestNew = ACR SCMInvitation $ CRInvitationUri connReqDataNew testE2ERatchetParams
connectionRequestNew1 :: AConnectionRequestUri
connectionRequestNew1 = ACR SCMInvitation $ CRInvitationUri connReqDataNew1 testE2ERatchetParams
contactAddress :: AConnectionRequestUri
contactAddress = ACR SCMContact $ CRContactUri connReqData
connectionRequestCurrentRange :: AConnectionRequestUri
connectionRequestCurrentRange =
ACR SCMInvitation $
CRInvitationUri
connReqData {crAgentVRange = supportedSMPAgentVRange, crSmpQueues = [queueV1, queueV1]}
testE2ERatchetParams12
contactAddressV2 :: AConnectionRequestUri
contactAddressV2 = ACR SCMContact $ CRContactUri connReqDataV2
contactAddressNew :: AConnectionRequestUri
contactAddressNew = ACR SCMContact $ CRContactUri connReqDataNew
connectionRequest2queues :: AConnectionRequestUri
connectionRequest2queues = ACR SCMInvitation $ CRInvitationUri connReqData {crSmpQueues = [queue, queue]} testE2ERatchetParams
connectionRequest2queuesNew :: AConnectionRequestUri
connectionRequest2queuesNew = ACR SCMInvitation $ CRInvitationUri connReqDataNew {crSmpQueues = [queueNew, queueNew]} testE2ERatchetParams
contactAddress2queues :: AConnectionRequestUri
contactAddress2queues = ACR SCMContact $ CRContactUri connReqData {crSmpQueues = [queue, queue]}
contactAddress2queuesNew :: AConnectionRequestUri
contactAddress2queuesNew = ACR SCMContact $ CRContactUri connReqDataNew {crSmpQueues = [queueNew, queueNew]}
connectionRequestClientDataEmpty :: AConnectionRequestUri
connectionRequestClientDataEmpty =
ACR SCMInvitation $
CRInvitationUri connReqData {crClientData = Just "{}"} testE2ERatchetParams
connectionRequestClientDataEmpty = ACR SCMInvitation $ CRInvitationUri connReqData {crClientData = Just "{}"} testE2ERatchetParams
connectionRequestClientData :: AConnectionRequestUri
connectionRequestClientData =
ACR SCMInvitation $
CRInvitationUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"} testE2ERatchetParams
contactAddressClientData :: AConnectionRequestUri
contactAddressClientData = ACR SCMContact $ CRContactUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"}
url :: ByteString -> ByteString
url = urlEncode True
(==#) :: (StrEncoding a, HasCallStack) => a -> ByteString -> Expectation
a ==# s = strEncode a `shouldBe` s
(#==) :: (StrEncoding a, Eq a, Show a, HasCallStack) => a -> ByteString -> Expectation
a #== s = strDecode s `shouldBe` Right a
(#==#) :: (StrEncoding a, Eq a, Show a, HasCallStack) => a -> ByteString -> Expectation
a #==# s = do
a ==# s
a #== s
connectionRequestTests :: Spec
connectionRequestTests =
describe "connection request parsing / serializing" $ do
it "should serialize SMP queue URIs" $ do
strEncode (queue :: SMPQueueUri) {queueAddress = queueAddrNoPort}
`shouldBe` "smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
strEncode queue {clientVRange = mkVersionRange (VersionSMPC 1) (VersionSMPC 2)}
`shouldBe` "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
it "should parse SMP queue URIs" $ do
strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-2&dh=" <> testDhKeyStr)
`shouldBe` Right (queue :: SMPQueueUri) {queueAddress = queueAddrNoPort}
strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr)
`shouldBe` Right (queueV1 :: SMPQueueUri) {queueAddress = queueAddrNoPort}
strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr)
`shouldBe` Right queueV1
strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-2&extra_param=abc")
`shouldBe` Right queue
strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?extra_param=abc&v=1&dh=" <> testDhKeyStr)
`shouldBe` Right queueV1
strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc")
`shouldBe` Right queueV1
it "should serialize connection requests" $ do
strEncode connectionRequest
`shouldBe` "simplex:/invitation#/?v=2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> urlEncode True testDhKeyStrUri
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
strEncode connectionRequestCurrentRange
`shouldBe` "simplex:/invitation#/?v=2-5&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> urlEncode True testDhKeyStrUri
<> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> urlEncode True testDhKeyStrUri
<> "&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
strEncode connectionRequestClientDataEmpty
`shouldBe` "simplex:/invitation#/?v=2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> urlEncode True testDhKeyStrUri
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&data=%7B%7D"
strEncode connectionRequestClientData
`shouldBe` "simplex:/invitation#/?v=2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> urlEncode True testDhKeyStrUri
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D"
it "should parse connection requests" $ do
strDecode
( "https://simplex.chat/contact#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
<> testDhKeyStrUri
<> "&v=1" -- adjusted to v2
)
`shouldBe` Right contactAddress
strDecode
( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
<> testDhKeyStrUri
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&v=2"
)
`shouldBe` Right connectionRequest
strDecode
( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> testDhKeyStrUri
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&v=2"
)
`shouldBe` Right connectionRequest
strDecode
( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> testDhKeyStrUri
<> "&e2e=v%3D1-1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&v=2-2"
)
`shouldBe` Right connectionRequest
strDecode
( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26extra_param%3Dabc%26dh%3D"
<> testDhKeyStrUri
<> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> testDhKeyStrUri
<> "&e2e=extra_key%3Dnew%26v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&some_new_param=abc"
<> "&v=2-5"
)
`shouldBe` Right connectionRequestCurrentRange
strDecode
( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> testDhKeyStrUri
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&data=%7B%7D"
<> "&v=2-2"
)
`shouldBe` Right connectionRequestClientDataEmpty
strDecode
( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
<> testDhKeyStrUri
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
<> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D"
<> "&v=2"
)
`shouldBe` Right connectionRequestClientData
it "should serialize and parse SMP queue URIs" $ do
queue #==# queueStr
queue #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-3&extra_param=abc&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
queueSK #==# queueStrSK
queue1 #==# queue1Str
queueNew #==# queueNewStr
queueNew #== queueNewStr'
queueNew1 #==# queueNew1Str
queueNewNoPort #==# ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr)
queueNew1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr)
queueV1 #==# ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
queueV1 #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#" <> testDhKeyStr)
queueV1 #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?extra_param=abc&v=1&dh=" <> testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
queueV1 #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
queueV1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr)
it "should serialize and parse connection invitations and contact addresses" $ do
connectionRequest #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequest #== ("https://simplex.chat/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequestSK #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequest1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequest2queues #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequestNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}")
contactAddress #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr)
contactAddress #== ("https://simplex.chat/contact#/?v=2-6&smp=" <> url queueStr)
contactAddress2queues #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr))
contactAddressNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueNewStr)
contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr))
contactAddressV2 #==# ("simplex:/contact#/?v=2&smp=" <> url queueStr)
contactAddressV2 #== ("https://simplex.chat/contact#/?v=1&smp=" <> url queueStr) -- adjusted to v2
contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2
contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr)
contactAddressClientData #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}")
File diff suppressed because it is too large Load Diff
+37 -42
View File
@@ -12,9 +12,9 @@ module AgentTests.NotificationTests where
-- import Control.Logger.Simple (LogConfig (..), LogLevel (..), setLogLevel, withGlobalLogging)
import AgentTests.FunctionalAPITests
( agentCfgV7,
( agentCfgVPrevPQ,
createConnection,
exchangeGreetingsMsgId,
exchangeGreetings,
get,
joinConnection,
makeConnection,
@@ -51,7 +51,7 @@ import qualified Data.ByteString.Char8 as B
import Data.Text.Encoding (encodeUtf8)
import NtfClient
import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
import SMPClient (cfg, cfgV7, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
@@ -70,7 +70,6 @@ import Simplex.Messaging.Transport (ATransport)
import System.Directory (doesFileExist, removeFile)
import Test.Hspec
import UnliftIO
import Util
removeFileIfExists :: FilePath -> IO ()
removeFileIfExists filePath = do
@@ -144,28 +143,26 @@ notificationTests t = do
withNtfServerOn t ntfTestPort2 . withNtfServerThreadOn t ntfTestPort $ \ntf ->
testNotificationsNewToken apns ntf
testNtfMatrix :: ATransport -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> Spec
testNtfMatrix :: HasCallStack => ATransport -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> Spec
testNtfMatrix t runTest = do
describe "next and current" $ do
it "next servers: SMP v7, NTF v2; next clients: v7/v2" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfgV7 agentCfgV7 runTest
it "next servers: SMP v7, NTF v2; curr clients: v6/v1" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfg agentCfg runTest
it "curr servers: SMP v6, NTF v1; curr clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfg agentCfg agentCfg runTest
skip "this case cannot be supported - see RFC" $
it "servers: SMP v6, NTF v1; clients: v7/v2 (not supported)" $
runNtfTestCfg t cfg ntfServerCfg agentCfgV7 agentCfgV7 runTest
-- servers can be migrated in any order
it "servers: next SMP v7, curr NTF v1; curr clients: v6/v1" $ runNtfTestCfg t cfgV7 ntfServerCfg agentCfg agentCfg runTest
it "servers: curr SMP v6, next NTF v2; curr clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfgV2 agentCfg agentCfg runTest
-- clients can be partially migrated
it "servers: next SMP v7, curr NTF v2; clients: next/curr" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfgV7 agentCfg runTest
it "servers: next SMP v7, curr NTF v2; clients: curr/new" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfg agentCfgV7 runTest
it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
-- servers can be upgraded in any order
it "servers: curr SMP, prev NTF; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
it "servers: prev SMP, curr NTF; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
-- one of two clients can be upgraded
it "servers: curr SMP, curr NTF; clients: curr/prev" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfg agentCfgVPrevPQ runTest
it "servers: curr SMP, curr NTF; clients: prev/curr" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfg runTest
runNtfTestCfg :: ATransport -> ServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> IO ()
runNtfTestCfg t smpCfg ntfCfg aCfg bCfg runTest = do
runNtfTestCfg :: HasCallStack => ATransport -> AgentMsgId -> ServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
runNtfTestCfg t baseId smpCfg ntfCfg aCfg bCfg runTest = do
withSmpServerConfigOn t smpCfg testPort $ \_ ->
withAPNSMockServer $ \apns ->
withNtfServerCfg ntfCfg {transports = [(ntfTestPort, t)]} $ \_ ->
withAgentClientsCfg2 aCfg bCfg $ runTest apns
withAgentClientsCfg2 aCfg bCfg $ runTest apns baseId
threadDelay 100000
testNotificationToken :: APNSMockServer -> IO ()
@@ -345,8 +342,8 @@ testRunNTFServerTests t srv =
withAgent 1 agentCfg initAgentServers testDB $ \a ->
testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing
testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentClient -> AgentClient -> IO ()
testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
(bobId, aliceId, nonce, message) <- runRight $ do
-- establish connection
(bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -404,11 +401,10 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@Agen
-- no notifications should follow
noNotification apnsQ
where
baseId = 3
msgId = subtract baseId
testNotificationSubscriptionNewConnection :: APNSMockServer -> AgentClient -> AgentClient -> IO ()
testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} alice bob =
testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bob =
runRight_ $ do
-- alice registers notification token
DeviceToken {} <- registerTestToken alice "abcd" NMInstant apnsQ
@@ -426,9 +422,9 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} alice bob =
allowConnection alice bobId confId "alice's connInfo"
void $ messageNotificationData bob apnsQ
get bob ##> ("", aliceId, INFO "alice's connInfo")
void $ messageNotificationData alice apnsQ
when (baseId == 3) $ void $ messageNotificationData alice apnsQ
get alice ##> ("", bobId, CON)
void $ messageNotificationData bob apnsQ
when (baseId == 3) $ void $ messageNotificationData bob apnsQ
get bob ##> ("", aliceId, CON)
-- bob sends message
1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
@@ -445,7 +441,6 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} alice bob =
-- no unexpected notifications should follow
noNotification apnsQ
where
baseId = 3
msgId = subtract baseId
registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO DeviceToken
@@ -520,7 +515,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
-- no notifications should follow
noNotification apnsQ
where
baseId = 3
baseId = 1
msgId = subtract baseId
testChangeToken :: APNSMockServer -> IO ()
@@ -559,7 +554,7 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
-- no notifications should follow
noNotification apnsQ
where
baseId = 3
baseId = 1
msgId = subtract baseId
testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO ()
@@ -568,11 +563,11 @@ testNotificationsStoreLog t APNSMockServer {apnsQ} = withAgentClients2 $ \alice
(aliceId, bobId) <- makeConnection alice bob
_ <- registerTestToken alice "abcd" NMInstant apnsQ
liftIO $ threadDelay 250000
4 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
get bob ##> ("", aliceId, SENT 4)
2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
get bob ##> ("", aliceId, SENT 2)
void $ messageNotificationData alice apnsQ
get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
ackMessage alice bobId 4 Nothing
ackMessage alice bobId 2 Nothing
liftIO $ killThread threadId
pure (aliceId, bobId)
@@ -580,8 +575,8 @@ testNotificationsStoreLog t APNSMockServer {apnsQ} = withAgentClients2 $ \alice
withNtfServerStoreLog t $ \threadId -> runRight_ $ do
liftIO $ threadDelay 250000
5 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
get bob ##> ("", aliceId, SENT 5)
3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
get bob ##> ("", aliceId, SENT 3)
void $ messageNotificationData alice apnsQ
get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
liftIO $ killThread threadId
@@ -592,11 +587,11 @@ testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alic
(aliceId, bobId) <- makeConnection alice bob
_ <- registerTestToken alice "abcd" NMInstant apnsQ
liftIO $ threadDelay 250000
4 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
get bob ##> ("", aliceId, SENT 4)
2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
get bob ##> ("", aliceId, SENT 2)
void $ messageNotificationData alice apnsQ
get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
ackMessage alice bobId 4 Nothing
ackMessage alice bobId 2 Nothing
liftIO $ killThread threadId
pure (aliceId, bobId)
@@ -608,8 +603,8 @@ testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alic
nGet alice =##> \case ("", "", UP _ [c]) -> c == bobId; _ -> False
nGet bob =##> \case ("", "", UP _ [c]) -> c == aliceId; _ -> False
liftIO $ threadDelay 1000000
5 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
get bob ##> ("", aliceId, SENT 5)
3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
get bob ##> ("", aliceId, SENT 3)
_ <- messageNotificationData alice apnsQ
get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
liftIO $ killThread threadId
@@ -664,7 +659,7 @@ testSwitchNotifications :: InitialAgentServers -> APNSMockServer -> IO ()
testSwitchNotifications servers APNSMockServer {apnsQ} =
withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
(aId, bId) <- makeConnection a b
exchangeGreetingsMsgId 4 a bId b aId
exchangeGreetings a bId b aId
_ <- registerTestToken a "abcd" NMInstant apnsQ
liftIO $ threadDelay 250000
let testMessage msg = do
@@ -739,7 +734,7 @@ messageNotification apnsQ = do
pure (nonce, message)
_ -> error "bad notification"
messageNotificationData :: AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
messageNotificationData c apnsQ = do
(nonce, message) <- messageNotification apnsQ
NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
+9 -2
View File
@@ -197,6 +197,9 @@ cData1 =
testPrivateAuthKey :: C.APrivateAuthKey
testPrivateAuthKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
testPublicAuthKey :: C.APublicAuthKey
testPublicAuthKey = C.APublicAuthKey C.SEd25519 (C.publicKey "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe")
testPrivDhKey :: C.PrivateKeyX25519
testPrivDhKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk"
@@ -218,6 +221,7 @@ rcvQueue1 =
e2ePrivKey = testPrivDhKey,
e2eDhSecret = Nothing,
sndId = "2345",
sndSecure = True,
status = New,
dbQueueId = DBNewQueue,
primary = True,
@@ -235,7 +239,8 @@ sndQueue1 =
connId = "conn1",
server = smpServer1,
sndId = "3456",
sndPublicKey = Nothing,
sndSecure = True,
sndPublicKey = testPublicAuthKey,
sndPrivateKey = testPrivateAuthKey,
e2ePubKey = Nothing,
e2eDhSecret = testDhSecret,
@@ -379,7 +384,8 @@ testUpgradeRcvConnToDuplex =
connId = "conn1",
server = SMPServer "smp.simplex.im" "5223" testKeyHash,
sndId = "2345",
sndPublicKey = Nothing,
sndSecure = True,
sndPublicKey = testPublicAuthKey,
sndPrivateKey = testPrivateAuthKey,
e2ePubKey = Nothing,
e2eDhSecret = testDhSecret,
@@ -412,6 +418,7 @@ testUpgradeSndConnToDuplex =
e2ePrivKey = testPrivDhKey,
e2eDhSecret = Nothing,
sndId = "4567",
sndSecure = True,
status = New,
dbQueueId = DBNewQueue,
rcvSwchStatus = Nothing,
+1
View File
@@ -183,6 +183,7 @@ dummyRQ userId server connId =
e2ePrivKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk",
e2eDhSecret = Nothing,
sndId = "",
sndSecure = True,
status = New,
dbQueueId = DBQueueId 0,
primary = True,
+8 -9
View File
@@ -28,7 +28,7 @@ import Network.HTTP.Types (Status)
import qualified Network.HTTP.Types as N
import qualified Network.HTTP2.Server as H
import Network.Socket
import SMPClient (serverBracket)
import SMPClient (prevRange, serverBracket)
import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost, defaultNetworkConfig)
import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
import qualified Simplex.Messaging.Crypto as C
@@ -36,7 +36,6 @@ import Simplex.Messaging.Encoding
import Simplex.Messaging.Notifications.Protocol (NtfResponse)
import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
import Simplex.Messaging.Notifications.Server.Env
import qualified Simplex.Messaging.Notifications.Server.Env as Env
import Simplex.Messaging.Notifications.Server.Push.APNS
import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
import Simplex.Messaging.Notifications.Transport
@@ -47,7 +46,6 @@ import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), http2TLSParams)
import Simplex.Messaging.Transport.HTTP2.Server
import Simplex.Messaging.Transport.Server
import qualified Simplex.Messaging.Transport.Server as Server
import Simplex.Messaging.Version (mkVersionRange)
import Test.Hspec
import UnliftIO.Async
import UnliftIO.Concurrent
@@ -108,18 +106,19 @@ ntfServerCfg =
serverStatsLogFile = "tests/ntf-server-stats.daily.log",
serverStatsBackupFile = Nothing,
ntfServerVRange = supportedServerNTFVRange,
transportConfig = defaultTransportServerConfig
transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedNTFHandshakes}
}
ntfServerCfgV2 :: NtfServerConfig
ntfServerCfgV2 =
ntfServerCfgVPrev :: NtfServerConfig
ntfServerCfgVPrev =
ntfServerCfg
{ ntfServerVRange = mkVersionRange initialNTFVersion authBatchCmdsNTFVersion,
smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}},
Env.transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedNTFHandshakes}
{ ntfServerVRange = prevRange $ ntfServerVRange ntfServerCfg,
smpAgentCfg = smpAgentCfg' {smpCfg = smpCfg' {serverVRange = prevRange serverVRange'}}
}
where
smpAgentCfg' = smpAgentCfg ntfServerCfg
smpCfg' = smpCfg smpAgentCfg'
serverVRange' = serverVRange smpCfg'
withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t)]}
+3 -3
View File
@@ -14,7 +14,7 @@ import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import NtfClient (ntfTestPort)
import SMPClient (proxyVRange, testPort)
import SMPClient (proxyVRangeV8, testPort)
import Simplex.Messaging.Agent.Env.SQLite
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval
@@ -80,8 +80,8 @@ agentCfg =
where
networkConfig = defaultNetworkConfig {tcpConnectTimeout = 1_000_000, tcpTimeout = 2_000_000}
agentProxyCfg :: AgentConfig
agentProxyCfg = agentCfg {smpCfg = (smpCfg agentCfg) {serverVRange = proxyVRange}}
agentProxyCfgV8 :: AgentConfig
agentProxyCfgV8 = agentCfg {smpCfg = (smpCfg agentCfg) {serverVRange = proxyVRangeV8}}
fastRetryInterval :: RetryInterval
fastRetryInterval = defaultReconnectInterval {initialInterval = 50_000}
+15 -9
View File
@@ -29,6 +29,7 @@ import qualified Simplex.Messaging.Transport.Client as Client
import Simplex.Messaging.Transport.Server
import qualified Simplex.Messaging.Transport.Server as Server
import Simplex.Messaging.Version
import Simplex.Messaging.Version.Internal
import System.Environment (lookupEnv)
import System.Info (os)
import Test.Hspec
@@ -133,18 +134,26 @@ cfgV7 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVer
cfgV8 :: ServerConfig
cfgV8 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion}
cfgVPrev :: ServerConfig
cfgVPrev = cfg {smpServerVRange = prevRange $ smpServerVRange cfg}
prevRange :: VersionRange v -> VersionRange v
prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr)}
prevVersion :: Version v -> Version v
prevVersion (Version v) = Version (v - 1)
proxyCfg :: ServerConfig
proxyCfg =
cfgV7
cfg
{ allowSMPProxy = True,
smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion,
smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {serverVRange = proxyVRange, agreeSecret = True}}
smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True}}
}
where
smpAgentCfg' = smpAgentCfg cfgV7
smpAgentCfg' = smpAgentCfg cfg
proxyVRange :: VersionRangeSMP
proxyVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
proxyVRangeV8 :: VersionRangeSMP
proxyVRangeV8 = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
@@ -180,9 +189,6 @@ withSmpServerOn t port' = withSmpServerThreadOn t port' . const
withSmpServer :: HasCallStack => ATransport -> IO a -> IO a
withSmpServer t = withSmpServerOn t testPort
withSmpServerV7 :: HasCallStack => ATransport -> IO a -> IO a
withSmpServerV7 t = withSmpServerConfigOn t cfgV7 testPort . const
withSmpServerProxy :: HasCallStack => ATransport -> IO a -> IO a
withSmpServerProxy t = withSmpServerConfigOn t proxyCfg testPort . const
+19 -20
View File
@@ -102,22 +102,22 @@ smpProxyTests = do
describe "agent API" $ do
describe "one server" $ do
it "always via proxy" . oneServer $
agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv1], SPMAlways, True) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv1], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
it "without proxy" . oneServer $
agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv1], SPMNever, False) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv1], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
describe "two servers" $ do
it "always via proxy" . twoServers $
agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv2], SPMAlways, True) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv2], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
it "both via proxy" . twoServers $
agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMUnknown, True) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMUnknown, True) C.SEd448 "hello 1" "hello 2" 1
it "first via proxy" . twoServers $
agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
it "without proxy" . twoServers $
agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
it "first via proxy for unknown" . twoServers $
agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv1, srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv1, srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 1
it "without proxy with fallback" . twoServers_ proxyCfg cfgV7 $
agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2"
agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 3
it "fails when fallback is prohibited" . twoServers_ proxyCfg cfgV7 $
agentViaProxyVersionError
it "retries sending when destination or proxy relay is offline" $
@@ -157,7 +157,7 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
-- prepare receiving queue
(rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
(rdhPub, rdhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe
QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe False
let dec = decryptMsgV3 $ C.dh' srvDh rdhPriv
-- get proxy session
sess0 <- runExceptT' $ connectSMPProxiedRelay pc relayServ (Just "correct")
@@ -199,8 +199,8 @@ proxyConnectDeadRelay n d proxyServ = do
Right !_noWay -> error "got unexpected client"
Left !_err -> threadDelay d
agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty SMPServer, SMPProxyMode, Bool) -> (NonEmpty SMPServer, SMPProxyMode, Bool) -> C.SAlgorithm a -> ByteString -> ByteString -> IO ()
agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 =
agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty SMPServer, SMPProxyMode, Bool) -> (NonEmpty SMPServer, SMPProxyMode, Bool) -> C.SAlgorithm a -> ByteString -> ByteString -> AgentMsgId -> IO ()
agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 baseId =
withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
(bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
@@ -232,9 +232,8 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
ackMessage alice bobId (baseId + 4) Nothing
where
baseId = 3
msgId = subtract baseId . fst
aCfg = agentProxyCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg}
aCfg = agentCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg}
servers (srvs, smpProxyMode, _) = (initAgentServersProxy smpProxyMode SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
agentDeliverMessagesViaProxyConc :: [NonEmpty SMPServer] -> [MsgBody] -> IO ()
@@ -299,14 +298,14 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
Left (Left e) -> cancel aSender >> throwIO e
logDebug "run finished"
pqEnc = CR.PQEncOn
aCfg = agentProxyCfg {sndAuthAlg = C.AuthAlg C.SEd448, rcvAuthAlg = C.AuthAlg C.SEd448}
aCfg = agentCfg {sndAuthAlg = C.AuthAlg C.SEd448, rcvAuthAlg = C.AuthAlg C.SEd448}
servers srvs = (initAgentServersProxy SPMAlways SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
agentViaProxyVersionError :: IO ()
agentViaProxyVersionError =
withAgent 1 agentProxyCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
Left (A.BROKER _ (TRANSPORT TEVersion)) <-
withAgent 2 agentProxyCfg (servers [SMPServer testHost testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
withAgent 2 agentCfg (servers [SMPServer testHost testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
(_bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
pure ()
@@ -370,22 +369,22 @@ agentViaProxyRetryOffline = do
withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs} port
a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
aCfg = agentProxyCfg {messageRetryInterval = fastMessageRetryInterval}
baseId = 3
aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
baseId = 1
msgId = subtract baseId . fst
servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers $ L.map noAuthSrv [srv]}
testNoProxy :: IO ()
testNoProxy = do
withSmpServerConfigOn (transport @TLS) cfg testPort2 $ \_ -> do
testSMPClient_ "127.0.0.1" testPort2 proxyVRange $ \(th :: THandleSMP TLS 'TClient) -> do
testSMPClient_ "127.0.0.1" testPort2 proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
(_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", PRXY testSMPServer Nothing)
reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
testProxyAuth :: IO ()
testProxyAuth = do
withSmpServerConfigOn (transport @TLS) proxyCfgAuth testPort $ \_ -> do
testSMPClient_ "127.0.0.1" testPort proxyVRange $ \(th :: THandleSMP TLS 'TClient) -> do
testSMPClient_ "127.0.0.1" testPort proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
(_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", PRXY testSMPServer2 $ Just "wrong")
reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
where
+13 -13
View File
@@ -73,7 +73,7 @@ pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission ErrorType B
pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
pattern Ids :: RecipientId -> SenderId -> RcvPublicDhKey -> BrokerMsg
pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh)
pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh _sndSecure)
pattern Msg :: MsgId -> MsgBody -> BrokerMsg
pattern Msg msgId body <- MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body}
@@ -134,7 +134,7 @@ testCreateSecure (ATransport t) =
g <- C.newRandom
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
(rId1, "") #== "creates queue"
@@ -199,7 +199,7 @@ testCreateDelete (ATransport t) =
g <- C.newRandom
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
(rId1, "") #== "creates queue"
@@ -271,7 +271,7 @@ stressTest (ATransport t) =
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
(dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
rIds <- forM ([1 .. 50] :: [Int]) . const $ do
Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing SMSubscribe)
Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing SMSubscribe False)
pure rId
let subscribeQueues h = forM_ rIds $ \rId -> do
Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
@@ -289,7 +289,7 @@ testAllowNewQueues t =
g <- C.newRandom
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
(dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
pure ()
testDuplex :: ATransport -> Spec
@@ -299,7 +299,7 @@ testDuplex (ATransport t) =
g <- C.newRandom
(arPub, arKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
(aDhPub, aDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing SMSubscribe)
Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing SMSubscribe False)
let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
-- aSnd ID is passed to Bob out-of-band
@@ -315,7 +315,7 @@ testDuplex (ATransport t) =
(brPub, brKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
(bDhPub, bDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing SMSubscribe)
Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing SMSubscribe False)
let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode bSnd)
-- "reply_id ..." is ad-hoc, not a part of SMP protocol
@@ -354,7 +354,7 @@ testSwitchSub (ATransport t) =
g <- C.newRandom
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
(ok1, OK) #== "sent test message 1"
@@ -740,7 +740,7 @@ createAndSecureQueue h sPub = do
g <- C.newRandom
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
let dhShared = C.dh' srvDh dhPriv
Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
(rId', rId) #== "same queue ID"
@@ -751,7 +751,7 @@ testTiming (ATransport t) =
describe "should have similar time for auth error, whether queue exists or not, for all key types" $
forM_ timingTests $ \tst ->
it (testName tst) $
smpTest2Cfg cfgV7 (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh ->
smpTest2Cfg cfg (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh ->
testSameTiming rh sh tst
where
testName :: (C.AuthAlg, C.AuthAlg, Int) -> String
@@ -775,7 +775,7 @@ testTiming (ATransport t) =
g <- C.newRandom
(rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)
@@ -937,8 +937,8 @@ syntaxTests (ATransport t) = do
describe "NEW" $ do
it "no parameters" $ (sampleSig, "bcda", "", NEW_) >#> ("", "bcda", "", ERR $ CMD SYNTAX)
it "many parameters" $ (sampleSig, "cdab", "", (NEW_, ' ', ('\x01', 'A'), samplePubKey, sampleDhPubKey)) >#> ("", "cdab", "", ERR $ CMD SYNTAX)
it "no signature" $ ("", "dabc", "", (NEW_, ' ', samplePubKey, sampleDhPubKey, SMSubscribe)) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
it "queue ID" $ (sampleSig, "abcd", "12345678", (NEW_, ' ', samplePubKey, sampleDhPubKey, SMSubscribe)) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
it "no signature" $ ("", "dabc", "", (NEW_, ' ', samplePubKey, sampleDhPubKey, '0', SMSubscribe, False)) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
it "queue ID" $ (sampleSig, "abcd", "12345678", (NEW_, ' ', samplePubKey, sampleDhPubKey, '0', SMSubscribe, False)) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
describe "KEY" $ do
it "valid syntax" $ (sampleSig, "bcda", "12345678", (KEY_, ' ', samplePubKey)) >#> ("", "bcda", "12345678", ERR AUTH)
it "no parameters" $ (sampleSig, "cdab", "12345678", KEY_) >#> ("", "cdab", "12345678", ERR $ CMD SYNTAX)
+6 -6
View File
@@ -398,7 +398,7 @@ testXFTPAgentReceiveCleanup = withGlobalLogging logCfgNoLogs $ do
-- receive file - should fail with AUTH error
withAgent 3 agentCfg initAgentServers testDB2 $ \rcp' -> do
runRight_ $ xftpStartWorkers rcp' (Just recipientFiles)
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <- rfGet rcp'
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <- rfGet rcp'
rfId' `shouldBe` rfId
-- tmp path should be removed after permanent error
@@ -477,7 +477,7 @@ testXFTPAgentSendCleanup = withGlobalLogging logCfgNoLogs $ do
-- send file - should fail with AUTH error
withAgent 2 agentCfg initAgentServers testDB $ \sndr' -> do
runRight_ $ xftpStartWorkers sndr' (Just senderFiles)
("", sfId', SFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
("", sfId', SFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
sfGet sndr'
sfId' `shouldBe` sfId
@@ -513,7 +513,7 @@ testXFTPAgentDelete = withGlobalLogging logCfgNoLogs $
withAgent 3 agentCfg initAgentServers testDB2 $ \rcp2 -> runRight $ do
xftpStartWorkers rcp2 (Just recipientFiles)
rfId <- xftpReceiveFile rcp2 1 rfd2 Nothing True
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
rfGet rcp2
liftIO $ rfId' `shouldBe` rfId
@@ -551,7 +551,7 @@ testXFTPAgentDeleteRestore = withGlobalLogging logCfgNoLogs $ do
withAgent 5 agentCfg initAgentServers testDB3 $ \rcp2 -> runRight $ do
xftpStartWorkers rcp2 (Just recipientFiles)
rfId <- xftpReceiveFile rcp2 1 rfd2 Nothing True
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
rfGet rcp2
liftIO $ rfId' `shouldBe` rfId
@@ -586,7 +586,7 @@ testXFTPAgentDeleteOnServer = withGlobalLogging logCfgNoLogs $
runRight_ . void $ do
-- receive file 1 again
rfId1 <- xftpReceiveFile rcp 1 rfd1_2 Nothing True
("", rfId1', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
("", rfId1', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
rfGet rcp
liftIO $ rfId1 `shouldBe` rfId1'
@@ -619,7 +619,7 @@ testXFTPAgentExpiredOnServer = withGlobalLogging logCfgNoLogs $ do
-- receive file 1 again - should fail with AUTH error
runRight $ do
rfId <- xftpReceiveFile rcp 1 rfd1_2 Nothing True
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
rfGet rcp
liftIO $ rfId' `shouldBe` rfId
+4 -4
View File
@@ -67,10 +67,10 @@ withXFTPServer2 :: HasCallStack => IO a -> IO a
withXFTPServer2 = withXFTPServerCfg testXFTPServerConfig {xftpPort = xftpTestPort2, filesPath = xftpServerFiles2} . const
xftpTestPort :: ServiceName
xftpTestPort = "7000"
xftpTestPort = "8000"
xftpTestPort2 :: ServiceName
xftpTestPort2 = "7001"
xftpTestPort2 = "8001"
testXFTPServer :: XFTPServer
testXFTPServer = fromString testXFTPServerStr
@@ -79,10 +79,10 @@ testXFTPServer2 :: XFTPServer
testXFTPServer2 = fromString testXFTPServerStr2
testXFTPServerStr :: String
testXFTPServerStr = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000"
testXFTPServerStr = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000"
testXFTPServerStr2 :: String
testXFTPServerStr2 = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001"
testXFTPServerStr2 = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8001"
xftpServerFiles :: FilePath
xftpServerFiles = "tests/tmp/xftp-server-files"