agent: make createConnection and setConnShortLink apis support setting all link data fields (#1665)

* agent: make createConnection and setConnShortLink apis support setting all link data fields

* add functions

* refactor

* refactor

* fix tests

---------

Co-authored-by: Evgeny Poberezkin <[email protected]>
This commit is contained in:
spaced4ndy
2025-11-05 07:08:33 +00:00
committed by GitHub
co-authored by Evgeny Poberezkin
parent 1ae3e8d0be
commit 3016b929b4
6 changed files with 182 additions and 118 deletions
+24 -24
View File
@@ -381,12 +381,12 @@ deleteConnectionsAsync c waitDelivery = withAgentEnv c . deleteConnectionsAsync'
{-# INLINE deleteConnectionsAsync #-}
-- | Create SMP agent connection (NEW command)
createConnection :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe UserLinkData -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, (CreatedConnLink c, Maybe ClientServiceId))
createConnection :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, (CreatedConnLink c, Maybe ClientServiceId))
createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::. newConn c nm userId enableNtfs checkNotices
{-# INLINE createConnection #-}
-- | Create or update user's contact connection short link
setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserLinkData -> Maybe CRClientData -> AE (ConnShortLink c)
setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c)
setConnShortLink c = withAgentEnv c .::. setConnShortLink' c
{-# INLINE setConnShortLink #-}
@@ -865,12 +865,12 @@ switchConnectionAsync' c corrId connId =
connectionStats c $ DuplexConnection cData rqs' sqs
_ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex"
newConn :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe UserLinkData -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, (CreatedConnLink c, Maybe ClientServiceId))
newConn c nm userId enableNtfs checkNotices cMode userData_ clientData pqInitKeys subMode = do
newConn :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, (CreatedConnLink c, Maybe ClientServiceId))
newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKeys subMode = do
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 userData_ clientData pqInitKeys subMode srv
(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 ()
@@ -886,19 +886,19 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu
when (maybe True (ts <) expires_) $
throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_}
setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserLinkData -> Maybe CRClientData -> AM (ConnShortLink c)
setConnShortLink' c nm connId cMode userData clientData =
setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c)
setConnShortLink' c nm connId cMode userLinkData clientData =
withConnLock c connId "setConnShortLink" $ do
SomeConn _ conn <- withStore c (`getConn` connId)
(rq, lnkId, sl, d) <- case (conn, cMode) of
(ContactConnection _ rq, SCMContact) -> prepareContactLinkData rq
(RcvConnection _ rq, SCMInvitation) -> prepareInvLinkData rq
(rq, lnkId, sl, d) <- case (conn, cMode, userLinkData) of
(ContactConnection _ rq, SCMContact, d@UserContactLinkData {}) -> prepareContactLinkData rq d
(RcvConnection _ rq, SCMInvitation, d@UserInvLinkData {}) -> prepareInvLinkData rq d
_ -> throwE $ CMD PROHIBITED "setConnShortLink: invalid connection or mode"
addQueueLink c nm rq lnkId d
pure sl
where
prepareContactLinkData :: RcvQueue -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData)
prepareContactLinkData rq@RcvQueue {shortLink} = do
prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData)
prepareContactLinkData rq@RcvQueue {shortLink} ud = do
g <- asks random
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
let cslContact = CSLContact SLSServer CCTContact (qServer rq)
@@ -906,25 +906,25 @@ setConnShortLink' c nm connId cMode userData clientData =
Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
let (linkId, k) = SL.contactShortLinkKdf shortLinkKey
unless (shortLinkId == linkId) $ throwE $ INTERNAL "setConnShortLink: link ID is not derived from link"
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange userData
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud
pure (rq, linkId, cslContact shortLinkKey, (linkEncFixedData, d))
Nothing -> do
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq ud
(linkId, k) = SL.contactShortLinkKdf linkKey
srvData <- liftError id $ SL.encryptLinkData g k linkData
let slCreds = ShortLinkCreds linkId linkKey privSigKey (fst srvData)
withStore' c $ \db -> updateShortLinkCreds db rq slCreds
pure (rq, linkId, cslContact linkKey, srvData)
prepareInvLinkData :: RcvQueue -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
prepareInvLinkData rq@RcvQueue {shortLink} = case shortLink of
prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
prepareInvLinkData rq@RcvQueue {shortLink} ud = case shortLink of
Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
g <- asks random
AgentConfig {smpAgentVRange} <- asks config
let k = SL.invShortLinkKdf shortLinkKey
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange userData
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange ud
let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey
pure (rq, shortLinkId, sl, (linkEncFixedData, d))
Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation"
@@ -989,13 +989,13 @@ changeConnectionUser' c oldUserId connId newUserId = do
where
updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId
newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe UserLinkData -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink c, Maybe ClientServiceId)
newRcvConnSrv c nm userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do
newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink c, Maybe ClientServiceId)
newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do
case (cMode, pqInitKeys) of
(SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
_ -> pure ()
e2eKeys <- atomically . C.generateKeyPair =<< asks random
case userData_ of
case userLinkData_ of
Just d -> do
(nonce, qUri, cReq, qd) <- prepareLinkData d $ fst e2eKeys
(rq, qUri') <- createRcvQueue (Just nonce) qd e2eKeys
@@ -1025,12 +1025,12 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userData_ clientData pqInitKey
SCMContact -> pure $ CRContactUri crData
SCMInvitation -> do
g <- asks random
let pqEnc = CR.initialPQEncryption (isJust userData_) pqInitKeys
let pqEnc = CR.initialPQEncryption (isJust userLinkData_) pqInitKeys
(pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem
pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange
prepareLinkData :: UserLinkData -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData)
prepareLinkData userData e2eDhKey = do
prepareLinkData :: UserConnLinkData c -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData)
prepareLinkData userLinkData e2eDhKey = do
g <- asks random
nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
@@ -1040,7 +1040,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userData_ clientData pqInitKey
qm = case cMode of SCMContact -> QMContact; SCMInvitation -> QMMessaging
qUri = SMPQueueUri vr $ SMPQueueAddress srv sndId e2eDhKey (Just qm)
connReq <- createConnReq qUri
let (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userData
let (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userLinkData
qd <- case cMode of
SCMContact -> do
let (linkId, k) = SL.contactShortLinkKdf linkKey
+23 -15
View File
@@ -112,6 +112,8 @@ module Simplex.Messaging.Agent.Protocol
ServiceScheme,
FixedLinkData (..),
ConnLinkData (..),
UserConnLinkData (..),
UserContactData (..),
UserLinkData (..),
OwnerAuth (..),
OwnerId,
@@ -1690,25 +1692,30 @@ data FixedLinkData c = FixedLinkData
data ConnLinkData c where
InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
ContactLinkData ::
{ agentVRange :: VersionRangeSMPA,
-- direct connection via connReq in fixed data is allowed.
direct :: Bool,
-- additional owner keys to sign changes of mutable data.
owners :: [OwnerAuth],
-- alternative addresses of chat relays that receive requests for this contact address.
relays :: [ConnShortLink 'CMContact],
userData :: UserLinkData
} -> ConnLinkData 'CMContact
ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact
data UserContactData = UserContactData
{ -- direct connection via connReq in fixed data is allowed.
direct :: Bool,
-- additional owner keys to sign changes of mutable data.
owners :: [OwnerAuth],
-- alternative addresses of chat relays that receive requests for this contact address.
relays :: [ConnShortLink 'CMContact],
userData :: UserLinkData
}
newtype UserLinkData = UserLinkData ByteString
data AConnLinkData = forall m. ConnectionModeI m => ACLD (SConnectionMode m) (ConnLinkData m)
data UserConnLinkData c where
UserInvLinkData :: UserLinkData -> UserConnLinkData 'CMInvitation
UserContactLinkData :: UserContactData -> UserConnLinkData 'CMContact
linkUserData :: ConnLinkData c -> UserLinkData
linkUserData = \case
InvitationLinkData _ d -> d
ContactLinkData {userData} -> userData
ContactLinkData _ UserContactData {userData} -> userData
{-# INLINE linkUserData #-}
linkUserData' :: ConnLinkData c -> ByteString
@@ -1749,8 +1756,8 @@ instance ConnectionModeI c => Encoding (FixedLinkData c) where
instance ConnectionModeI c => Encoding (ConnLinkData c) where
smpEncode = \case
InvitationLinkData vr userData -> smpEncode (CMInvitation, vr, userData)
ContactLinkData {agentVRange, direct, owners, relays, userData} ->
B.concat [smpEncode (CMContact, agentVRange, direct), smpEncodeList owners, smpEncodeList relays, smpEncode userData]
ContactLinkData vr UserContactData {direct, owners, relays, userData} ->
B.concat [smpEncode (CMContact, vr, direct), smpEncodeList owners, smpEncodeList relays, smpEncode userData]
smpP = (\(ACLD _ d) -> checkConnMode d) <$?> smpP
{-# INLINE smpP #-}
@@ -1763,11 +1770,12 @@ instance Encoding AConnLinkData where
(vr, userData) <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure $ ACLD SCMInvitation $ InvitationLinkData vr userData
CMContact -> do
(agentVRange, direct) <- smpP
(vr, direct) <- smpP
owners <- smpListP
relays <- smpListP
userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure $ ACLD SCMContact ContactLinkData {agentVRange, direct, owners, relays, userData}
let cd = UserContactData {direct, owners, relays, userData}
pure $ ACLD SCMContact $ ContactLinkData vr cd
instance Encoding UserLinkData where
smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s)
+10 -9
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -48,20 +49,20 @@ contactShortLinkKdf (LinkKey k) =
invShortLinkKdf :: LinkKey -> C.SbKey
invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserLinkData -> (LinkKey, (ByteString, ByteString))
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}
md = smpEncode $ connLinkData @c agentVRange userData
md = smpEncode $ connLinkData agentVRange userData
in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
encodeSignUserData :: forall c. ConnectionModeI c => SConnectionMode c -> C.PrivateKeyEd25519 -> VersionRangeSMPA -> UserLinkData -> ByteString
encodeSignUserData _ pk agentVRange userData =
encodeSign pk $ smpEncode $ connLinkData @c agentVRange userData
encodeSignUserData :: ConnectionModeI c => SConnectionMode c -> C.PrivateKeyEd25519 -> VersionRangeSMPA -> UserConnLinkData c -> ByteString
encodeSignUserData _ pk agentVRange userLinkData =
encodeSign pk $ smpEncode $ connLinkData agentVRange userLinkData
connLinkData :: forall c. ConnectionModeI c => VersionRangeSMPA -> UserLinkData -> ConnLinkData c
connLinkData agentVRange userData = case sConnectionMode @c of
SCMInvitation -> InvitationLinkData agentVRange userData
SCMContact -> ContactLinkData {agentVRange, direct = True, owners = [], relays = [], userData}
connLinkData :: VersionRangeSMPA -> UserConnLinkData c -> ConnLinkData c
connLinkData vr = \case
UserInvLinkData d -> InvitationLinkData vr d
UserContactLinkData d -> ContactLinkData vr d
encodeSign :: C.PrivateKeyEd25519 -> ByteString -> ByteString
encodeSign pk s = smpEncode (C.sign' pk s) <> s
+5 -1
View File
@@ -5,7 +5,7 @@
module AgentTests.EqInstances where
import Data.Type.Equality
import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), OwnerAuth (..), UserLinkData (..))
import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), OwnerAuth (..), UserContactData (..), UserLinkData (..))
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Client (ProxiedRelay (..))
@@ -32,6 +32,10 @@ deriving instance Show (ConnLinkData c)
deriving instance Eq (ConnLinkData c)
deriving instance Show UserContactData
deriving instance Eq UserContactData
deriving instance Show UserLinkData
deriving instance Eq UserLinkData
+86 -56
View File
@@ -312,7 +312,7 @@ deleteConnections c = A.deleteConnections c NRMInteractive
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
getConnShortLink c = A.getConnShortLink c NRMInteractive
setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserLinkData -> Maybe CRClientData -> AE (ConnShortLink c)
setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c)
setConnShortLink c = A.setConnShortLink c NRMInteractive
suspendConnection :: AgentClient -> ConnId -> AE ()
@@ -369,13 +369,13 @@ functionalAPITests ps = do
it "should connect after errors" $ testContactErrors ps False
it "should connect after errors with client restarts" $ testContactErrors ps True
describe "Short connection links" $ do
describe "should connect via 1-time short link" $ testProxyMatrix ps testInviationShortLink
describe "should connect via 1-time short link with async join" $ testProxyMatrix ps testInviationShortLinkAsync
describe "should connect via 1-time short link" $ testProxyMatrix ps testInvitationShortLink
describe "should connect via 1-time short link with async join" $ testProxyMatrix ps testInvitationShortLinkAsync
describe "should connect via contact short link" $ testProxyMatrix ps testContactShortLink
describe "should add short link to existing contact and connect" $ testProxyMatrix ps testAddContactShortLink
xdescribe "try to create 1-time short link with prev versions" $ testProxyMatrixWithPrev ps testInviationShortLinkPrev
xdescribe "try to create 1-time short link with prev versions" $ testProxyMatrixWithPrev ps testInvitationShortLinkPrev
describe "server restart" $ do
it "should get 1-time link data after restart" $ testInviationShortLinkRestart ps
it "should get 1-time link data after restart" $ testInvitationShortLinkRestart ps
it "should connect via contact short link after restart" $ testContactShortLinkRestart ps
it "should connect via added contact short link after restart" $ testAddContactShortLinkRestart ps
it "should create and get short links with the old contact queues" $ testOldContactQueueShortLink ps
@@ -1329,11 +1329,12 @@ withServer1 ps = withSmpServerStoreLogOn ps testPort . const
withServer2 :: (ASrvTransport, AStoreType) -> IO a -> IO a
withServer2 (t, ASType qsType _) = withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 . const
testInviationShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
testInviationShortLink viaProxy a b =
testInvitationShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
testInvitationShortLink viaProxy a b =
withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
let userData = UserLinkData "some user data"
(bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
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
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
@@ -1364,17 +1365,19 @@ testJoinConn_ viaProxy sndSecure a bId b connReq = do
get b ##> ("", aId, CON)
exchangeGreetingsViaProxy viaProxy a bId b aId
testInviationShortLinkPrev :: HasCallStack => Bool -> Bool -> AgentClient -> AgentClient -> IO ()
testInviationShortLinkPrev viaProxy sndSecure a b = runRight_ $ do
testInvitationShortLinkPrev :: HasCallStack => Bool -> Bool -> AgentClient -> AgentClient -> IO ()
testInvitationShortLinkPrev viaProxy sndSecure a b = runRight_ $ do
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
-- can't create short link with previous version
(bId, (CCLink connReq Nothing, Nothing)) <- A.createConnection a NRMInteractive 1 True True SCMInvitation (Just userData) Nothing CR.IKPQOn SMSubscribe
(bId, (CCLink connReq Nothing, Nothing)) <- A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKPQOn SMSubscribe
testJoinConn_ viaProxy sndSecure a bId b connReq
testInviationShortLinkAsync :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
testInviationShortLinkAsync viaProxy a b = do
testInvitationShortLinkAsync :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
testInvitationShortLinkAsync viaProxy a b = do
let userData = UserLinkData "some user data"
(bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
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
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
@@ -1389,24 +1392,32 @@ testInviationShortLinkAsync viaProxy a b = do
get b ##> ("", aId, CON)
exchangeGreetingsViaProxy viaProxy a bId b aId
relayLink1 :: ConnShortLink 'CMContact
relayLink1 = either error id $ strDecode "https://localhost/a#4AkRDmhf64tdRlN406g8lJRg5OCmhD6ynIhi6glOcCM?p=7001&c=LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI"
relayLink2 :: ConnShortLink 'CMContact
relayLink2 = either error id $ strDecode "https://localhost/a#4AkRDmhf64tdRlN406g8lJRg5OCmhD6ynIhi6glOcCM"
testContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
testContactShortLink viaProxy a b =
withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
let userData = UserLinkData "some user data"
(contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
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', connData') <- runRight $ getConnShortLink b 1 shortLink
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
userCtData' `shouldBe` userCtData
-- same user can get contact link again
(connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
(connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
linkUserData connData2 `shouldBe` userData
userCtData2 `shouldBe` userCtData
-- another user can get the same contact link
(connReq3, connData3) <- runRight $ getConnShortLink c 1 shortLink
(connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
connReq3 `shouldBe` connReq
linkUserData connData3 `shouldBe` userData
userCtData3 `shouldBe` userCtData
runRight $ do
(aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
liftIO $ sndSecure `shouldBe` False
@@ -1422,13 +1433,15 @@ testContactShortLink viaProxy a b =
exchangeGreetingsViaProxy viaProxy a bId b aId
-- update user data
let updatedData = UserLinkData "updated user data"
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
(connReq4, updatedConnData') <- runRight $ getConnShortLink c 1 shortLink
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
connReq4 `shouldBe` connReq
linkUserData updatedConnData' `shouldBe` updatedData
updatedCtData' `shouldBe` updatedCtData
-- one more time
shortLink2 <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
shortLink2 <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink2 `shouldBe` shortLink
-- delete short link
runRight_ $ deleteConnShortLink a NRMInteractive contactId SCMContact
@@ -1441,19 +1454,21 @@ testAddContactShortLink viaProxy a b =
(contactId, (CCLink connReq0 Nothing, Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe
Right connReq <- pure $ smpDecode (smpEncode connReq0) --
let userData = UserLinkData "some user data"
shortLink <- runRight $ setConnShortLink a contactId SCMContact userData Nothing
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
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
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
userCtData' `shouldBe` userCtData
-- same user can get contact link again
(connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
(connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
linkUserData connData2 `shouldBe` userData
userCtData2 `shouldBe` userCtData
-- another user can get the same contact link
(connReq3, connData3) <- runRight $ getConnShortLink c 1 shortLink
(connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
connReq3 `shouldBe` connReq
linkUserData connData3 `shouldBe` userData
userCtData3 `shouldBe` userCtData
runRight $ do
(aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
liftIO $ sndSecure `shouldBe` False
@@ -1469,17 +1484,20 @@ testAddContactShortLink viaProxy a b =
exchangeGreetingsViaProxy viaProxy a bId b aId
-- update user data
let updatedData = UserLinkData "updated user data"
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
(connReq4, updatedConnData') <- runRight $ getConnShortLink c 1 shortLink
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
connReq4 `shouldBe` connReq
linkUserData updatedConnData' `shouldBe` updatedData
updatedCtData' `shouldBe` updatedCtData
testInviationShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testInviationShortLinkRestart ps = withAgentClients2 $ \a b -> do
testInvitationShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
(bId, (CCLink connReq (Just shortLink), Nothing)) <- withSmpServer ps $
runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMOnlyCreate
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
@@ -1490,43 +1508,51 @@ testInviationShortLinkRestart ps = withAgentClients2 $ \a b -> do
testContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
newLinkData = UserContactLinkData userCtData
(contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- withSmpServer ps $
runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just userData) Nothing CR.IKPQOn SMOnlyCreate
runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMOnlyCreate
Right connReq <- pure $ smpDecode (smpEncode connReq0)
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedLinkData = UserContactLinkData updatedCtData
withSmpServer ps $ do
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
userCtData' `shouldBe` userCtData
-- update user data
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing
shortLink' `shouldBe` shortLink
withSmpServer ps $ do
(connReq4, updatedConnData') <- runRight $ getConnShortLink b 1 shortLink
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
connReq4 `shouldBe` connReq
linkUserData updatedConnData' `shouldBe` updatedData
updatedCtData' `shouldBe` updatedCtData
testAddContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
newLinkData = UserContactLinkData userCtData
((contactId, (CCLink connReq0 Nothing, Nothing)), shortLink) <- withSmpServer ps $ runRight $ do
r@(contactId, _) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate
(r,) <$> setConnShortLink a contactId SCMContact userData Nothing
(r,) <$> setConnShortLink a contactId SCMContact newLinkData Nothing
Right connReq <- pure $ smpDecode (smpEncode connReq0)
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedLinkData = UserContactLinkData updatedCtData
withSmpServer ps $ do
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
userCtData' `shouldBe` userCtData
-- update user data
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing
shortLink' `shouldBe` shortLink
withSmpServer ps $ do
(connReq4, updatedConnData') <- runRight $ getConnShortLink b 1 shortLink
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
connReq4 `shouldBe` connReq
linkUserData updatedConnData' `shouldBe` updatedData
updatedCtData' `shouldBe` updatedCtData
testOldContactQueueShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
@@ -1560,19 +1586,23 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
withSmpServer ps $ do
let userData = UserLinkData "some user data"
shortLink <- runRight $ setConnShortLink a contactId SCMContact userData Nothing
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
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
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
userCtData' `shouldBe` userCtData
-- update user data
let updatedData = UserLinkData "updated user data"
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedData Nothing
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
-- check updated
(connReq'', updatedConnData') <- runRight $ getConnShortLink b 1 shortLink
(connReq'', ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
connReq'' `shouldBe` connReq
linkUserData updatedConnData' `shouldBe` updatedData
updatedCtData' `shouldBe` updatedCtData
replaceSubstringInFile :: FilePath -> T.Text -> T.Text -> IO ()
replaceSubstringInFile filePath oldText newText = do
+34 -13
View File
@@ -1,4 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
@@ -8,7 +11,8 @@ import AgentTests.ConnectionRequestTests (contactConnRequest, invConnRequest)
import AgentTests.EqInstances ()
import Control.Concurrent.STM
import Control.Monad.Except
import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnectionMode (..), LinkKey (..), SConnectionMode (..), SMPAgentError (..), UserLinkData (..), linkUserData, supportedSMPAgentVRange)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnLinkData (..), ConnectionMode (..), ConnShortLink (..), LinkKey (..), UserConnLinkData (..), SConnectionMode (..), SMPAgentError (..), UserContactData (..), UserLinkData (..), linkUserData, supportedSMPAgentVRange)
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.ShortLink as SL
import Test.Hspec hiding (fit, it)
@@ -31,7 +35,8 @@ testInvShortLink = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userData
userLinkData = UserInvLinkData userData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userLinkData
k = SL.invShortLinkKdf linkKey
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
-- decrypt
@@ -45,7 +50,8 @@ testInvShortLinkBadDataHash = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userData
userLinkData = UserInvLinkData userData
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userLinkData
-- different key
linkKey <- LinkKey <$> atomically (C.randomBytes 32 g)
let k = SL.invShortLinkKdf linkKey
@@ -54,19 +60,27 @@ testInvShortLinkBadDataHash = do
SL.decryptLinkData @'CMInvitation linkKey k srvData
`shouldBe` Left (AGENT (A_LINK "link data hash"))
relayLink1 :: ConnShortLink 'CMContact
relayLink1 = either error id $ strDecode "https://localhost/a#4AkRDmhf64tdRlN406g8lJRg5OCmhD6ynIhi6glOcCM?p=7001&c=LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI"
relayLink2 :: ConnShortLink 'CMContact
relayLink2 = either error id $ strDecode "https://localhost/a#4AkRDmhf64tdRlN406g8lJRg5OCmhD6ynIhi6glOcCM"
testContactShortLink :: IO ()
testContactShortLink = do
-- encrypt
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData userCtData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
-- decrypt
Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData
Right (connReq, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
connReq `shouldBe` contactConnRequest
linkUserData connData' `shouldBe` userData
userCtData' `shouldBe` userCtData
testUpdateContactShortLink :: IO ()
testUpdateContactShortLink = do
@@ -74,17 +88,21 @@ testUpdateContactShortLink = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData userCtData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
-- encrypt updated user data
let updatedUserData = UserLinkData "updated user data"
signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange updatedUserData
userCtData' = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedUserData}
userLinkData' = UserContactLinkData userCtData'
signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData'
Right ud' <- runExceptT $ SL.encryptUserData g k signed
-- decrypt
Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k (fd, ud')
Right (connReq, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
connReq `shouldBe` contactConnRequest
linkUserData connData' `shouldBe` updatedUserData
userCtData'' `shouldBe` userCtData'
testContactShortLinkBadDataHash :: IO ()
testContactShortLinkBadDataHash = do
@@ -92,7 +110,8 @@ testContactShortLinkBadDataHash = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
-- different key
linkKey <- LinkKey <$> atomically (C.randomBytes 32 g)
let (_linkId, k) = SL.contactShortLinkKdf linkKey
@@ -107,14 +126,16 @@ testContactShortLinkBadSignature = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userData
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
-- encrypt updated user data
let updatedUserData = UserLinkData "updated user data"
userLinkData' = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = updatedUserData}
-- another signature key
(_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g
let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange updatedUserData
let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange userLinkData'
Right ud' <- runExceptT $ SL.encryptUserData g k signed
-- decryption fails
SL.decryptLinkData @'CMContact linkKey k (fd, ud')