mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-10-12 02:22:45 +00:00
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:
co-authored by
Evgeny Poberezkin
parent
1ae3e8d0be
commit
3016b929b4
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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')
|
||||
|
||||
Reference in New Issue
Block a user