mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-05-13 20:53:13 +00:00
agent: set/update and delete contact short link data (#1499)
* agent: set/update and delete contact short link data * delete contact link data, tests * comments * type signature for GHC 8.10.7
This commit is contained in:
Evgeny
@@ -56,7 +56,10 @@ module Simplex.Messaging.Agent
|
||||
deleteConnectionAsync,
|
||||
deleteConnectionsAsync,
|
||||
createConnection,
|
||||
setContactShortLink,
|
||||
deleteContactShortLink,
|
||||
getConnShortLink,
|
||||
deleteLocalInvShortLink,
|
||||
changeConnectionUser,
|
||||
prepareConnectionToJoin,
|
||||
prepareConnectionToAccept,
|
||||
@@ -189,7 +192,7 @@ import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
|
||||
import Simplex.Messaging.Notifications.Types
|
||||
import Simplex.Messaging.Parsers (parse)
|
||||
import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC)
|
||||
import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolType (..), ProtocolTypeI (..), QueueLinkData, SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
@@ -347,21 +350,23 @@ createConnection c userId enableNtfs = withAgentEnv c .::. newConn c userId enab
|
||||
{-# INLINE createConnection #-}
|
||||
|
||||
-- | Create or update user's contact connection short link
|
||||
-- TODO [short links]
|
||||
setConnShortLink :: AgentClient -> ConnId -> ConnInfo -> AE (ConnShortLink 'CMContact)
|
||||
setConnShortLink c = withAgentEnv c .: setConnShortLink' c
|
||||
{-# INLINE setConnShortLink #-}
|
||||
setContactShortLink :: AgentClient -> ConnId -> ConnInfo -> AE (ConnShortLink 'CMContact)
|
||||
setContactShortLink c = withAgentEnv c .: setContactShortLink' c
|
||||
{-# INLINE setContactShortLink #-}
|
||||
|
||||
deleteContactShortLink :: AgentClient -> ConnId -> AE ()
|
||||
deleteContactShortLink c = withAgentEnv c . deleteContactShortLink' c
|
||||
{-# INLINE deleteContactShortLink #-}
|
||||
|
||||
-- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries
|
||||
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnInfo)
|
||||
getConnShortLink c = withAgentEnv c .: getConnShortLink' c
|
||||
{-# INLINE getConnShortLink #-}
|
||||
|
||||
-- | This irreversible deletes short link data, and it won't be retrievable again
|
||||
-- TODO [short links]
|
||||
delInvShortLink :: AgentClient -> ConnShortLink 'CMInvitation -> AE ()
|
||||
delInvShortLink c = withAgentEnv c . delInvShortLink' c
|
||||
{-# INLINE delInvShortLink #-}
|
||||
-- | This irreversibly deletes short link data, and it won't be retrievable again
|
||||
deleteLocalInvShortLink :: AgentClient -> ConnShortLink 'CMInvitation -> AE ()
|
||||
deleteLocalInvShortLink c = withAgentEnv c . deleteLocalInvShortLink' c
|
||||
{-# INLINE deleteLocalInvShortLink #-}
|
||||
|
||||
-- | Changes the user id associated with a connection
|
||||
changeConnectionUser :: AgentClient -> UserId -> ConnId -> UserId -> AE ()
|
||||
@@ -801,11 +806,46 @@ newConn :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode
|
||||
newConn c userId enableNtfs cMode userData_ clientData pqInitKeys subMode = do
|
||||
srv <- getSMPServer c userId
|
||||
connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
|
||||
(connId,) <$> newRcvConnSrv_ c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srv
|
||||
(connId,) <$> newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srv
|
||||
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
|
||||
|
||||
setConnShortLink' :: AgentClient -> ConnId -> ConnInfo -> AM (ConnShortLink 'CMContact)
|
||||
setConnShortLink' = undefined
|
||||
setContactShortLink' :: AgentClient -> ConnId -> ConnInfo -> AM (ConnShortLink 'CMContact)
|
||||
setContactShortLink' c connId userData =
|
||||
withConnLock c connId "setContactShortLink" $
|
||||
withStore c (`getConn` connId) >>= \case
|
||||
SomeConn _ (ContactConnection _ rq) -> do
|
||||
(lnkId, linkKey, d) <- prepareLinkData rq
|
||||
addQueueLink c rq lnkId d
|
||||
pure $ CSLContact (qServer rq) CCTContact linkKey
|
||||
_ -> throwE $ CMD PROHIBITED "setContactShortLink: not contact address"
|
||||
where
|
||||
prepareLinkData :: RcvQueue -> AM (SMP.LinkId, LinkKey, QueueLinkData)
|
||||
prepareLinkData rq@RcvQueue {server, sndId, e2ePrivKey, shortLink} = do
|
||||
g <- asks random
|
||||
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
|
||||
case shortLink of
|
||||
Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
|
||||
let (linkId, k) = SL.contactShortLinkKdf shortLinkKey
|
||||
unless (shortLinkId == linkId) $ throwE $ INTERNAL "setContactShortLink: link ID is not derived from link"
|
||||
d <- liftIO $ SL.encryptData g k $ SL.encodeSignUserData linkPrivSigKey smpAgentVRange userData
|
||||
pure (linkId, shortLinkKey, (linkEncFixedData, d))
|
||||
Nothing -> do
|
||||
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
|
||||
let qUri = SMPQueueUri vr $ SMPQueueAddress server sndId (C.publicKey e2ePrivKey) False
|
||||
connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing
|
||||
(linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userData
|
||||
(linkId, k) = SL.contactShortLinkKdf linkKey
|
||||
srvData <- liftIO $ SL.encryptLinkData g k linkData
|
||||
let slCreds = ShortLinkCreds linkId linkKey privSigKey (fst srvData)
|
||||
withStore' c $ \db -> updateShortLinkCreds db rq slCreds
|
||||
pure (linkId, linkKey, srvData)
|
||||
|
||||
deleteContactShortLink' :: AgentClient -> ConnId -> AM ()
|
||||
deleteContactShortLink' c connId =
|
||||
withConnLock c connId "deleteContactShortLink" $
|
||||
withStore c (`getConn` connId) >>= \case
|
||||
SomeConn _ (ContactConnection _ rq) -> deleteQueueLink c rq
|
||||
_ -> throwE $ CMD PROHIBITED "deleteContactShortLink: 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 -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnInfo)
|
||||
@@ -829,15 +869,15 @@ getConnShortLink' c userId = \case
|
||||
ld <- getQueueLink c userId srv linkId
|
||||
decryptData srv linkKey k ld
|
||||
where
|
||||
decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, SMP.QueueLinkData) -> AM (ConnectionRequestUri c, ConnInfo)
|
||||
decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnInfo)
|
||||
decryptData srv linkKey k (sndId, d) = do
|
||||
r@(cReq, _) <- liftEither $ SL.decryptLinkData @c linkKey k d
|
||||
unless ((srv, sndId) `sameQAddress` qAddress (connReqQueue cReq)) $
|
||||
throwE $ AGENT $ A_LINK "different address"
|
||||
pure r
|
||||
|
||||
delInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM ()
|
||||
delInvShortLink' = undefined
|
||||
deleteLocalInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM ()
|
||||
deleteLocalInvShortLink' c (CSLInvitation srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId
|
||||
|
||||
changeConnectionUser' :: AgentClient -> UserId -> ConnId -> UserId -> AM ()
|
||||
changeConnectionUser' c oldUserId connId newUserId = do
|
||||
@@ -849,13 +889,8 @@ changeConnectionUser' c oldUserId connId newUserId = do
|
||||
where
|
||||
updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId
|
||||
|
||||
newRcvConnSrv :: ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c)
|
||||
newRcvConnSrv c userId connId enableNtfs cMode =
|
||||
fmap fst .:: newRcvConnSrv_ c userId connId enableNtfs cMode Nothing
|
||||
{-# INLINE newRcvConnSrv #-}
|
||||
|
||||
newRcvConnSrv_ :: forall c. ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c, Maybe (ConnShortLink c))
|
||||
newRcvConnSrv_ c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do
|
||||
newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c, Maybe (ConnShortLink c))
|
||||
newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do
|
||||
case (cMode, pqInitKeys) of
|
||||
(SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
|
||||
_ -> pure ()
|
||||
@@ -898,12 +933,12 @@ newRcvConnSrv_ c userId connId enableNtfs cMode userData_ clientData pqInitKeys
|
||||
g <- asks random
|
||||
nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
|
||||
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
|
||||
AgentConfig {smpClientVRange = vr, smpAgentVRange = agentVRange} <- asks config
|
||||
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
|
||||
let sndId = SMP.EntityId $ C.sha3_256 corrId
|
||||
sndSecure = case cMode of SCMContact -> False; SCMInvitation -> True
|
||||
qUri = SMPQueueUri vr $ SMPQueueAddress srv sndId e2eDhKey sndSecure
|
||||
connReq <- createConnReq qUri
|
||||
let (linkKey, linkData) = SL.encodeSignLinkData sigKeys agentVRange connReq userData
|
||||
let (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userData
|
||||
qd <- case cMode of
|
||||
SCMContact -> do
|
||||
let (linkId, k) = SL.contactShortLinkKdf linkKey
|
||||
@@ -956,8 +991,6 @@ newConnToAccept c connId enableNtfs invId pqSup = do
|
||||
newConnToJoin c userId connId enableNtfs connReq pqSup
|
||||
_ -> throwE $ CMD PROHIBITED "newConnToAccept"
|
||||
|
||||
-- Short link MUST be passed again to joinConnection so that the same sender key is used.
|
||||
-- The alternative design would be to create connection ID and SndQueue when short link is read.
|
||||
joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
|
||||
joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do
|
||||
srv <- getNextSMPServer c userId [qServer $ connReqQueue cReq]
|
||||
@@ -968,7 +1001,7 @@ connReqQueue = \case
|
||||
CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q
|
||||
CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q
|
||||
|
||||
startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Bool)
|
||||
startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Maybe SMP.LinkId)
|
||||
startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
|
||||
lift (compatibleInvitationUri cReqUri) >>= \case
|
||||
Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
|
||||
@@ -986,15 +1019,17 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
|
||||
Left e -> do
|
||||
nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e))
|
||||
runExceptT $ createRatchet_ db g maxSupported pqSupport e2eRcvParams
|
||||
pure (cData, sq, e2eSndParams, False)
|
||||
pure (cData, sq, e2eSndParams, Nothing)
|
||||
_ -> do
|
||||
let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo
|
||||
sndKeys_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId
|
||||
invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId
|
||||
let lnkId_ = fst <$> invLink_
|
||||
sndKeys_ = snd <$> invLink_
|
||||
(q, _) <- lift $ newSndQueue userId "" qInfo sndKeys_
|
||||
withStore c $ \db -> runExceptT $ do
|
||||
e2eSndParams <- createRatchet_ db g maxSupported pqSupport e2eRcvParams
|
||||
sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
|
||||
pure (cData, sq', e2eSndParams, isJust sndKeys_)
|
||||
pure (cData, sq', e2eSndParams, lnkId_)
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
where
|
||||
createRatchet_ db g maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do
|
||||
@@ -1048,20 +1083,20 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod
|
||||
where
|
||||
doJoin :: Maybe SndQueue -> AM SndQueueSecured
|
||||
doJoin sq_ = do
|
||||
(cData, sq, e2eSndParams, hasLink) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup
|
||||
(cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup
|
||||
secureConfirmQueue c cData sq srv cInfo (Just e2eSndParams) subMode
|
||||
>>= (when hasLink (delInvSL c connId srv sq) $>)
|
||||
>>= (mapM_ (delInvSL c connId srv) lnkId_ $>)
|
||||
joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv =
|
||||
lift (compatibleContactUri cReqUri) >>= \case
|
||||
Just (qInfo, vrsn) -> do
|
||||
cReq <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
|
||||
(cReq, _) <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing Nothing (CR.IKNoPQ pqSup) subMode srv
|
||||
void $ sendInvitation c userId connId qInfo vrsn cReq cInfo
|
||||
pure False
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
|
||||
delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SndQueue -> AM ()
|
||||
delInvSL c connId srv sq =
|
||||
withStore' c (\db -> deleteInvShortLink db (protoServer srv) (queueId sq)) `catchE` \e ->
|
||||
delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SMP.LinkId -> AM ()
|
||||
delInvSL c connId srv lnkId =
|
||||
withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e ->
|
||||
liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e))
|
||||
|
||||
joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
|
||||
@@ -1074,9 +1109,9 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo
|
||||
where
|
||||
doJoin :: Maybe SndQueue -> AM SndQueueSecured
|
||||
doJoin sq_ = do
|
||||
(cData, sq, e2eSndParams, hasLink) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport
|
||||
(cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport
|
||||
secureConfirmQueueAsync c cData sq srv cInfo (Just e2eSndParams) subMode
|
||||
>>= (when hasLink (delInvSL c connId srv sq) $>)
|
||||
>>= (mapM_ (delInvSL c connId srv) lnkId_ $>)
|
||||
joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do
|
||||
throwE $ CMD PROHIBITED "joinConnSrvAsync"
|
||||
|
||||
@@ -1364,7 +1399,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
|
||||
NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do
|
||||
triedHosts <- newTVarIO S.empty
|
||||
tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
|
||||
cReq <- newRcvConnSrv c userId connId enableNtfs cMode Nothing pqEnc subMode srv
|
||||
(cReq, _) <- newRcvConnSrv c userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv
|
||||
notify $ INV (ACR cMode cReq)
|
||||
JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
|
||||
triedHosts <- newTVarIO S.empty
|
||||
|
||||
@@ -1066,7 +1066,7 @@ withSMPClient c q cmdStr action = do
|
||||
|
||||
sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ConnId -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
|
||||
sendOrProxySMPMessage c userId destSrv connId cmdStr spKey_ senderId msgFlags msg =
|
||||
sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendViaProxy sendDirectly
|
||||
fst <$> sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendViaProxy sendDirectly
|
||||
where
|
||||
sendViaProxy smp proxySess = do
|
||||
atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
|
||||
@@ -1077,20 +1077,6 @@ sendOrProxySMPMessage c userId destSrv connId cmdStr spKey_ senderId msgFlags ms
|
||||
sendSMPMessage smp spKey_ senderId msgFlags msg
|
||||
|
||||
sendOrProxySMPCommand ::
|
||||
AgentClient ->
|
||||
UserId ->
|
||||
SMPServer ->
|
||||
ConnId ->
|
||||
ByteString ->
|
||||
SMP.SenderId ->
|
||||
(SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) ->
|
||||
(SMPClient -> ExceptT SMPClientError IO ()) ->
|
||||
AM (Maybe SMPServer)
|
||||
sendOrProxySMPCommand c userId destSrv connId cmdStr entId sendCmdViaProxy sendCmdDirectly =
|
||||
fst <$> sendOrProxySMPCommand_ c userId destSrv connId cmdStr entId sendCmdViaProxy sendCmdDirectly
|
||||
{-# INLINE sendOrProxySMPCommand #-}
|
||||
|
||||
sendOrProxySMPCommand_ ::
|
||||
forall a.
|
||||
AgentClient ->
|
||||
UserId ->
|
||||
@@ -1101,7 +1087,7 @@ sendOrProxySMPCommand_ ::
|
||||
(SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError a)) ->
|
||||
(SMPClient -> ExceptT SMPClientError IO a) ->
|
||||
AM (Maybe SMPServer, a)
|
||||
sendOrProxySMPCommand_ c userId destSrv@ProtocolServer {host = destHosts} connId cmdStr entId sendCmdViaProxy sendCmdDirectly = do
|
||||
sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId cmdStr entId sendCmdViaProxy sendCmdDirectly = do
|
||||
tSess <- mkTransportSession c userId destSrv connId
|
||||
ifM shouldUseProxy (sendViaProxy Nothing tSess) ((Nothing,) <$> sendDirectly tSess)
|
||||
where
|
||||
@@ -1698,14 +1684,14 @@ deleteQueueLink c rq@RcvQueue {rcvId, rcvPrivateKey} =
|
||||
|
||||
secureGetQueueLink :: AgentClient -> UserId -> InvShortLink -> AM (SMP.SenderId, QueueLinkData)
|
||||
secureGetQueueLink c userId InvShortLink {server, linkId, sndPrivateKey, sndPublicKey} =
|
||||
snd <$> sendOrProxySMPCommand_ c userId server (unEntityId linkId) "LKEY <key>" linkId secureGetViaProxy secureGetDirectly
|
||||
snd <$> sendOrProxySMPCommand c userId server (unEntityId linkId) "LKEY <key>" linkId secureGetViaProxy secureGetDirectly
|
||||
where
|
||||
secureGetViaProxy smp proxySess = proxySecureGetSMPQueueLink smp proxySess sndPrivateKey linkId sndPublicKey
|
||||
secureGetDirectly smp = secureGetSMPQueueLink smp sndPrivateKey linkId sndPublicKey
|
||||
|
||||
getQueueLink :: AgentClient -> UserId -> SMPServer -> SMP.LinkId -> AM (SMP.SenderId, QueueLinkData)
|
||||
getQueueLink c userId server lnkId =
|
||||
snd <$> sendOrProxySMPCommand_ c userId server (unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly
|
||||
snd <$> sendOrProxySMPCommand c userId server (unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly
|
||||
where
|
||||
getViaProxy smp proxySess = proxyGetSMPQueueLink smp proxySess lnkId
|
||||
getDirectly smp = getSMPQueueLink smp lnkId
|
||||
|
||||
@@ -94,6 +94,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
|
||||
deleteInvShortLink,
|
||||
createInvShortLink,
|
||||
setInvShortLinkSndId,
|
||||
updateShortLinkCreds,
|
||||
-- Messages
|
||||
updateRcvIds,
|
||||
createRcvMsg,
|
||||
@@ -782,24 +783,24 @@ getInvShortLink db server linkId =
|
||||
let sndPublicKey = C.APublicAuthKey a $ C.publicKey pk
|
||||
in InvShortLink {server, linkId, linkKey, sndPrivateKey, sndPublicKey, sndId}
|
||||
|
||||
getInvShortLinkKeys :: DB.Connection -> SMPServer -> SenderId -> IO (Maybe C.AAuthKeyPair)
|
||||
getInvShortLinkKeys :: DB.Connection -> SMPServer -> SenderId -> IO (Maybe (LinkId, C.AAuthKeyPair))
|
||||
getInvShortLinkKeys db srv sndId =
|
||||
maybeFirstRow toSndKeys $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT snd_private_key
|
||||
SELECT link_id, snd_private_key
|
||||
FROM inv_short_links
|
||||
WHERE host = ? AND port = ? AND snd_id = ?
|
||||
|]
|
||||
(host srv, port srv, sndId)
|
||||
where
|
||||
toSndKeys :: Only C.APrivateAuthKey -> C.AAuthKeyPair
|
||||
toSndKeys (Only privKey@(C.APrivateAuthKey a pk)) = (C.APublicAuthKey a $ C.publicKey pk, privKey)
|
||||
toSndKeys :: (LinkId, C.APrivateAuthKey) -> (LinkId, C.AAuthKeyPair)
|
||||
toSndKeys (linkId, privKey@(C.APrivateAuthKey a pk)) = (linkId, (C.APublicAuthKey a $ C.publicKey pk, privKey))
|
||||
|
||||
deleteInvShortLink :: DB.Connection -> SMPServer -> SenderId -> IO ()
|
||||
deleteInvShortLink db srv sndId =
|
||||
DB.execute db "DELETE FROM inv_short_links WHERE host = ? AND port = ? AND snd_id = ?" (host srv, port srv, sndId)
|
||||
deleteInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO ()
|
||||
deleteInvShortLink db srv lnkId =
|
||||
DB.execute db "DELETE FROM inv_short_links WHERE host = ? AND port = ? AND link_id = ?" (host srv, port srv, lnkId)
|
||||
|
||||
createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
|
||||
createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do
|
||||
@@ -830,6 +831,17 @@ setInvShortLinkSndId db InvShortLink {server, linkId} sndId =
|
||||
|]
|
||||
(sndId, host server, port server, linkId)
|
||||
|
||||
updateShortLinkCreds :: DB.Connection -> RcvQueue -> ShortLinkCreds -> IO ()
|
||||
updateShortLinkCreds db RcvQueue {server, rcvId} ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE rcv_queues
|
||||
SET link_id = ?, link_key = ?, link_priv_sig_key = ?, link_enc_fixed_data = ?
|
||||
WHERE host = ? AND port = ? AND rcv_id = ?
|
||||
|]
|
||||
(shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData, host server, port server, rcvId)
|
||||
|
||||
updateRcvIds :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
|
||||
updateRcvIds db connId = do
|
||||
(lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash) <- retrieveLastIdsAndHashRcv_ db connId
|
||||
|
||||
@@ -31,17 +31,25 @@ encodeSignLinkData :: ConnectionModeI c => C.KeyPair 'C.Ed25519 -> VersionRangeS
|
||||
encodeSignLinkData (sigKey, pk) agentVRange connReq userData =
|
||||
let fd = smpEncode FixedLinkData {agentVRange, sigKey, connReq}
|
||||
ud = smpEncode UserLinkData {agentVRange, userData}
|
||||
in (LinkKey (C.sha3_256 fd), (sign fd, sign ud))
|
||||
where
|
||||
sign s = smpEncode (C.signatureBytes $ C.sign' pk s) <> s
|
||||
in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk ud))
|
||||
|
||||
encodeSignUserData :: C.PrivateKeyEd25519 -> VersionRangeSMPA -> ConnInfo -> ByteString
|
||||
encodeSignUserData pk agentVRange userData =
|
||||
encodeSign pk $ smpEncode UserLinkData {agentVRange, userData}
|
||||
|
||||
encodeSign :: C.PrivateKeyEd25519 -> ByteString -> ByteString
|
||||
encodeSign pk s = smpEncode (C.signatureBytes $ C.sign' pk s) <> s
|
||||
|
||||
-- TODO [short links] possibly use padded encryption for fixed and for user data
|
||||
encryptLinkData :: TVar ChaChaDRG -> C.SbKey -> (ByteString, ByteString) -> IO QueueLinkData
|
||||
encryptLinkData g k = bimapM encrypt encrypt
|
||||
where
|
||||
encrypt s = do
|
||||
nonce <- atomically $ C.randomCbNonce g
|
||||
pure $ EncDataBytes $ smpEncode nonce <> C.sbEncryptNoPad k nonce s
|
||||
encrypt = encryptData g k
|
||||
|
||||
encryptData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> IO EncDataBytes
|
||||
encryptData g k s = do
|
||||
nonce <- atomically $ C.randomCbNonce g
|
||||
pure $ EncDataBytes $ smpEncode nonce <> C.sbEncryptNoPad k nonce s
|
||||
|
||||
decryptLinkData :: ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnInfo)
|
||||
decryptLinkData linkKey k (encFD, encUD) = do
|
||||
|
||||
@@ -1264,11 +1264,13 @@ client
|
||||
ACK msgId -> withQueue $ acknowledgeMsg msgId
|
||||
KEY sKey -> withQueue $ \q _ -> (corrId,entId,) . either ERR id <$> secureQueue_ q sKey
|
||||
LSET lnkId d ->
|
||||
withQueue $ \q qr -> checkMode QMContact qr $ liftIO $
|
||||
OK <$$ addQueueLinkData (queueStore ms) q lnkId d
|
||||
withQueue $ \q qr -> checkMode QMContact qr $ liftIO $ case queueData qr of
|
||||
Just (lnkId', _) | lnkId' /= lnkId -> pure $ Left AUTH
|
||||
_ -> OK <$$ addQueueLinkData (queueStore ms) q lnkId d
|
||||
LDEL ->
|
||||
withQueue $ \q _ -> liftIO $ (corrId,entId,) . either ERR (const OK) <$>
|
||||
deleteQueueLinkData (queueStore ms) q
|
||||
withQueue $ \q qr -> checkMode QMContact qr $ liftIO $ case queueData qr of
|
||||
Just _ -> OK <$$ deleteQueueLinkData (queueStore ms) q
|
||||
Nothing -> pure $ Right OK
|
||||
NKEY nKey dhKey -> withQueue $ \q _ -> addQueueNotifier_ q nKey dhKey
|
||||
NDEL -> withQueue $ \q _ -> deleteQueueNotifier_ q
|
||||
OFF -> maybe (pure $ err INTERNAL) suspendQueue_ q_
|
||||
|
||||
@@ -219,7 +219,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
|
||||
Nothing ->
|
||||
addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId))
|
||||
Just (lnkId', _) | lnkId' == lnkId ->
|
||||
addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data != ?)") (d :. (lnkId, rId, fst d))
|
||||
addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data = ?)") (d :. (lnkId, rId, fst d))
|
||||
_ -> throwE AUTH
|
||||
where
|
||||
rId = recipientId sq
|
||||
|
||||
@@ -312,6 +312,7 @@ functionalAPITests ps = do
|
||||
it "should connect via 1-time short link" $ testInviationShortLink ps
|
||||
it "should connect via 1-time short link with async join" $ testInviationShortLinkAsync ps
|
||||
it "should connect via contact short link" $ testContactShortLink ps
|
||||
it "should add short link to existing contact and connect" $ testAddContactShortLink ps
|
||||
describe "Message delivery" $ do
|
||||
describe "update connection agent version on received messages" $ do
|
||||
it "should increase if compatible, shouldn'ps decrease" $
|
||||
@@ -1130,7 +1131,7 @@ testContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO ()
|
||||
testContactShortLink ps =
|
||||
withAgentClients3 $ \a b c -> withSmpServer ps $ do
|
||||
let userData = "some user data"
|
||||
(_contactId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
|
||||
(contactId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
|
||||
(connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
@@ -1156,6 +1157,59 @@ testContactShortLink ps =
|
||||
get a ##> ("", bId, CON)
|
||||
get b ##> ("", aId, CON)
|
||||
exchangeGreetings a bId b aId
|
||||
-- update user data
|
||||
let updatedData = "updated user data"
|
||||
shortLink' <- runRight $ setContactShortLink a contactId updatedData
|
||||
shortLink' `shouldBe` shortLink
|
||||
(connReq4, updatedData') <- runRight $ getConnShortLink c 1 shortLink
|
||||
connReq4 `shouldBe` connReq
|
||||
updatedData' `shouldBe` updatedData
|
||||
-- one more time
|
||||
shortLink2 <- runRight $ setContactShortLink a contactId updatedData
|
||||
shortLink2 `shouldBe` shortLink
|
||||
-- delete short link
|
||||
runRight_ $ deleteContactShortLink a contactId
|
||||
Left (SMP _ AUTH) <- runExceptT $ getConnShortLink c 1 shortLink
|
||||
pure ()
|
||||
|
||||
testAddContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO ()
|
||||
testAddContactShortLink ps =
|
||||
withAgentClients3 $ \a b c -> withSmpServer ps $ do
|
||||
(contactId, (connReq, Nothing)) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe
|
||||
let userData = "some user data"
|
||||
shortLink <- runRight $ setContactShortLink a contactId userData
|
||||
(connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
userData' `shouldBe` userData
|
||||
-- same user can get contact link again
|
||||
(connReq2, userData2) <- runRight $ getConnShortLink b 1 shortLink
|
||||
connReq2 `shouldBe` connReq
|
||||
userData2 `shouldBe` userData
|
||||
-- another user can get the same contact link
|
||||
(connReq3, userData3) <- runRight $ getConnShortLink c 1 shortLink
|
||||
connReq3 `shouldBe` connReq
|
||||
userData3 `shouldBe` userData
|
||||
runRight $ do
|
||||
(aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
|
||||
liftIO $ sndSecure `shouldBe` False
|
||||
("", _, REQ invId _ "bob's connInfo") <- get a
|
||||
bId <- A.prepareConnectionToAccept a True invId PQSupportOn
|
||||
sndSecure' <- acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sndSecure' `shouldBe` True
|
||||
("", _, CONF confId _ "alice's connInfo") <- get b
|
||||
allowConnection b aId confId "bob's connInfo"
|
||||
get a ##> ("", bId, INFO "bob's connInfo")
|
||||
get a ##> ("", bId, CON)
|
||||
get b ##> ("", aId, CON)
|
||||
exchangeGreetings a bId b aId
|
||||
-- update user data
|
||||
let updatedData = "updated user data"
|
||||
shortLink' <- runRight $ setContactShortLink a contactId updatedData
|
||||
shortLink' `shouldBe` shortLink
|
||||
(connReq4, updatedData') <- runRight $ getConnShortLink c 1 shortLink
|
||||
connReq4 `shouldBe` connReq
|
||||
updatedData' `shouldBe` updatedData
|
||||
|
||||
testIncreaseConnAgentVersion :: HasCallStack => (ATransport, AStoreType) -> IO ()
|
||||
testIncreaseConnAgentVersion ps = do
|
||||
|
||||
@@ -1102,6 +1102,13 @@ testInvQueueLinkData =
|
||||
sId3 `shouldBe` sId
|
||||
ld2 `shouldBe` ld
|
||||
|
||||
let newLD = (EncDataBytes "fixed data", EncDataBytes "updated user data")
|
||||
Resp "8" rId' (ERR AUTH) <- signSendRecv r rKey ("8", rId, LSET lnkId newLD)
|
||||
rId' `shouldBe` rId
|
||||
|
||||
Resp "9" rId2 (ERR AUTH) <- signSendRecv r rKey ("9", rId, LDEL)
|
||||
rId2 `shouldBe` rId
|
||||
|
||||
testContactQueueLinkData :: SpecWith (ATransport, AStoreType)
|
||||
testContactQueueLinkData =
|
||||
it "create and access queue short link data for contact address" $ \(ATransport t, msType) ->
|
||||
@@ -1141,6 +1148,27 @@ testContactQueueLinkData =
|
||||
sId3 `shouldBe` sId
|
||||
ld2 `shouldBe` ld
|
||||
|
||||
let newLD = (EncDataBytes "fixed data", EncDataBytes "updated user data")
|
||||
Resp "7" rId' OK <- signSendRecv r rKey ("7", rId, LSET lnkId newLD)
|
||||
rId' `shouldBe` rId
|
||||
|
||||
Resp "8" _ (LNK sId4 ld3) <- sendRecv s ("", "8", lnkId, LGET)
|
||||
sId4 `shouldBe` sId
|
||||
ld3 `shouldBe` newLD
|
||||
|
||||
badLnkId <- EntityId <$> atomically (C.randomBytes 24 g)
|
||||
Resp "9" _ (ERR AUTH) <- signSendRecv r rKey ("9", rId, LSET badLnkId newLD)
|
||||
|
||||
let badLD = (EncDataBytes "changed fixed data", EncDataBytes "updated user data 2")
|
||||
Resp "10" _ (ERR AUTH) <- signSendRecv r rKey ("10", rId, LSET lnkId badLD)
|
||||
|
||||
Resp "11" rId2 OK <- signSendRecv r rKey ("11", rId, LDEL)
|
||||
rId2 `shouldBe` rId
|
||||
Resp "11a" _ OK <- signSendRecv r rKey ("11a", rId, LDEL)
|
||||
|
||||
Resp "12" lnkId3 (ERR AUTH) <- sendRecv s ("", "12", lnkId, LGET)
|
||||
lnkId3 `shouldBe` lnkId
|
||||
|
||||
samplePubKey :: C.APublicVerifyKey
|
||||
samplePubKey = C.APublicVerifyKey C.SEd25519 "MCowBQYDK2VwAyEAfAOflyvbJv1fszgzkQ6buiZJVgSpQWsucXq7U6zjMgY="
|
||||
|
||||
|
||||
Reference in New Issue
Block a user