mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-07-18 20:27:31 +00:00
agent: getConnShortLinkAsync; implement joinConnectionAsync for contact connections; narrow setConnShortLinkAsync only to Contact connections (#1694)
* agent: getConnShortLinkAsync * enable all tests * comment * comment * join conn async for contact URI (wip) * fix test * remove enableNtfs param * FixedLinkData --------- Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
spaced4ndy
co-authored by
Evgeny Poberezkin
Evgeny Poberezkin
parent
3e5b654109
commit
89b81d151f
+103
-44
@@ -50,6 +50,7 @@ module Simplex.Messaging.Agent
|
||||
connRequestPQSupport,
|
||||
createConnectionAsync,
|
||||
setConnShortLinkAsync,
|
||||
getConnShortLinkAsync,
|
||||
joinConnectionAsync,
|
||||
allowConnectionAsync,
|
||||
acceptContactAsync,
|
||||
@@ -198,8 +199,8 @@ import Simplex.Messaging.Client (NetworkRequestMode (..), SMPClientError, Server
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
|
||||
import qualified Simplex.Messaging.Crypto.ShortLink as SL
|
||||
import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import qualified Simplex.Messaging.Crypto.ShortLink as SL
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
|
||||
@@ -347,13 +348,19 @@ createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAs
|
||||
{-# INLINE createConnectionAsync #-}
|
||||
|
||||
-- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response
|
||||
setConnShortLinkAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE ()
|
||||
setConnShortLinkAsync c = withAgentEnv c .::. setConnShortLinkAsync' c
|
||||
setConnShortLinkAsync :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AE ()
|
||||
setConnShortLinkAsync c = withAgentEnv c .:: setConnShortLinkAsync' c
|
||||
{-# INLINE setConnShortLinkAsync #-}
|
||||
|
||||
-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id
|
||||
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
|
||||
joinConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs
|
||||
-- | Get and verify data from short link (LGET/LKEY command) asynchronously, synchronous response is new connection id
|
||||
getConnShortLinkAsync :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AE ConnId
|
||||
getConnShortLinkAsync c = withAgentEnv c .:. getConnShortLinkAsync' c
|
||||
{-# INLINE getConnShortLinkAsync #-}
|
||||
|
||||
-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id.
|
||||
-- If connId is provided (for contact URIs), it updates the existing connection record created by getConnShortLinkAsync.
|
||||
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
|
||||
joinConnectionAsync c userId aCorrId connId_ enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId connId_ enableNtfs
|
||||
{-# INLINE joinConnectionAsync #-}
|
||||
|
||||
-- | Allow connection to continue after CONF notification (LET command), no synchronous response
|
||||
@@ -401,7 +408,7 @@ deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c
|
||||
{-# INLINE deleteConnShortLink #-}
|
||||
|
||||
-- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries
|
||||
getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
|
||||
getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c)
|
||||
getConnShortLink c = withAgentEnv c .:. getConnShortLink' c
|
||||
{-# INLINE getConnShortLink #-}
|
||||
|
||||
@@ -784,8 +791,9 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do
|
||||
|
||||
-- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection,
|
||||
-- and join should retry, the same as 1-time invitation joins.
|
||||
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
|
||||
joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
|
||||
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
|
||||
joinConnAsync c userId corrId connId_ enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
|
||||
when (isJust connId_) $ throwE $ CMD PROHIBITED "joinConnAsync: connId not allowed for invitation URI"
|
||||
withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
|
||||
lift (compatibleInvitationUri cReqUri) >>= \case
|
||||
Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
|
||||
@@ -796,8 +804,22 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup
|
||||
enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
|
||||
pure connId
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption =
|
||||
throwE $ CMD PROHIBITED "joinConnAsync"
|
||||
joinConnAsync c userId corrId connId_ enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = do
|
||||
lift (compatibleContactUri cReqUri) >>= \case
|
||||
Just (_, Compatible connAgentVersion) -> do
|
||||
let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing
|
||||
connId <- case connId_ of
|
||||
Just cId -> do
|
||||
-- update connection record created by getConnShortLinkAsync
|
||||
withStore' c $ \db -> updateNewConnJoin db cId connAgentVersion pqSupport enableNtfs
|
||||
pure cId
|
||||
Nothing -> do
|
||||
g <- asks random
|
||||
let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
|
||||
withStore c $ \db -> createNewConn db g cData SCMInvitation
|
||||
enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
|
||||
pure connId
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
|
||||
allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
|
||||
allowConnectionAsync' c corrId connId confId ownConnInfo =
|
||||
@@ -816,7 +838,7 @@ acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId
|
||||
acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do
|
||||
Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId
|
||||
withStore' c $ \db -> acceptInvitation db invId ownConnInfo
|
||||
joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
|
||||
joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
|
||||
withStore' c (`unacceptInvitation` invId)
|
||||
throwE err
|
||||
|
||||
@@ -876,8 +898,9 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey
|
||||
srv <- getSMPServer c userId
|
||||
when (checkNotices && connMode cMode == CMContact) $ checkClientNotices c srv
|
||||
connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
|
||||
(connId,) <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv
|
||||
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
|
||||
(connId,)
|
||||
<$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv
|
||||
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
|
||||
|
||||
checkClientNotices :: AgentClient -> SMPServerWithAuth -> AM ()
|
||||
checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAuth srv@(ProtocolServer {host}) _) = do
|
||||
@@ -892,17 +915,41 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu
|
||||
when (maybe True (ts <) expires_) $
|
||||
throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_}
|
||||
|
||||
setConnShortLinkAsync' :: forall c. ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM ()
|
||||
setConnShortLinkAsync' c corrId connId cMode userLinkData clientData =
|
||||
setConnShortLinkAsync' :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AM ()
|
||||
setConnShortLinkAsync' c corrId connId userLinkData clientData =
|
||||
withConnLock c connId "setConnShortLinkAsync" $ do
|
||||
SomeConn _ conn <- withStore c (`getConn` connId)
|
||||
srv <- case (conn, cMode, userLinkData) of
|
||||
(ContactConnection _ RcvQueue {server, shortLink}, SCMContact, UserContactLinkData d) -> do
|
||||
liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <> )) $ validateOwners shortLink d
|
||||
srv <- case (conn, userLinkData) of
|
||||
(ContactConnection _ RcvQueue {server, shortLink}, UserContactLinkData d) -> do
|
||||
liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <>)) $ validateOwners shortLink d
|
||||
pure server
|
||||
(RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server
|
||||
_ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode"
|
||||
enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AULD cMode userLinkData) clientData
|
||||
enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET userLinkData clientData
|
||||
|
||||
getConnShortLinkAsync' :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AM ConnId
|
||||
getConnShortLinkAsync' c userId corrId shortLink@(CSLContact _ _ srv _) = do
|
||||
g <- asks random
|
||||
connId <- withStore c $ \db -> do
|
||||
-- server is created so the command is processed in server queue,
|
||||
-- not blocking other "no server" commands
|
||||
void $ createServer db srv
|
||||
prepareNewConn db g
|
||||
enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LGET shortLink
|
||||
pure connId
|
||||
where
|
||||
prepareNewConn db g = do
|
||||
let cData =
|
||||
ConnData
|
||||
{ userId,
|
||||
connId = "",
|
||||
connAgentVersion = currentSMPAgentVersion,
|
||||
enableNtfs = False,
|
||||
lastExternalSndId = 0,
|
||||
deleted = False,
|
||||
ratchetSyncState = RSOk,
|
||||
pqSupport = PQSupportOff
|
||||
}
|
||||
createNewConn db g cData SCMInvitation
|
||||
|
||||
setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c)
|
||||
setConnShortLink' c nm connId cMode userLinkData clientData =
|
||||
@@ -917,7 +964,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData =
|
||||
where
|
||||
prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData)
|
||||
prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do
|
||||
liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <> )) $ validateOwners shortLink d'
|
||||
liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d'
|
||||
g <- asks random
|
||||
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
|
||||
let cslContact = CSLContact SLSServer CCTContact (qServer rq)
|
||||
@@ -958,7 +1005,7 @@ deleteConnShortLink' c nm connId cMode =
|
||||
_ -> throwE $ CMD PROHIBITED "deleteConnShortLink: not contact address"
|
||||
|
||||
-- TODO [short links] remove 1-time invitation data and link ID from the server after the message is sent.
|
||||
getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnLinkData c)
|
||||
getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (FixedLinkData c, ConnLinkData c)
|
||||
getConnShortLink' c nm userId = \case
|
||||
CSLInvitation _ srv linkId linkKey -> do
|
||||
g <- asks random
|
||||
@@ -979,18 +1026,19 @@ getConnShortLink' c nm userId = \case
|
||||
ld <- getQueueLink c nm userId srv linkId
|
||||
decryptData srv linkKey k ld
|
||||
where
|
||||
decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnLinkData c)
|
||||
decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c)
|
||||
decryptData srv linkKey k (sndId, d) = do
|
||||
r@(cReq, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d
|
||||
let (srv', sndId') = qAddress (connReqQueue cReq)
|
||||
unless (srv `sameSrvHost` srv' && sndId == sndId') $
|
||||
throwE $ AGENT $ A_LINK "different address"
|
||||
pure $ if srv' == srv then r else (updateConnReqServer srv cReq, clData)
|
||||
r@(fd, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d
|
||||
let (srv', sndId') = qAddress (connReqQueue $ linkConnReq fd)
|
||||
unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address"
|
||||
pure $ if srv' == srv then r else (updateConnReqServer srv fd, clData)
|
||||
sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs
|
||||
updateConnReqServer :: SMPServer -> ConnectionRequestUri c -> ConnectionRequestUri c
|
||||
updateConnReqServer srv = \case
|
||||
CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams
|
||||
CRContactUri crData -> CRContactUri $ updateQueues crData
|
||||
updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c
|
||||
updateConnReqServer srv fd =
|
||||
let connReq' = case linkConnReq fd of
|
||||
CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams
|
||||
CRContactUri crData -> CRContactUri $ updateQueues crData
|
||||
in fd {linkConnReq = connReq'}
|
||||
where
|
||||
updateQueues crData@(ConnReqUriData {crSmpQueues = SMPQueueUri vr addr :| qs}) =
|
||||
crData {crSmpQueues = SMPQueueUri vr addr {smpServer = srv} :| qs}
|
||||
@@ -1073,7 +1121,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
|
||||
connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c)
|
||||
connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of
|
||||
Just ShortLinkCreds {shortLinkId, shortLinkKey}
|
||||
| qUri == qUri' -> pure $ case cReq of
|
||||
| qUri == qUri' -> pure $ case cReq of
|
||||
CRContactUri _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey
|
||||
CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) ->
|
||||
let cReq' = case pqInitKeys of
|
||||
@@ -1334,7 +1382,7 @@ databaseDiff passed known =
|
||||
let passedSet = S.fromList passed
|
||||
knownSet = S.fromList known
|
||||
missingIds = S.toList $ passedSet `S.difference` knownSet
|
||||
extraIds = S.toList $ knownSet `S.difference` passedSet
|
||||
extraIds = S.toList $ knownSet `S.difference` passedSet
|
||||
in DatabaseDiff {missingIds, extraIds}
|
||||
|
||||
-- | Subscribe to receive connection messages (SUB command) in Reader monad
|
||||
@@ -1372,7 +1420,8 @@ subscribeConnections_ c conns = do
|
||||
notifyResultError rs
|
||||
pure rs
|
||||
where
|
||||
partitionResultsConns :: (ConnId, Either StoreError SomeConnSub) ->
|
||||
partitionResultsConns ::
|
||||
(ConnId, Either StoreError SomeConnSub) ->
|
||||
(Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)]) ->
|
||||
(Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)])
|
||||
partitionResultsConns (connId, conn_) (rs, cs) = case conn_ of
|
||||
@@ -1679,15 +1728,26 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
|
||||
tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
|
||||
(CCLink cReq _, service) <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv
|
||||
notify $ INV (ACR cMode cReq) service
|
||||
LSET auData@(AULD cMode userLinkData) clientData ->
|
||||
LSET userLinkData clientData ->
|
||||
withServer' . tryCommand $ do
|
||||
link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData
|
||||
notify $ LINK (ACSL cMode link) auData
|
||||
link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData
|
||||
notify $ LINK link userLinkData
|
||||
LGET shortLink ->
|
||||
withServer' . tryCommand $ do
|
||||
(fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink
|
||||
notify $ LDATA fixedData linkData
|
||||
JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
|
||||
triedHosts <- newTVarIO S.empty
|
||||
tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
|
||||
(sqSecured, service) <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
|
||||
notify $ JOINED sqSecured service
|
||||
-- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously.
|
||||
-- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously.
|
||||
JOIN enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc subMode connInfo -> noServer $ do
|
||||
triedHosts <- newTVarIO S.empty
|
||||
tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
|
||||
(sqSecured, service) <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv
|
||||
notify $ JOINED sqSecured service
|
||||
LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
|
||||
ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
|
||||
SWCH ->
|
||||
@@ -1697,7 +1757,6 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
|
||||
switchDuplexConnection c NRMBackground conn replaced >>= notify . SWITCH QDRcv SPStarted
|
||||
_ -> throwE $ CMD PROHIBITED "SWCH: not duplex"
|
||||
DEL -> withServer' . tryCommand $ deleteConnection' c NRMBackground connId >> notify OK
|
||||
_ -> notify $ ERR $ INTERNAL $ "unsupported async command " <> show (aCommandTag cmd)
|
||||
AInternalCommand cmd -> case cmd of
|
||||
ICAckDel rId srvMsgId msgId -> withServer $ \srv -> tryWithLock "ICAckDel" $ ack srv rId srvMsgId >> withStore' c (\db -> deleteMsg db connId msgId)
|
||||
ICAck rId srvMsgId -> withServer $ \srv -> tryWithLock "ICAck" $ ack srv rId srvMsgId
|
||||
@@ -1861,7 +1920,7 @@ enqueueMessageB c reqs = do
|
||||
storeSentMsg db cfg aMessageIds = \case
|
||||
Left e -> pure (aMessageIds, Left e)
|
||||
Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of
|
||||
VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
|
||||
VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
|
||||
Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
|
||||
Nothing -> do
|
||||
(mbId_, r) <- case csqs_ of
|
||||
@@ -1903,7 +1962,6 @@ enqueueMessageB c reqs = do
|
||||
handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
|
||||
handleInternal = pure . Left . INTERNAL . show
|
||||
|
||||
|
||||
encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString
|
||||
encodeAgentMsgStr aMessage internalSndId prevMsgHash = do
|
||||
let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
|
||||
@@ -2324,7 +2382,8 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
|
||||
forM_ cIds_ $ \cIds -> notify ("", "", AEvt SAEConn $ DEL_CONNS cIds)
|
||||
pure res
|
||||
where
|
||||
partitionResultsConns :: (ConnId, Either StoreError SomeConn) ->
|
||||
partitionResultsConns ::
|
||||
(ConnId, Either StoreError SomeConn) ->
|
||||
(Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId]) ->
|
||||
(Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId])
|
||||
partitionResultsConns (connId, conn_) (rs, rqs, cIds) = case conn_ of
|
||||
@@ -2332,7 +2391,7 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
|
||||
Right (SomeConn _ conn) -> case connRcvQueues conn of
|
||||
[] -> (M.insert connId (Right ()) rs, rqs, cIds)
|
||||
rqs' -> (rs, rqs' ++ rqs, connId : cIds)
|
||||
unsubNtfConnIds :: NonEmpty ConnId -> AM' ()
|
||||
unsubNtfConnIds :: NonEmpty ConnId -> AM' ()
|
||||
unsubNtfConnIds connIds' = do
|
||||
ns <- asks ntfSupervisor
|
||||
atomically $ writeTBQueue (ntfSubQ ns) (NSCDeleteSub, connIds')
|
||||
|
||||
@@ -20,8 +20,8 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
|
||||
|
||||
-- |
|
||||
-- Module : Simplex.Messaging.Agent.Protocol
|
||||
@@ -112,6 +112,7 @@ module Simplex.Messaging.Agent.Protocol
|
||||
CRClientData,
|
||||
ServiceScheme,
|
||||
FixedLinkData (..),
|
||||
AConnLinkData (..),
|
||||
ConnLinkData (..),
|
||||
AUserConnLinkData (..),
|
||||
UserConnLinkData (..),
|
||||
@@ -255,10 +256,10 @@ import Simplex.Messaging.Protocol
|
||||
legacyStrEncodeServer,
|
||||
noAuthSrv,
|
||||
sameSrvAddr,
|
||||
senderCanSecure,
|
||||
shortLinksSMPClientVersion,
|
||||
sndAuthKeySMPClientVersion,
|
||||
srvHostnamesSMPClientVersion,
|
||||
shortLinksSMPClientVersion,
|
||||
senderCanSecure,
|
||||
pattern ProtoServerWithAuth,
|
||||
pattern SMPServer,
|
||||
)
|
||||
@@ -386,7 +387,8 @@ type SndQueueSecured = Bool
|
||||
-- | Parameterized type for SMP agent events
|
||||
data AEvent (e :: AEntity) where
|
||||
INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn
|
||||
LINK :: AConnShortLink -> AUserConnLinkData -> AEvent AEConn
|
||||
LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
|
||||
LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn
|
||||
CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
|
||||
REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
|
||||
INFO :: PQSupport -> ConnInfo -> AEvent AEConn
|
||||
@@ -440,7 +442,8 @@ deriving instance Show AEvtTag
|
||||
|
||||
data ACommand
|
||||
= NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
|
||||
| LSET AUserConnLinkData (Maybe CRClientData) -- response LINK
|
||||
| LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK
|
||||
| LGET (ConnShortLink 'CMContact) -- response LDATA
|
||||
| JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
|
||||
| LET ConfirmationId ConnInfo -- ConnInfo is from client
|
||||
| ACK AgentMsgId (Maybe MsgReceiptInfo)
|
||||
@@ -451,6 +454,7 @@ data ACommand
|
||||
data ACommandTag
|
||||
= NEW_
|
||||
| LSET_
|
||||
| LGET_
|
||||
| JOIN_
|
||||
| LET_
|
||||
| ACK_
|
||||
@@ -461,6 +465,7 @@ data ACommandTag
|
||||
data AEventTag (e :: AEntity) where
|
||||
INV_ :: AEventTag AEConn
|
||||
LINK_ :: AEventTag AEConn
|
||||
LDATA_ :: AEventTag AEConn
|
||||
CONF_ :: AEventTag AEConn
|
||||
REQ_ :: AEventTag AEConn
|
||||
INFO_ :: AEventTag AEConn
|
||||
@@ -508,6 +513,7 @@ aCommandTag :: ACommand -> ACommandTag
|
||||
aCommandTag = \case
|
||||
NEW {} -> NEW_
|
||||
LSET {} -> LSET_
|
||||
LGET _ -> LGET_
|
||||
JOIN {} -> JOIN_
|
||||
LET {} -> LET_
|
||||
ACK {} -> ACK_
|
||||
@@ -518,6 +524,7 @@ aEventTag :: AEvent e -> AEventTag e
|
||||
aEventTag = \case
|
||||
INV {} -> INV_
|
||||
LINK {} -> LINK_
|
||||
LDATA {} -> LDATA_
|
||||
CONF {} -> CONF_
|
||||
REQ {} -> REQ_
|
||||
INFO {} -> INFO_
|
||||
@@ -1706,14 +1713,19 @@ type CRClientData = Text
|
||||
data FixedLinkData c = FixedLinkData
|
||||
{ agentVRange :: VersionRangeSMPA,
|
||||
rootKey :: C.PublicKeyEd25519,
|
||||
connReq :: ConnectionRequestUri c,
|
||||
linkConnReq :: ConnectionRequestUri c,
|
||||
linkEntityId :: Maybe ByteString
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ConnLinkData c where
|
||||
InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
|
||||
ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact
|
||||
|
||||
deriving instance Eq (ConnLinkData c)
|
||||
|
||||
deriving instance Show (ConnLinkData c)
|
||||
|
||||
data UserContactData = UserContactData
|
||||
{ -- direct connection via connReq in fixed data is allowed.
|
||||
direct :: Bool,
|
||||
@@ -1740,13 +1752,6 @@ deriving instance Show (UserConnLinkData m)
|
||||
|
||||
data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m)
|
||||
|
||||
instance Eq AUserConnLinkData where
|
||||
AULD m d == AULD m' d' = case testEquality m m' of
|
||||
Just Refl -> d == d'
|
||||
Nothing -> False
|
||||
|
||||
deriving instance Show AUserConnLinkData
|
||||
|
||||
linkUserData :: ConnLinkData c -> UserLinkData
|
||||
linkUserData = \case
|
||||
InvitationLinkData _ d -> d
|
||||
@@ -1787,10 +1792,10 @@ validateOwners shortLink_ UserContactData {owners} = case shortLink_ of
|
||||
where
|
||||
hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners
|
||||
k = C.publicKey linkPrivSigKey
|
||||
|
||||
|
||||
validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String ()
|
||||
validateLinkOwners rootKey = go []
|
||||
where
|
||||
where
|
||||
go _ [] = Right ()
|
||||
go prev (o : os) = validOwner o >> go (o : prev) os
|
||||
where
|
||||
@@ -1805,12 +1810,12 @@ validateLinkOwners rootKey = go []
|
||||
signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k)
|
||||
|
||||
instance ConnectionModeI c => Encoding (FixedLinkData c) where
|
||||
smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} =
|
||||
smpEncode (agentVRange, rootKey, connReq) <> maybe "" smpEncode linkEntityId
|
||||
smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} =
|
||||
smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId
|
||||
smpP = do
|
||||
(agentVRange, rootKey, connReq) <- smpP
|
||||
(agentVRange, rootKey, linkConnReq) <- smpP
|
||||
linkEntityId <- (smpP <|> pure Nothing) <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
|
||||
pure FixedLinkData {agentVRange, rootKey, connReq, linkEntityId}
|
||||
pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId}
|
||||
|
||||
instance ConnectionModeI c => Encoding (ConnLinkData c) where
|
||||
smpEncode = \case
|
||||
@@ -1849,7 +1854,7 @@ instance Encoding AUserConnLinkData where
|
||||
CMContact ->
|
||||
AULD SCMContact . UserContactLinkData <$> smpP
|
||||
|
||||
instance StrEncoding AUserConnLinkData where
|
||||
instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where
|
||||
strEncode = smpEncode
|
||||
{-# INLINE strEncode #-}
|
||||
strP = smpP
|
||||
@@ -2065,6 +2070,7 @@ instance StrEncoding ACommandTag where
|
||||
A.takeTill (== ' ') >>= \case
|
||||
"NEW" -> pure NEW_
|
||||
"LSET" -> pure LSET_
|
||||
"LGET" -> pure LGET_
|
||||
"JOIN" -> pure JOIN_
|
||||
"LET" -> pure LET_
|
||||
"ACK" -> pure ACK_
|
||||
@@ -2074,6 +2080,7 @@ instance StrEncoding ACommandTag where
|
||||
strEncode = \case
|
||||
NEW_ -> "NEW"
|
||||
LSET_ -> "LSET"
|
||||
LGET_ -> "LGET"
|
||||
JOIN_ -> "JOIN"
|
||||
LET_ -> "LET"
|
||||
ACK_ -> "ACK"
|
||||
@@ -2086,6 +2093,7 @@ commandP binaryP =
|
||||
>>= \case
|
||||
NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
|
||||
LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP))
|
||||
LGET_ -> s (LGET <$> strP)
|
||||
JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
|
||||
LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
|
||||
ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP))
|
||||
@@ -2104,6 +2112,7 @@ serializeCommand :: ACommand -> ByteString
|
||||
serializeCommand = \case
|
||||
NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode)
|
||||
LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_
|
||||
LGET sl -> s (LGET_, sl)
|
||||
JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo)
|
||||
LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo]
|
||||
ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_
|
||||
|
||||
@@ -36,6 +36,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
|
||||
checkUser,
|
||||
|
||||
-- * Queues and connections
|
||||
createServer,
|
||||
createNewConn,
|
||||
updateNewConnRcv,
|
||||
updateNewConnSnd,
|
||||
@@ -57,6 +58,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
|
||||
setConnUserId,
|
||||
setConnAgentVersion,
|
||||
setConnPQSupport,
|
||||
updateNewConnJoin,
|
||||
getDeletedConnIds,
|
||||
getDeletedWaitingDeliveryConnIds,
|
||||
setConnRatchetSync,
|
||||
@@ -432,7 +434,7 @@ createSndConn db gVar cData q@SndQueue {server} =
|
||||
-- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_
|
||||
ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $
|
||||
createConn_ db gVar cData $ \connId -> do
|
||||
serverKeyHash_ <- createServer_ db server
|
||||
serverKeyHash_ <- createServer db server
|
||||
createConnRecord db connId cData SCMInvitation
|
||||
insertSndQueue_ db connId q serverKeyHash_
|
||||
|
||||
@@ -519,7 +521,7 @@ addConnRcvQueue db connId rq subMode =
|
||||
|
||||
addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
|
||||
addConnRcvQueue_ db connId rq@RcvQueue {server} subMode = do
|
||||
serverKeyHash_ <- createServer_ db server
|
||||
serverKeyHash_ <- createServer db server
|
||||
insertRcvQueue_ db connId rq subMode serverKeyHash_
|
||||
|
||||
addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
|
||||
@@ -531,7 +533,7 @@ addConnSndQueue db connId sq =
|
||||
|
||||
addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue
|
||||
addConnSndQueue_ db connId sq@SndQueue {server} = do
|
||||
serverKeyHash_ <- createServer_ db server
|
||||
serverKeyHash_ <- createServer db server
|
||||
insertSndQueue_ db connId sq serverKeyHash_
|
||||
|
||||
setRcvQueueStatus :: DB.Connection -> RcvQueue -> QueueStatus -> IO ()
|
||||
@@ -829,7 +831,7 @@ deleteInvShortLink db srv lnkId =
|
||||
|
||||
createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
|
||||
createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do
|
||||
serverKeyHash_ <- createServer_ db server
|
||||
serverKeyHash_ <- createServer db server
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
@@ -2024,8 +2026,8 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
|
||||
-- * Server helper
|
||||
|
||||
-- | Creates a new server, if it doesn't exist, and returns the passed key hash if it is different from stored.
|
||||
createServer_ :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
|
||||
createServer_ db newSrv@ProtocolServer {host, port, keyHash} = do
|
||||
createServer :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
|
||||
createServer db newSrv@ProtocolServer {host, port, keyHash} = do
|
||||
r <- insertNewServer_
|
||||
if null r
|
||||
then getServerKeyHash_ db newSrv >>= either E.throwIO pure
|
||||
@@ -2406,6 +2408,10 @@ setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO ()
|
||||
setConnPQSupport db connId pqSupport =
|
||||
DB.execute db "UPDATE connections SET pq_support = ? WHERE conn_id = ?" (pqSupport, connId)
|
||||
|
||||
updateNewConnJoin :: DB.Connection -> ConnId -> VersionSMPA -> PQSupport -> Bool -> IO ()
|
||||
updateNewConnJoin db connId aVersion pqSupport enableNtfs =
|
||||
DB.execute db "UPDATE connections SET smp_agent_version = ?, pq_support = ?, enable_ntfs = ? WHERE conn_id = ?" (aVersion, pqSupport, BI enableNtfs, connId)
|
||||
|
||||
getDeletedConnIds :: DB.Connection -> IO [ConnId]
|
||||
getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only (BI True))
|
||||
|
||||
|
||||
@@ -33,7 +33,7 @@ import Simplex.Messaging.Agent.Client (cryptoError)
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Protocol (EntityId (..), LinkId, EncDataBytes (..), QueueLinkData)
|
||||
import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), LinkId, QueueLinkData)
|
||||
import Simplex.Messaging.Util (liftEitherWith)
|
||||
|
||||
fixedDataPaddedLength :: Int
|
||||
@@ -51,8 +51,8 @@ invShortLinkKdf :: LinkKey -> C.SbKey
|
||||
invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
|
||||
|
||||
encodeSignLinkData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString))
|
||||
encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
|
||||
let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId = Nothing}
|
||||
encodeSignLinkData (rootKey, pk) agentVRange linkConnReq userData =
|
||||
let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId = Nothing}
|
||||
md = smpEncode $ connLinkData agentVRange userData
|
||||
in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
|
||||
|
||||
@@ -82,11 +82,11 @@ encryptData g k len s = do
|
||||
ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len
|
||||
pure $ EncDataBytes $ smpEncode nonce <> ct
|
||||
|
||||
decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c)
|
||||
decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (FixedLinkData c, ConnLinkData c)
|
||||
decryptLinkData linkKey k (encFD, encMD) = do
|
||||
(sig1, fd) <- decrypt encFD
|
||||
(sig2, md) <- decrypt encMD
|
||||
FixedLinkData {rootKey, connReq} <- decode fd
|
||||
fd'@FixedLinkData {rootKey} <- decode fd
|
||||
md' <- decode @(ConnLinkData c) md
|
||||
let signedBy k' = C.verify' k' sig2 md
|
||||
if
|
||||
@@ -97,7 +97,7 @@ decryptLinkData linkKey k (encFD, encMD) = do
|
||||
ContactLinkData _ UserContactData {owners} -> do
|
||||
first (AGENT . A_LINK) $ validateLinkOwners rootKey owners
|
||||
unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature"
|
||||
Right (connReq, md')
|
||||
Right (fd', md')
|
||||
where
|
||||
decrypt (EncDataBytes d) = do
|
||||
(nonce, Tail ct) <- decode d
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
module AgentTests.EqInstances where
|
||||
|
||||
import Data.Type.Equality
|
||||
import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), ShortLinkCreds (..))
|
||||
import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..))
|
||||
import Simplex.Messaging.Agent.Store
|
||||
import Simplex.Messaging.Client (ProxiedRelay (..))
|
||||
|
||||
@@ -28,10 +28,6 @@ deriving instance Eq ClientNtfCreds
|
||||
|
||||
deriving instance Eq ShortLinkCreds
|
||||
|
||||
deriving instance Show (ConnLinkData c)
|
||||
|
||||
deriving instance Eq (ConnLinkData c)
|
||||
|
||||
deriving instance Show ProxiedRelay
|
||||
|
||||
deriving instance Eq ProxiedRelay
|
||||
|
||||
@@ -313,7 +313,7 @@ deleteConnection c = A.deleteConnection c NRMInteractive
|
||||
deleteConnections :: AgentClient -> [ConnId] -> AE (M.Map ConnId (Either AgentErrorType ()))
|
||||
deleteConnections c = A.deleteConnections c NRMInteractive
|
||||
|
||||
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
|
||||
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c)
|
||||
getConnShortLink c = A.getConnShortLink c NRMInteractive
|
||||
|
||||
setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c)
|
||||
@@ -458,6 +458,8 @@ functionalAPITests ps = do
|
||||
testBasicMatrix2 ps testAsyncCommands
|
||||
it "should add short link data using async agent command" $
|
||||
testSetConnShortLinkAsync ps
|
||||
it "should get short link data and join connection using async agent commands" $
|
||||
testGetConnShortLinkAsync ps
|
||||
it "should restore and complete async commands on restart" $
|
||||
testAsyncCommandsRestore ps
|
||||
describe "accept connection using async command" $
|
||||
@@ -1369,12 +1371,12 @@ testInvitationShortLink viaProxy a b =
|
||||
let userData = UserLinkData "some user data"
|
||||
newLinkData = UserInvLinkData userData
|
||||
(bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
|
||||
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
linkUserData connData' `shouldBe` userData
|
||||
-- same user can get invitation link again
|
||||
(connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq2}, connData2) <- runRight $ getConnShortLink b 1 shortLink
|
||||
connReq2 `shouldBe` connReq
|
||||
linkUserData connData2 `shouldBe` userData
|
||||
-- another user cannot get the same invitation link
|
||||
@@ -1412,12 +1414,12 @@ testInvitationShortLinkAsync viaProxy a b = do
|
||||
let userData = UserLinkData "some user data"
|
||||
newLinkData = UserInvLinkData userData
|
||||
(bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
|
||||
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
linkUserData connData' `shouldBe` userData
|
||||
runRight $ do
|
||||
aId <- A.joinConnectionAsync b 1 "123" True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
aId <- A.joinConnectionAsync b 1 "123" Nothing True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False
|
||||
("", _, CONF confId _ "bob's connInfo") <- get a
|
||||
allowConnection a bId confId "alice's connInfo"
|
||||
@@ -1440,16 +1442,16 @@ testContactShortLink viaProxy a b =
|
||||
newLinkData = UserContactLinkData userCtData
|
||||
(contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe
|
||||
Right connReq <- pure $ smpDecode (smpEncode connReq0)
|
||||
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
userCtData' `shouldBe` userCtData
|
||||
-- same user can get contact link again
|
||||
(connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
|
||||
connReq2 `shouldBe` connReq
|
||||
userCtData2 `shouldBe` userCtData
|
||||
-- another user can get the same contact link
|
||||
(connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
|
||||
connReq3 `shouldBe` connReq
|
||||
userCtData3 `shouldBe` userCtData
|
||||
runRight $ do
|
||||
@@ -1471,7 +1473,7 @@ testContactShortLink viaProxy a b =
|
||||
userLinkData' = UserContactLinkData updatedCtData
|
||||
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
|
||||
shortLink' `shouldBe` shortLink
|
||||
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
|
||||
connReq4 `shouldBe` connReq
|
||||
updatedCtData' `shouldBe` updatedCtData
|
||||
-- one more time
|
||||
@@ -1491,16 +1493,16 @@ testAddContactShortLink viaProxy a b =
|
||||
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
newLinkData = UserContactLinkData userCtData
|
||||
shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing
|
||||
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
userCtData' `shouldBe` userCtData
|
||||
-- same user can get contact link again
|
||||
(connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
|
||||
connReq2 `shouldBe` connReq
|
||||
userCtData2 `shouldBe` userCtData
|
||||
-- another user can get the same contact link
|
||||
(connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
|
||||
connReq3 `shouldBe` connReq
|
||||
userCtData3 `shouldBe` userCtData
|
||||
runRight $ do
|
||||
@@ -1522,7 +1524,7 @@ testAddContactShortLink viaProxy a b =
|
||||
userLinkData' = UserContactLinkData updatedCtData
|
||||
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
|
||||
shortLink' `shouldBe` shortLink
|
||||
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
|
||||
connReq4 `shouldBe` connReq
|
||||
updatedCtData' `shouldBe` updatedCtData
|
||||
|
||||
@@ -1534,7 +1536,7 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
|
||||
runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMOnlyCreate
|
||||
withSmpServer ps $ do
|
||||
runRight_ $ subscribeConnection a bId
|
||||
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
linkUserData connData' `shouldBe` userData
|
||||
@@ -1623,7 +1625,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
|
||||
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
userLinkData = UserContactLinkData userCtData
|
||||
shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing
|
||||
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
userCtData' `shouldBe` userCtData
|
||||
@@ -1634,7 +1636,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
|
||||
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
|
||||
shortLink' `shouldBe` shortLink
|
||||
-- check updated
|
||||
(connReq'', ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
(FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
connReq'' `shouldBe` connReq
|
||||
updatedCtData' `shouldBe` updatedCtData
|
||||
|
||||
@@ -2617,7 +2619,7 @@ testAsyncCommands sqSecured alice bob baseId =
|
||||
bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
|
||||
("1", bobId', INV (ACR _ qInfo)) <- get alice
|
||||
liftIO $ bobId' `shouldBe` bobId
|
||||
aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
aliceId <- joinConnectionAsync bob 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
("2", aliceId', JOINED sqSecured') <- get bob
|
||||
liftIO $ do
|
||||
aliceId' `shouldBe` aliceId
|
||||
@@ -2675,8 +2677,8 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
|
||||
-- update link data async
|
||||
let updatedData = UserLinkData "updated user data"
|
||||
updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData}
|
||||
setConnShortLinkAsync alice "1" cId SCMContact (UserContactLinkData updatedCtData) Nothing
|
||||
("1", cId', LINK (ACSL SCMContact shortLink') (AULD SCMContact (UserContactLinkData updatedCtData'))) <- get alice
|
||||
setConnShortLinkAsync alice "1" cId (UserContactLinkData updatedCtData) Nothing
|
||||
("1", cId', LINK shortLink' (UserContactLinkData updatedCtData')) <- get alice
|
||||
liftIO $ cId' `shouldBe` cId
|
||||
liftIO $ shortLink' `shouldBe` shortLink
|
||||
liftIO $ updatedCtData' `shouldBe` updatedCtData
|
||||
@@ -2694,6 +2696,34 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
|
||||
get alice ##> ("", bobId, CON)
|
||||
get bob ##> ("", aliceId, CON)
|
||||
|
||||
testGetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
|
||||
testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
|
||||
withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
|
||||
let userData = UserLinkData "test user data"
|
||||
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
newLinkData = UserContactLinkData userCtData
|
||||
(_, (CCLink qInfo (Just shortLink), _)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe
|
||||
-- get link data async - creates new connection for bob
|
||||
newId <- getConnShortLinkAsync bob 1 "1" shortLink
|
||||
("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData')) <- get bob
|
||||
liftIO $ newId' `shouldBe` newId
|
||||
liftIO $ qInfo' `shouldBe` qInfo
|
||||
liftIO $ userCtData' `shouldBe` userCtData
|
||||
-- join connection async using connId from getConnShortLinkAsync
|
||||
aliceId <- joinConnectionAsync bob 1 "2" (Just newId) True qInfo' "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ aliceId `shouldBe` newId
|
||||
("2", aliceId', JOINED False) <- get bob
|
||||
liftIO $ aliceId' `shouldBe` aliceId
|
||||
-- complete connection
|
||||
("", _, REQ invId _ "bob's connInfo") <- get alice
|
||||
bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
(_, Nothing) <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, CONF confId _ "alice's connInfo") <- get bob
|
||||
allowConnection bob aliceId confId "bob's connInfo"
|
||||
get alice ##> ("", bobId, INFO "bob's connInfo")
|
||||
get alice ##> ("", bobId, CON)
|
||||
get bob ##> ("", aliceId, CON)
|
||||
|
||||
testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO ()
|
||||
testAsyncCommandsRestore ps = do
|
||||
alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
|
||||
@@ -2987,7 +3017,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do
|
||||
bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
|
||||
("1", bId', INV (ACR _ qInfo)) <- get a
|
||||
liftIO $ bId' `shouldBe` bId
|
||||
aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ threadDelay 500000
|
||||
ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
|
||||
pure (aId, bId)
|
||||
@@ -3032,7 +3062,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
|
||||
bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
|
||||
("1", bId', INV (ACR _ qInfo)) <- get a
|
||||
liftIO $ bId' `shouldBe` bId
|
||||
aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ threadDelay 500000
|
||||
ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
|
||||
pure (aId, bId)
|
||||
|
||||
@@ -12,12 +12,12 @@ import AgentTests.EqInstances ()
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad.Except
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Base64.URL as B64
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import qualified Simplex.Messaging.Crypto.ShortLink as SL
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Protocol (EncFixedDataBytes)
|
||||
import Test.Hspec hiding (fit, it)
|
||||
import Util
|
||||
@@ -48,7 +48,7 @@ testInvShortLink = do
|
||||
k = SL.invShortLinkKdf linkKey
|
||||
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
|
||||
-- decrypt
|
||||
Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData
|
||||
Right (FixedLinkData {linkConnReq = connReq}, connData') <- pure $ SL.decryptLinkData linkKey k srvData
|
||||
connReq `shouldBe` invConnRequest
|
||||
linkUserData connData' `shouldBe` userData
|
||||
|
||||
@@ -86,7 +86,7 @@ testContactShortLink = do
|
||||
(_linkId, k) = SL.contactShortLinkKdf linkKey
|
||||
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
|
||||
-- decrypt
|
||||
Right (connReq, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
|
||||
Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
|
||||
connReq `shouldBe` contactConnRequest
|
||||
userCtData' `shouldBe` userCtData
|
||||
|
||||
@@ -108,7 +108,7 @@ testUpdateContactShortLink = do
|
||||
signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData'
|
||||
Right ud' <- runExceptT $ SL.encryptUserData g k signed
|
||||
-- decrypt
|
||||
Right (connReq, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
|
||||
Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
|
||||
connReq `shouldBe` contactConnRequest
|
||||
userCtData'' `shouldBe` userCtData'
|
||||
|
||||
@@ -148,7 +148,7 @@ testContactShortLinkBadSignature = do
|
||||
-- decryption fails
|
||||
SL.decryptLinkData @'CMContact linkKey k (fd, ud')
|
||||
`shouldBe` Left (AGENT (A_LINK "user data signature"))
|
||||
|
||||
|
||||
testContactShortLinkOwner :: IO ()
|
||||
testContactShortLinkOwner = do
|
||||
-- encrypt
|
||||
@@ -183,7 +183,7 @@ testEncDec :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkK
|
||||
testEncDec g pk (fd, linkKey, k) ctData = do
|
||||
let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData
|
||||
Right ud <- runExceptT $ SL.encryptUserData g k signed
|
||||
Right (connReq', ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud)
|
||||
Right (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud)
|
||||
connReq' `shouldBe` contactConnRequest
|
||||
ctData' `shouldBe` ctData
|
||||
|
||||
|
||||
Reference in New Issue
Block a user