mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-30 14:16:00 +00:00
agent: make version independent of PQ enqryption support (#1114)
* agent: make version independent of PQ enqryption support * remove comment
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
1612a7e2c7
commit
fe28e02be7
@@ -618,14 +618,14 @@ newConnAsync c userId corrId enableNtfs cMode pqInitKeys subMode = do
|
||||
newConnNoQueues :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId
|
||||
newConnNoQueues c userId connId enableNtfs cMode pqSupport = do
|
||||
g <- asks random
|
||||
connAgentVersion <- asks $ maxVersion . ($ pqSupport) . smpAgentVRange . config
|
||||
connAgentVersion <- asks $ maxVersion . smpAgentVRange . config
|
||||
let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
|
||||
withStore c $ \db -> createNewConn db g cData cMode
|
||||
|
||||
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
|
||||
joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
|
||||
withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
|
||||
lift (compatibleInvitationUri cReqUri pqSup) >>= \case
|
||||
lift (compatibleInvitationUri cReqUri) >>= \case
|
||||
Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
|
||||
g <- asks random
|
||||
let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
|
||||
@@ -729,16 +729,14 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
|
||||
when enableNtfs $ do
|
||||
ns <- asks ntfSupervisor
|
||||
atomically $ sendNtfSubCommand ns (connId, NSCCreate)
|
||||
let pqEnc = CR.connPQEncryption pqInitKeys
|
||||
crData = ConnReqUriData SSSimplex (smpAgentVRange pqEnc) [qUri] clientData
|
||||
e2eVRange = e2eEncryptVRange pqEnc
|
||||
let crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
|
||||
case cMode of
|
||||
SCMContact -> pure (connId, CRContactUri crData)
|
||||
SCMInvitation -> do
|
||||
g <- asks random
|
||||
(pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVRange) (CR.initialPQEncryption pqInitKeys)
|
||||
(pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) (CR.initialPQEncryption pqInitKeys)
|
||||
withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem
|
||||
pure (connId, CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVRange)
|
||||
pure (connId, CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange)
|
||||
|
||||
joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
|
||||
joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do
|
||||
@@ -750,14 +748,14 @@ joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do
|
||||
|
||||
startJoinInvitation :: UserId -> ConnId -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (Compatible VersionSMPA, ConnData, NewSndQueue, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448)
|
||||
startJoinInvitation userId connId enableNtfs cReqUri pqSup =
|
||||
lift (compatibleInvitationUri cReqUri pqSup) >>= \case
|
||||
lift (compatibleInvitationUri cReqUri) >>= \case
|
||||
Just (qInfo, (Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_)), aVersion@(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)
|
||||
(_, rcDHRs) <- atomically $ C.generateKeyPair g
|
||||
rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams
|
||||
maxSupported <- asks $ maxVersion . ($ pqSup) . e2eEncryptVRange . config
|
||||
maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
|
||||
let rcVs = CR.RatchetVersions {current = v, maxSupported}
|
||||
rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
|
||||
q <- lift $ newSndQueue userId "" qInfo
|
||||
@@ -767,29 +765,29 @@ startJoinInvitation userId connId enableNtfs cReqUri pqSup =
|
||||
|
||||
connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport))
|
||||
connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of
|
||||
CRInvitationUri {} -> invPQSupported <$$> compatibleInvitationUri cReq pqSup
|
||||
CRInvitationUri {} -> invPQSupported <$$> compatibleInvitationUri cReq
|
||||
where
|
||||
invPQSupported (_, Compatible (CR.E2ERatchetParams e2eV _ _ _), Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV (Just e2eV))
|
||||
CRContactUri {} -> ctPQSupported <$$> compatibleContactUri cReq pqSup
|
||||
CRContactUri {} -> ctPQSupported <$$> compatibleContactUri cReq
|
||||
where
|
||||
ctPQSupported (_, Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV Nothing)
|
||||
|
||||
compatibleInvitationUri :: ConnectionRequestUri 'CMInvitation -> PQSupport -> AM' (Maybe (Compatible SMPQueueInfo, Compatible (CR.RcvE2ERatchetParams 'C.X448), Compatible VersionSMPA))
|
||||
compatibleInvitationUri (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) pqSup = do
|
||||
compatibleInvitationUri :: ConnectionRequestUri 'CMInvitation -> AM' (Maybe (Compatible SMPQueueInfo, Compatible (CR.RcvE2ERatchetParams 'C.X448), Compatible VersionSMPA))
|
||||
compatibleInvitationUri (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) = do
|
||||
AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
|
||||
pure $
|
||||
(,,)
|
||||
<$> (qUri `compatibleVersion` smpClientVRange)
|
||||
<*> (e2eRcvParamsUri `compatibleVersion` e2eEncryptVRange pqSup)
|
||||
<*> (crAgentVRange `compatibleVersion` smpAgentVRange pqSup)
|
||||
<*> (e2eRcvParamsUri `compatibleVersion` e2eEncryptVRange)
|
||||
<*> (crAgentVRange `compatibleVersion` smpAgentVRange)
|
||||
|
||||
compatibleContactUri :: ConnectionRequestUri 'CMContact -> PQSupport -> AM' (Maybe (Compatible SMPQueueInfo, Compatible VersionSMPA))
|
||||
compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)}) pqSup = do
|
||||
compatibleContactUri :: ConnectionRequestUri 'CMContact -> AM' (Maybe (Compatible SMPQueueInfo, Compatible VersionSMPA))
|
||||
compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)}) = do
|
||||
AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
|
||||
pure $
|
||||
(,)
|
||||
<$> (qUri `compatibleVersion` smpClientVRange)
|
||||
<*> (crAgentVRange `compatibleVersion` smpAgentVRange pqSup)
|
||||
<*> (crAgentVRange `compatibleVersion` smpAgentVRange)
|
||||
|
||||
versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport
|
||||
versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_
|
||||
@@ -812,7 +810,7 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod
|
||||
void $ withStore' c $ \db -> deleteConn db Nothing connId'
|
||||
throwError e
|
||||
joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv =
|
||||
lift (compatibleContactUri cReqUri pqSup) >>= \case
|
||||
lift (compatibleContactUri cReqUri) >>= \case
|
||||
Just (qInfo, vrsn) -> do
|
||||
(connId', cReq) <- newConnSrv c userId connId enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
|
||||
sendInvitation c userId qInfo vrsn cReq cInfo
|
||||
@@ -1219,7 +1217,7 @@ enqueueMessageB c reqs = do
|
||||
pure $ Right ((msgId, pqSecr), if null sqs' then Nothing else Just (cData, sqs', msgId))
|
||||
where
|
||||
storeSentMsg :: DB.Connection -> AgentConfig -> (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage) -> IO (Either AgentErrorType ((ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage), InternalId, PQEncryption))
|
||||
storeSentMsg db cfg req@(cData@ConnData {connId, pqSupport}, sq :| _, pqEnc_, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do
|
||||
storeSentMsg db cfg req@(cData@ConnData {connId}, sq :| _, pqEnc_, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do
|
||||
let AgentConfig {smpAgentVRange, e2eEncryptVRange} = cfg
|
||||
internalTs <- liftIO getCurrentTime
|
||||
(internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
|
||||
@@ -1227,10 +1225,9 @@ enqueueMessageB c reqs = do
|
||||
agentMsg = AgentMessage privHeader aMessage
|
||||
agentMsgStr = smpEncode agentMsg
|
||||
internalHash = C.sha256Hash agentMsgStr
|
||||
currentE2EVersion = maxVersion $ e2eEncryptVRange PQSupportOff
|
||||
(encAgentMessage, pqEnc) <- agentRatchetEncrypt db cData agentMsgStr e2eEncUserMsgLength pqEnc_ currentE2EVersion
|
||||
-- agent version range is determined by the connection suppport of PQ encryption, that is may be enabled when message is sent
|
||||
let agentVersion = maxVersion $ smpAgentVRange pqSupport
|
||||
currentE2EVersion = maxVersion e2eEncryptVRange
|
||||
(encAgentMessage, pqEnc) <- agentRatchetEncrypt db cData agentMsgStr e2eEncAgentMsgLength pqEnc_ currentE2EVersion
|
||||
let agentVersion = maxVersion smpAgentVRange
|
||||
msgBody = smpEncode $ AgentMsgEnvelope {agentVersion, encAgentMessage}
|
||||
msgType = agentMessageType agentMsg
|
||||
msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody, pqEncryption = pqEnc, internalHash, prevMsgHash}
|
||||
@@ -1520,7 +1517,7 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
|
||||
let cData' = cData {pqSupport = pqSupport'} :: ConnData
|
||||
AgentConfig {e2eEncryptVRange} <- asks config
|
||||
g <- asks random
|
||||
(pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion $ e2eEncryptVRange pqSupport') pqSupport'
|
||||
(pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqSupport'
|
||||
enqueueRatchetKeyMsgs c cData' sqs e2eParams
|
||||
withStore' c $ \db -> do
|
||||
setConnRatchetSync db connId RSStarted
|
||||
@@ -2189,8 +2186,8 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
|
||||
_ -> prohibited >> ack
|
||||
_ -> prohibited >> ack
|
||||
updateConnVersion :: Connection c -> ConnData -> VersionSMPA -> AM (Connection c)
|
||||
updateConnVersion conn' cData'@ConnData {pqSupport} msgAgentVersion = do
|
||||
aVRange <- asks $ ($ pqSupport) . smpAgentVRange . config
|
||||
updateConnVersion conn' cData' msgAgentVersion = do
|
||||
aVRange <- asks $ smpAgentVRange . config
|
||||
let msgAVRange = fromMaybe (versionToRange msgAgentVersion) $ safeVersionRange (minVersion aVRange) msgAgentVersion
|
||||
case msgAVRange `compatibleVersion` aVRange of
|
||||
Just (Compatible av)
|
||||
@@ -2256,19 +2253,17 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
|
||||
logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret srvMsgId
|
||||
AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
|
||||
let ConnData {pqSupport} = toConnData conn'
|
||||
aVRange = smpAgentVRange pqSupport
|
||||
e2eVRange = e2eEncryptVRange pqSupport
|
||||
unless
|
||||
(agentVersion `isCompatible` aVRange && smpClientVersion `isCompatible` smpClientVRange)
|
||||
(agentVersion `isCompatible` smpAgentVRange && smpClientVersion `isCompatible` smpClientVRange)
|
||||
(throwError $ AGENT A_VERSION)
|
||||
case status of
|
||||
New -> case (conn', e2eEncryption) of
|
||||
-- party initiating connection
|
||||
(RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _))) -> do
|
||||
unless (e2eVersion `isCompatible` e2eVRange) (throwError $ AGENT A_VERSION)
|
||||
unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwError $ AGENT A_VERSION)
|
||||
(pk1, rcDHRs, pKem) <- withStore c (`getRatchetX3dhKeys` connId)
|
||||
rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 rcDHRs pKem e2eSndParams
|
||||
let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eVRange}
|
||||
let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
|
||||
pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion)
|
||||
rc = CR.initRcvRatchet rcVs rcDHRs rcParams pqSupport'
|
||||
g <- asks random
|
||||
@@ -2450,7 +2445,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
|
||||
ContactConnection {} -> do
|
||||
-- show connection request even if invitaion via contact address is not compatible.
|
||||
-- in case invitation not compatible, assume there is no PQ encryption support.
|
||||
pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq PQSupportOn
|
||||
pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq
|
||||
g <- asks random
|
||||
let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo}
|
||||
invId <- withStore c $ \db -> createInvitation db g newInv
|
||||
@@ -2470,10 +2465,9 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
|
||||
newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqSupport} _ sqs) =
|
||||
unlessM ratchetExists $ do
|
||||
AgentConfig {e2eEncryptVRange} <- asks config
|
||||
let connE2EVRange = e2eEncryptVRange pqSupport
|
||||
unless (e2eVersion `isCompatible` connE2EVRange) (throwError $ AGENT A_VERSION)
|
||||
unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwError $ AGENT A_VERSION)
|
||||
keys <- getSendRatchetKeys
|
||||
let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion connE2EVRange}
|
||||
let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
|
||||
initRatchet rcVs keys
|
||||
notifyAgreed
|
||||
where
|
||||
@@ -2579,8 +2573,7 @@ confirmQueue (Compatible agentVersion) c cData@ConnData {connId, pqSupport} sq s
|
||||
where
|
||||
mkConfirmation :: AgentMessage -> AM MsgBody
|
||||
mkConfirmation aMessage = do
|
||||
-- the version to be used when PQSupport is disabled
|
||||
currentE2EVersion <- asks $ maxVersion . ($ PQSupportOff) . e2eEncryptVRange . config
|
||||
currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
|
||||
withStore c $ \db -> runExceptT $ do
|
||||
void . liftIO $ updateSndIds db connId
|
||||
let pqEnc = CR.pqSupportToEnc pqSupport
|
||||
@@ -2599,8 +2592,7 @@ enqueueConfirmation c cData sq connInfo e2eEncryption_ = do
|
||||
|
||||
storeConfirmation :: AgentClient -> ConnData -> SndQueue -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AgentMessage -> AM ()
|
||||
storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq e2eEncryption_ agentMsg = do
|
||||
-- the version to be used when PQSupport is disabled
|
||||
currentE2EVersion <- asks $ maxVersion . ($ PQSupportOff) . e2eEncryptVRange . config
|
||||
currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
|
||||
withStore c $ \db -> runExceptT $ do
|
||||
internalTs <- liftIO getCurrentTime
|
||||
(internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
|
||||
@@ -2620,8 +2612,8 @@ enqueueRatchetKeyMsgs c cData (sq :| sqs) e2eEncryption = do
|
||||
mapM_ (lift . enqueueSavedMessage c cData msgId) $ filter isActiveSndQ sqs
|
||||
|
||||
enqueueRatchetKey :: AgentClient -> ConnData -> SndQueue -> CR.RcvE2ERatchetParams 'C.X448 -> AM AgentMsgId
|
||||
enqueueRatchetKey c cData@ConnData {connId, pqSupport} sq e2eEncryption = do
|
||||
aVRange <- asks $ ($ pqSupport) . smpAgentVRange . config
|
||||
enqueueRatchetKey c cData@ConnData {connId} sq e2eEncryption = do
|
||||
aVRange <- asks $ smpAgentVRange . config
|
||||
msgId <- storeRatchetKey $ maxVersion aVRange
|
||||
lift $ submitPendingMsg c cData sq
|
||||
pure $ unId msgId
|
||||
|
||||
@@ -56,7 +56,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
|
||||
import Simplex.Messaging.Client
|
||||
import Simplex.Messaging.Client.Agent ()
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQSupport, VersionRangeE2E, supportedE2EEncryptVRange)
|
||||
import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange)
|
||||
import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
|
||||
import Simplex.Messaging.Notifications.Transport (NTFVersion)
|
||||
import Simplex.Messaging.Notifications.Types
|
||||
@@ -117,8 +117,8 @@ data AgentConfig = AgentConfig
|
||||
caCertificateFile :: FilePath,
|
||||
privateKeyFile :: FilePath,
|
||||
certificateFile :: FilePath,
|
||||
e2eEncryptVRange :: PQSupport -> VersionRangeE2E,
|
||||
smpAgentVRange :: PQSupport -> VersionRangeSMPA,
|
||||
e2eEncryptVRange :: VersionRangeE2E,
|
||||
smpAgentVRange :: VersionRangeSMPA,
|
||||
smpClientVRange :: VersionRangeSMPC
|
||||
}
|
||||
|
||||
|
||||
@@ -44,7 +44,7 @@ module Simplex.Messaging.Agent.Protocol
|
||||
currentSMPAgentVersion,
|
||||
supportedSMPAgentVRange,
|
||||
e2eEncConnInfoLength,
|
||||
e2eEncUserMsgLength,
|
||||
e2eEncAgentMsgLength,
|
||||
|
||||
-- * SMP agent protocol types
|
||||
ConnInfo,
|
||||
@@ -272,16 +272,11 @@ deliveryRcptsSMPAgentVersion = VersionSMPA 4
|
||||
pqdrSMPAgentVersion :: VersionSMPA
|
||||
pqdrSMPAgentVersion = VersionSMPA 5
|
||||
|
||||
-- TODO v5.7 increase to 5
|
||||
currentSMPAgentVersion :: VersionSMPA
|
||||
currentSMPAgentVersion = VersionSMPA 4
|
||||
currentSMPAgentVersion = VersionSMPA 5
|
||||
|
||||
-- TODO v5.7 remove dependency of version range on whether PQ support is needed
|
||||
supportedSMPAgentVRange :: PQSupport -> VersionRangeSMPA
|
||||
supportedSMPAgentVRange pq =
|
||||
mkVersionRange duplexHandshakeSMPAgentVersion $ case pq of
|
||||
PQSupportOn -> pqdrSMPAgentVersion
|
||||
PQSupportOff -> currentSMPAgentVersion
|
||||
supportedSMPAgentVRange :: VersionRangeSMPA
|
||||
supportedSMPAgentVRange = mkVersionRange duplexHandshakeSMPAgentVersion currentSMPAgentVersion
|
||||
|
||||
-- it is shorter to allow all handshake headers,
|
||||
-- including E2E (double-ratchet) parameters and
|
||||
@@ -292,8 +287,8 @@ e2eEncConnInfoLength v = \case
|
||||
PQSupportOn | v >= pqdrSMPAgentVersion -> 11122
|
||||
_ -> 14848
|
||||
|
||||
e2eEncUserMsgLength :: VersionSMPA -> PQSupport -> Int
|
||||
e2eEncUserMsgLength v = \case
|
||||
e2eEncAgentMsgLength :: VersionSMPA -> PQSupport -> Int
|
||||
e2eEncAgentMsgLength v = \case
|
||||
-- reduced by 2222 (the increase of message ratchet header size)
|
||||
PQSupportOn | v >= pqdrSMPAgentVersion -> 13634
|
||||
_ -> 15856
|
||||
|
||||
@@ -143,16 +143,11 @@ kdfX3DHE2EEncryptVersion = VersionE2E 2
|
||||
pqRatchetE2EEncryptVersion :: VersionE2E
|
||||
pqRatchetE2EEncryptVersion = VersionE2E 3
|
||||
|
||||
-- TODO v5.7 increase to 3
|
||||
currentE2EEncryptVersion :: VersionE2E
|
||||
currentE2EEncryptVersion = VersionE2E 2
|
||||
currentE2EEncryptVersion = VersionE2E 3
|
||||
|
||||
-- TODO v5.7 remove dependency of version range on whether PQ encryption is used
|
||||
supportedE2EEncryptVRange :: PQSupport -> VersionRangeE2E
|
||||
supportedE2EEncryptVRange pq =
|
||||
mkVersionRange kdfX3DHE2EEncryptVersion $ case pq of
|
||||
PQSupportOn -> pqRatchetE2EEncryptVersion
|
||||
PQSupportOff -> currentE2EEncryptVersion
|
||||
supportedE2EEncryptVRange :: VersionRangeE2E
|
||||
supportedE2EEncryptVRange = mkVersionRange kdfX3DHE2EEncryptVersion currentE2EEncryptVersion
|
||||
|
||||
data RatchetKEMState
|
||||
= RKSProposed -- only KEM encapsulation key
|
||||
|
||||
@@ -214,14 +214,13 @@ testDuplexConnection _ alice bob = testDuplexConnection' (alice, IKPQOn) (bob, P
|
||||
testDuplexConnection' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQSupport) -> IO ()
|
||||
testDuplexConnection' (alice, aPQ) (bob, bPQ) = do
|
||||
let pq = pqConnectionMode aPQ bPQ
|
||||
pqSup = CR.pqEncToSupport pq
|
||||
("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW T INV" <> pqConnModeStr aPQ <> " subscribe")
|
||||
let cReq' = strEncode cReq
|
||||
bob #: ("11", "alice", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo") #> ("11", "alice", OK)
|
||||
("", "bob", Right (A.CONF confId pqSup' _ "bob's connInfo")) <- (alice <#:)
|
||||
pqSup' `shouldBe` pqSup
|
||||
pqSup' `shouldBe` CR.connPQEncryption aPQ
|
||||
alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
|
||||
bob <# ("", "alice", A.INFO pqSup "alice's connInfo")
|
||||
bob <# ("", "alice", A.INFO bPQ "alice's connInfo")
|
||||
bob <# ("", "alice", CON pq)
|
||||
alice <# ("", "bob", CON pq)
|
||||
-- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
|
||||
@@ -253,15 +252,14 @@ testDuplexConnRandomIds _ alice bob = testDuplexConnRandomIds' (alice, IKPQOn) (
|
||||
testDuplexConnRandomIds' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQSupport) -> IO ()
|
||||
testDuplexConnRandomIds' (alice, aPQ) (bob, bPQ) = do
|
||||
let pq = pqConnectionMode aPQ bPQ
|
||||
pqSup = CR.pqEncToSupport pq
|
||||
("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW T INV" <> pqConnModeStr aPQ <> " subscribe")
|
||||
let cReq' = strEncode cReq
|
||||
("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo")
|
||||
("", bobConn', Right (A.CONF confId pqSup' _ "bob's connInfo")) <- (alice <#:)
|
||||
pqSup' `shouldBe` pqSup
|
||||
pqSup' `shouldBe` CR.connPQEncryption aPQ
|
||||
bobConn' `shouldBe` bobConn
|
||||
alice #: ("2", bobConn, "LET " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
|
||||
bob <# ("", aliceConn, A.INFO pqSup "alice's connInfo")
|
||||
bob <# ("", aliceConn, A.INFO bPQ "alice's connInfo")
|
||||
bob <# ("", aliceConn, CON pq)
|
||||
alice <# ("", bobConn, CON pq)
|
||||
alice #: ("2", bobConn, "SEND F :hello") #> ("2", bobConn, A.MID 4 pq)
|
||||
@@ -291,17 +289,15 @@ testContactConnection (alice, aPQ) (bob, bPQ) (tom, tPQ) = do
|
||||
("1", "alice_contact", Right (INV cReq)) <- alice #: ("1", "alice_contact", "NEW T CON" <> pqConnModeStr aPQ <> " subscribe")
|
||||
let cReq' = strEncode cReq
|
||||
abPQ = pqConnectionMode aPQ bPQ
|
||||
abPQSup = CR.pqEncToSupport abPQ
|
||||
aPQMode = CR.connPQEncryption aPQ
|
||||
|
||||
bob #: ("11", "alice", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo") #> ("11", "alice", OK)
|
||||
("", "alice_contact", Right (A.REQ aInvId pqSup' _ "bob's connInfo")) <- (alice <#:)
|
||||
pqSup' `shouldBe` bPQ
|
||||
("", "alice_contact", Right (A.REQ aInvId PQSupportOn _ "bob's connInfo")) <- (alice <#:)
|
||||
alice #: ("2", "bob", "ACPT " <> aInvId <> enableKEMStr aPQMode <> " 16\nalice's connInfo") #> ("2", "bob", OK)
|
||||
("", "alice", Right (A.CONF bConfId pqSup'' _ "alice's connInfo")) <- (bob <#:)
|
||||
pqSup'' `shouldBe` abPQSup
|
||||
pqSup'' `shouldBe` bPQ
|
||||
bob #: ("12", "alice", "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", "alice", OK)
|
||||
alice <# ("", "bob", A.INFO abPQSup "bob's connInfo 2")
|
||||
alice <# ("", "bob", A.INFO (CR.connPQEncryption aPQ) "bob's connInfo 2")
|
||||
alice <# ("", "bob", CON abPQ)
|
||||
bob <# ("", "alice", CON abPQ)
|
||||
alice #: ("3", "bob", "SEND F :hi") #> ("3", "bob", A.MID 4 abPQ)
|
||||
@@ -310,15 +306,13 @@ testContactConnection (alice, aPQ) (bob, bPQ) (tom, tPQ) = do
|
||||
bob #: ("13", "alice", "ACK 4") #> ("13", "alice", OK)
|
||||
|
||||
let atPQ = pqConnectionMode aPQ tPQ
|
||||
atPQSup = CR.pqEncToSupport atPQ
|
||||
tom #: ("21", "alice", "JOIN T " <> cReq' <> enableKEMStr tPQ <> " subscribe 14\ntom's connInfo") #> ("21", "alice", OK)
|
||||
("", "alice_contact", Right (A.REQ aInvId' pqSup3 _ "tom's connInfo")) <- (alice <#:)
|
||||
pqSup3 `shouldBe` tPQ
|
||||
("", "alice_contact", Right (A.REQ aInvId' PQSupportOn _ "tom's connInfo")) <- (alice <#:)
|
||||
alice #: ("4", "tom", "ACPT " <> aInvId' <> enableKEMStr aPQMode <> " 16\nalice's connInfo") #> ("4", "tom", OK)
|
||||
("", "alice", Right (A.CONF tConfId pqSup4 _ "alice's connInfo")) <- (tom <#:)
|
||||
pqSup4 `shouldBe` atPQSup
|
||||
pqSup4 `shouldBe` tPQ
|
||||
tom #: ("22", "alice", "LET " <> tConfId <> " 16\ntom's connInfo 2") #> ("22", "alice", OK)
|
||||
alice <# ("", "tom", A.INFO atPQSup "tom's connInfo 2")
|
||||
alice <# ("", "tom", A.INFO (CR.connPQEncryption aPQ) "tom's connInfo 2")
|
||||
alice <# ("", "tom", CON atPQ)
|
||||
tom <# ("", "alice", CON atPQ)
|
||||
alice #: ("5", "tom", "SEND F :hi there") #> ("5", "tom", A.MID 4 atPQ)
|
||||
@@ -329,22 +323,20 @@ testContactConnection (alice, aPQ) (bob, bPQ) (tom, tPQ) = do
|
||||
testContactConnRandomIds :: Transport c => (c, InitialKeys) -> (c, PQSupport) -> IO ()
|
||||
testContactConnRandomIds (alice, aPQ) (bob, bPQ) = do
|
||||
let pq = pqConnectionMode aPQ bPQ
|
||||
pqSup = CR.pqEncToSupport pq
|
||||
("1", aliceContact, Right (INV cReq)) <- alice #: ("1", "", "NEW T CON" <> pqConnModeStr aPQ <> " subscribe")
|
||||
let cReq' = strEncode cReq
|
||||
|
||||
("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo")
|
||||
("", aliceContact', Right (A.REQ aInvId pqSup' _ "bob's connInfo")) <- (alice <#:)
|
||||
pqSup' `shouldBe` bPQ
|
||||
("", aliceContact', Right (A.REQ aInvId PQSupportOn _ "bob's connInfo")) <- (alice <#:)
|
||||
aliceContact' `shouldBe` aliceContact
|
||||
|
||||
("2", bobConn, Right OK) <- alice #: ("2", "", "ACPT " <> aInvId <> enableKEMStr (CR.connPQEncryption aPQ) <> " 16\nalice's connInfo")
|
||||
("", aliceConn', Right (A.CONF bConfId pqSup'' _ "alice's connInfo")) <- (bob <#:)
|
||||
pqSup'' `shouldBe` pqSup
|
||||
pqSup'' `shouldBe` bPQ
|
||||
aliceConn' `shouldBe` aliceConn
|
||||
|
||||
bob #: ("12", aliceConn, "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", aliceConn, OK)
|
||||
alice <# ("", bobConn, A.INFO pqSup "bob's connInfo 2")
|
||||
alice <# ("", bobConn, A.INFO (CR.connPQEncryption aPQ) "bob's connInfo 2")
|
||||
alice <# ("", bobConn, CON pq)
|
||||
bob <# ("", aliceConn, CON pq)
|
||||
|
||||
@@ -358,7 +350,7 @@ testRejectContactRequest _ alice bob = do
|
||||
("1", "a_contact", Right (INV cReq)) <- alice #: ("1", "a_contact", "NEW T CON subscribe")
|
||||
let cReq' = strEncode cReq
|
||||
bob #: ("11", "alice", "JOIN T " <> cReq' <> " subscribe 10\nbob's info") #> ("11", "alice", OK)
|
||||
("", "a_contact", Right (A.REQ aInvId PQSupportOff _ "bob's info")) <- (alice <#:)
|
||||
("", "a_contact", Right (A.REQ aInvId PQSupportOn _ "bob's info")) <- (alice <#:)
|
||||
-- RJCT must use correct contact connection
|
||||
alice #: ("2a", "bob", "RJCT " <> aInvId) #> ("2a", "bob", ERR $ CONN NOT_FOUND)
|
||||
alice #: ("2b", "a_contact", "RJCT " <> aInvId) #> ("2b", "a_contact", OK)
|
||||
@@ -571,12 +563,11 @@ connect' (h1, name1, pqMode1) (h2, name2, pqMode2) = do
|
||||
("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW T INV" <> pqConnModeStr pqMode1 <> " subscribe")
|
||||
let cReq' = strEncode cReq
|
||||
pq = pqConnectionMode pqMode1 pqMode2
|
||||
pqSup = CR.pqEncToSupport pq
|
||||
h2 #: ("c2", name1, "JOIN T " <> cReq' <> enableKEMStr pqMode2 <> " subscribe 5\ninfo2") #> ("c2", name1, OK)
|
||||
("", _, Right (A.CONF connId pqSup' _ "info2")) <- (h1 <#:)
|
||||
pqSup' `shouldBe` pqSup
|
||||
pqSup' `shouldBe` CR.connPQEncryption pqMode1
|
||||
h1 #: ("c3", name2, "LET " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
|
||||
h2 <# ("", name1, A.INFO pqSup "info1")
|
||||
h2 <# ("", name1, A.INFO pqMode2 "info1")
|
||||
h2 <# ("", name1, CON pq)
|
||||
h1 <# ("", name2, CON pq)
|
||||
|
||||
|
||||
@@ -68,7 +68,7 @@ testE2ERatchetParams :: RcvE2ERatchetParamsUri 'C.X448
|
||||
testE2ERatchetParams = E2ERatchetParamsUri (mkVersionRange (VersionE2E 1) (VersionE2E 1)) testDhPubKey testDhPubKey Nothing
|
||||
|
||||
testE2ERatchetParams12 :: RcvE2ERatchetParamsUri 'C.X448
|
||||
testE2ERatchetParams12 = E2ERatchetParamsUri (supportedE2EEncryptVRange PQSupportOn) testDhPubKey testDhPubKey Nothing
|
||||
testE2ERatchetParams12 = E2ERatchetParamsUri supportedE2EEncryptVRange testDhPubKey testDhPubKey Nothing
|
||||
|
||||
connectionRequest :: AConnectionRequestUri
|
||||
connectionRequest =
|
||||
@@ -82,7 +82,7 @@ connectionRequestCurrentRange :: AConnectionRequestUri
|
||||
connectionRequestCurrentRange =
|
||||
ACR SCMInvitation $
|
||||
CRInvitationUri
|
||||
connReqData {crAgentVRange = supportedSMPAgentVRange PQSupportOn, crSmpQueues = [queueV1, queueV1]}
|
||||
connReqData {crAgentVRange = supportedSMPAgentVRange, crSmpQueues = [queueV1, queueV1]}
|
||||
testE2ERatchetParams12
|
||||
|
||||
connectionRequestClientDataEmpty :: AConnectionRequestUri
|
||||
|
||||
@@ -93,9 +93,9 @@ fullMsgLen :: Ratchet a -> Int
|
||||
fullMsgLen Ratchet {rcSupportKEM, rcVersion} = headerLenLength + fullHeaderLen v rcSupportKEM + C.authTagSize + paddedMsgLen
|
||||
where
|
||||
v = current rcVersion
|
||||
headerLenLength = case rcSupportKEM of
|
||||
PQSupportOn | v >= pqRatchetE2EEncryptVersion -> 3 -- two bytes are added because of two Large used in new encoding
|
||||
_ -> 1
|
||||
headerLenLength
|
||||
| v >= pqRatchetE2EEncryptVersion = 3 -- two bytes are added because of two Large used in new encoding
|
||||
| otherwise = 1
|
||||
|
||||
testMessageHeader :: forall a. AlgorithmI a => VersionE2E -> C.SAlgorithm a -> Expectation
|
||||
testMessageHeader v _ = do
|
||||
@@ -520,7 +520,7 @@ initRatchets = do
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions PQSupportOff
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOff
|
||||
pure (alice, bob, encrypt' noSndKEM, decrypt' noRcvKEM, (\#>))
|
||||
@@ -537,7 +537,7 @@ initRatchetsKEMProposed = do
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions PQSupportOn
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn
|
||||
pure (alice, bob, encrypt' hasSndKEM, decrypt' hasRcvKEM, (!#>))
|
||||
@@ -555,7 +555,7 @@ initRatchetsKEMAccepted = do
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions PQSupportOn
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn
|
||||
pure (alice, bob, encrypt' hasSndKEM, decrypt' hasRcvKEM, (!#>))
|
||||
@@ -572,14 +572,14 @@ initRatchetsKEMProposedAgain = do
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions PQSupportOn
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn
|
||||
pure (alice, bob, encrypt' hasSndKEM, decrypt' hasRcvKEM, (!#>))
|
||||
|
||||
testRatchetVersions :: PQSupport -> RatchetVersions
|
||||
testRatchetVersions pq =
|
||||
let v = maxVersion $ supportedE2EEncryptVRange pq
|
||||
testRatchetVersions :: RatchetVersions
|
||||
testRatchetVersions =
|
||||
let v = maxVersion supportedE2EEncryptVRange
|
||||
in RatchetVersions v v
|
||||
|
||||
encrypt_ :: AlgorithmI a => Maybe PQEncryption -> (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (ByteString, Ratchet a, SkippedMsgDiff))
|
||||
|
||||
@@ -187,9 +187,9 @@ agentCfgVPrev :: AgentConfig
|
||||
agentCfgVPrev =
|
||||
agentCfg
|
||||
{ sndAuthAlg = C.AuthAlg C.SEd25519,
|
||||
smpAgentVRange = \_ -> prevRange $ smpAgentVRange agentCfg PQSupportOff,
|
||||
smpAgentVRange = prevRange $ smpAgentVRange agentCfg,
|
||||
smpClientVRange = prevRange $ smpClientVRange agentCfg,
|
||||
e2eEncryptVRange = \_ -> prevRange $ e2eEncryptVRange agentCfg PQSupportOff,
|
||||
e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg,
|
||||
smpCfg = smpCfgVPrev
|
||||
}
|
||||
|
||||
@@ -198,14 +198,14 @@ agentCfgV7 :: AgentConfig
|
||||
agentCfgV7 =
|
||||
agentCfg
|
||||
{ sndAuthAlg = C.AuthAlg C.SX25519,
|
||||
smpAgentVRange = \_ -> V.mkVersionRange duplexHandshakeSMPAgentVersion $ max pqdrSMPAgentVersion currentSMPAgentVersion,
|
||||
e2eEncryptVRange = \_ -> V.mkVersionRange CR.kdfX3DHE2EEncryptVersion $ max CR.pqRatchetE2EEncryptVersion CR.currentE2EEncryptVersion,
|
||||
smpAgentVRange = V.mkVersionRange duplexHandshakeSMPAgentVersion $ max pqdrSMPAgentVersion currentSMPAgentVersion,
|
||||
e2eEncryptVRange = V.mkVersionRange CR.kdfX3DHE2EEncryptVersion $ max CR.pqRatchetE2EEncryptVersion CR.currentE2EEncryptVersion,
|
||||
smpCfg = smpCfgV7,
|
||||
ntfCfg = ntfCfgV2
|
||||
}
|
||||
|
||||
agentCfgRatchetVPrev :: AgentConfig
|
||||
agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = \_ -> prevRange $ e2eEncryptVRange agentCfg PQSupportOff}
|
||||
agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}
|
||||
|
||||
prevRange :: VersionRange v -> VersionRange v
|
||||
prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr)}
|
||||
@@ -546,28 +546,27 @@ testEnablePQEncryption =
|
||||
(a, 4, "msg 1") \#>\ b
|
||||
(b, 5, "msg 2") \#>\ a
|
||||
-- 45 bytes is used by agent message envelope inside double ratchet message envelope
|
||||
let largeMsg g' pqEnc = atomically $ C.randomBytes (e2eEncUserMsgLength pqdrSMPAgentVersion pqEnc - 45) g'
|
||||
let largeMsg g' pqEnc = atomically $ C.randomBytes (e2eEncAgentMsgLength pqdrSMPAgentVersion pqEnc - 45) g'
|
||||
lrg <- largeMsg g PQSupportOff
|
||||
(a, 6, lrg) \#>\ b
|
||||
(b, 7, lrg) \#>\ a
|
||||
-- enabling PQ encryption
|
||||
(a, 8, lrg) \#>! b
|
||||
(b, 9, lrg) \#>! a
|
||||
-- switched to smaller envelopes (before reporting PQ encryption enabled)
|
||||
sml <- largeMsg g PQSupportOn
|
||||
-- fail because of message size
|
||||
Left (A.CMD LARGE) <- tryError $ A.sendMessage ca bId PQEncOn SMP.noMsgFlags lrg
|
||||
(11, PQEncOff) <- A.sendMessage ca bId PQEncOn SMP.noMsgFlags sml
|
||||
get ca =##> \case ("", connId, SENT 11) -> connId == bId; _ -> False
|
||||
get cb =##> \case ("", connId, MsgErr' 10 MsgSkipped {} PQEncOff msg') -> connId == aId && msg' == sml; _ -> False
|
||||
ackMessage cb aId 10 Nothing
|
||||
(9, PQEncOff) <- A.sendMessage ca bId PQEncOn SMP.noMsgFlags sml
|
||||
get ca =##> \case ("", connId, SENT 9) -> connId == bId; _ -> False
|
||||
get cb =##> \case ("", connId, MsgErr' 8 MsgSkipped {} PQEncOff msg') -> connId == aId && msg' == sml; _ -> False
|
||||
ackMessage cb aId 8 Nothing
|
||||
-- -- fail in reply to sync IDss
|
||||
Left (A.CMD LARGE) <- tryError $ A.sendMessage cb aId PQEncOn SMP.noMsgFlags lrg
|
||||
(12, PQEncOn) <- A.sendMessage cb aId PQEncOn SMP.noMsgFlags sml
|
||||
get cb =##> \case ("", connId, SENT 12) -> connId == aId; _ -> False
|
||||
get ca =##> \case ("", connId, MsgErr' 12 MsgSkipped {} PQEncOn msg') -> connId == bId && msg' == sml; _ -> False
|
||||
ackMessage ca bId 12 Nothing
|
||||
(10, PQEncOff) <- A.sendMessage cb aId PQEncOn SMP.noMsgFlags sml
|
||||
get cb =##> \case ("", connId, SENT 10) -> connId == aId; _ -> False
|
||||
get ca =##> \case ("", connId, MsgErr' 10 MsgSkipped {} PQEncOff msg') -> connId == bId && msg' == sml; _ -> False
|
||||
ackMessage ca bId 10 Nothing
|
||||
(a, 11, sml) \#>! b
|
||||
-- PQ encryption now enabled
|
||||
(b, 12, sml) !#>! a
|
||||
(a, 13, sml) !#>! b
|
||||
(b, 14, sml) !#>! a
|
||||
-- disabling PQ encryption
|
||||
@@ -797,8 +796,8 @@ testAllowConnectionClientRestart t = do
|
||||
|
||||
testIncreaseConnAgentVersion :: HasCallStack => ATransport -> IO ()
|
||||
testIncreaseConnAgentVersion t = do
|
||||
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 2} initAgentServers testDB
|
||||
bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 2} initAgentServers testDB2
|
||||
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
|
||||
bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
|
||||
withSmpServerStoreMsgLogOn t testPort $ \_ -> do
|
||||
(aliceId, bobId) <- runRight $ do
|
||||
(aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
|
||||
@@ -810,7 +809,7 @@ testIncreaseConnAgentVersion t = do
|
||||
-- version doesn't increase if incompatible
|
||||
|
||||
disposeAgentClient alice
|
||||
alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB
|
||||
alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
|
||||
|
||||
runRight_ $ do
|
||||
subscribeConnection alice2 bobId
|
||||
@@ -821,7 +820,7 @@ testIncreaseConnAgentVersion t = do
|
||||
-- version increases if compatible
|
||||
|
||||
disposeAgentClient bob
|
||||
bob2 <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB2
|
||||
bob2 <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
|
||||
|
||||
runRight_ $ do
|
||||
subscribeConnection bob2 aliceId
|
||||
@@ -832,7 +831,7 @@ testIncreaseConnAgentVersion t = do
|
||||
-- version doesn't decrease, even if incompatible
|
||||
|
||||
disposeAgentClient alice2
|
||||
alice3 <- getSMPAgentClient' 5 agentCfg {smpAgentVRange = \_ -> mkVersionRange 2 2} initAgentServers testDB
|
||||
alice3 <- getSMPAgentClient' 5 agentCfg {smpAgentVRange = mkVersionRange 2 2} initAgentServers testDB
|
||||
|
||||
runRight_ $ do
|
||||
subscribeConnection alice3 bobId
|
||||
@@ -841,7 +840,7 @@ testIncreaseConnAgentVersion t = do
|
||||
checkVersion bob2 aliceId 3
|
||||
|
||||
disposeAgentClient bob2
|
||||
bob3 <- getSMPAgentClient' 6 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 1} initAgentServers testDB2
|
||||
bob3 <- getSMPAgentClient' 6 agentCfg {smpAgentVRange = mkVersionRange 1 1} initAgentServers testDB2
|
||||
|
||||
runRight_ $ do
|
||||
subscribeConnection bob3 aliceId
|
||||
@@ -858,8 +857,8 @@ checkVersion c connId v = do
|
||||
|
||||
testIncreaseConnAgentVersionMaxCompatible :: HasCallStack => ATransport -> IO ()
|
||||
testIncreaseConnAgentVersionMaxCompatible t = do
|
||||
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 2} initAgentServers testDB
|
||||
bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 2} initAgentServers testDB2
|
||||
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
|
||||
bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
|
||||
withSmpServerStoreMsgLogOn t testPort $ \_ -> do
|
||||
(aliceId, bobId) <- runRight $ do
|
||||
(aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
|
||||
@@ -871,7 +870,7 @@ testIncreaseConnAgentVersionMaxCompatible t = do
|
||||
-- version increases to max compatible
|
||||
|
||||
disposeAgentClient alice
|
||||
alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB
|
||||
alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
|
||||
disposeAgentClient bob
|
||||
bob2 <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = supportedSMPAgentVRange} initAgentServers testDB2
|
||||
|
||||
@@ -886,8 +885,8 @@ testIncreaseConnAgentVersionMaxCompatible t = do
|
||||
|
||||
testIncreaseConnAgentVersionStartDifferentVersion :: HasCallStack => ATransport -> IO ()
|
||||
testIncreaseConnAgentVersionStartDifferentVersion t = do
|
||||
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 2} initAgentServers testDB
|
||||
bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB2
|
||||
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
|
||||
bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
|
||||
withSmpServerStoreMsgLogOn t testPort $ \_ -> do
|
||||
(aliceId, bobId) <- runRight $ do
|
||||
(aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
|
||||
@@ -899,7 +898,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do
|
||||
-- version increases to max compatible
|
||||
|
||||
disposeAgentClient alice
|
||||
alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB
|
||||
alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
|
||||
|
||||
runRight_ $ do
|
||||
subscribeConnection alice2 bobId
|
||||
@@ -2454,8 +2453,8 @@ testDeliveryReceipts =
|
||||
|
||||
testDeliveryReceiptsVersion :: HasCallStack => ATransport -> IO ()
|
||||
testDeliveryReceiptsVersion t = do
|
||||
a <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB
|
||||
b <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB2
|
||||
a <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
|
||||
b <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
|
||||
withSmpServerStoreMsgLogOn t testPort $ \_ -> do
|
||||
(aId, bId) <- runRight $ do
|
||||
(aId, bId) <- makeConnection_ PQSupportOff a b
|
||||
@@ -2482,8 +2481,8 @@ testDeliveryReceiptsVersion t = do
|
||||
subscribeConnection a' bId
|
||||
subscribeConnection b' aId
|
||||
exchangeGreetingsMsgId_ PQEncOff 6 a' bId b' aId
|
||||
checkVersion a' bId 4
|
||||
checkVersion b' aId 4
|
||||
checkVersion a' bId 5
|
||||
checkVersion b' aId 5
|
||||
(8, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello"
|
||||
get a' ##> ("", bId, SENT 8)
|
||||
get b' =##> \case ("", c, Msg' 8 PQEncOff "hello") -> c == aId; _ -> False
|
||||
|
||||
Reference in New Issue
Block a user