mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-30 14:16:00 +00:00
agent: types and encodings to use from the app (#1504)
* agent: types and encodings to use from the app * use action forks
This commit is contained in:
Evgeny
8
.github/workflows/build.yml
vendored
8
.github/workflows/build.yml
vendored
@@ -46,10 +46,10 @@ jobs:
|
||||
uses: actions/checkout@v3
|
||||
|
||||
- name: Set up Docker Buildx
|
||||
uses: docker/setup-buildx-action@v3
|
||||
uses: simplex-chat/docker-setup-buildx-action@v3
|
||||
|
||||
- name: Build and cache Docker image
|
||||
uses: docker/build-push-action@v6
|
||||
uses: simplex-chat/docker-build-push-action@v6
|
||||
with:
|
||||
context: .
|
||||
load: true
|
||||
@@ -127,7 +127,7 @@ jobs:
|
||||
- name: Build changelog
|
||||
if: startsWith(github.ref, 'refs/tags/v')
|
||||
id: build_changelog
|
||||
uses: mikepenz/release-changelog-builder-action@v5
|
||||
uses: simplex-chat/release-changelog-builder-action@v5
|
||||
with:
|
||||
configuration: .github/changelog_conf.json
|
||||
failOnError: true
|
||||
@@ -138,7 +138,7 @@ jobs:
|
||||
|
||||
- name: Create release
|
||||
if: startsWith(github.ref, 'refs/tags/v') && matrix.ghc != '8.10.7'
|
||||
uses: softprops/action-gh-release@v2
|
||||
uses: simplex-chat/action-gh-release@v2
|
||||
with:
|
||||
body: |
|
||||
See full changelog [here](https://github.com/simplex-chat/simplexmq/blob/master/CHANGELOG.md).
|
||||
|
||||
6
.github/workflows/docker-image.yml
vendored
6
.github/workflows/docker-image.yml
vendored
@@ -22,14 +22,14 @@ jobs:
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Log in to Docker Hub
|
||||
uses: docker/login-action@v3
|
||||
uses: simplex-chat/docker-login-action@v3
|
||||
with:
|
||||
username: ${{ secrets.DOCKERHUB_USERNAME }}
|
||||
password: ${{ secrets.DOCKERHUB_PASSWORD }}
|
||||
|
||||
- name: Extract metadata for Docker image
|
||||
id: meta
|
||||
uses: docker/metadata-action@v5
|
||||
uses: simplex-chat/docker-metadata-action@v5
|
||||
with:
|
||||
images: ${{ secrets.DOCKERHUB_USERNAME }}/${{ matrix.app }}
|
||||
flavor: |
|
||||
@@ -40,7 +40,7 @@ jobs:
|
||||
type=semver,pattern=v{{major}}
|
||||
|
||||
- name: Build and push Docker image
|
||||
uses: docker/build-push-action@v6
|
||||
uses: simplex-chat/docker-build-push-action@v6
|
||||
with:
|
||||
push: true
|
||||
build-args: |
|
||||
|
||||
@@ -365,7 +365,7 @@ deleteConnectionsAsync c waitDelivery = withAgentEnv c . deleteConnectionsAsync'
|
||||
{-# INLINE deleteConnectionsAsync #-}
|
||||
|
||||
-- | Create SMP agent connection (NEW command)
|
||||
createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, (ConnectionRequestUri c, Maybe (ConnShortLink c)))
|
||||
createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, CreatedConnLink c)
|
||||
createConnection c userId enableNtfs = withAgentEnv c .::. newConn c userId enableNtfs
|
||||
{-# INLINE createConnection #-}
|
||||
|
||||
@@ -400,10 +400,12 @@ changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConne
|
||||
-- "link deleted" (SMP AUTH) interactively, so this approach is simpler overall.
|
||||
prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE ConnId
|
||||
prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs
|
||||
{-# INLINE prepareConnectionToJoin #-}
|
||||
|
||||
-- | Create SMP agent connection without queue (to be joined with acceptContact passing invitation ID).
|
||||
prepareConnectionToAccept :: AgentClient -> Bool -> ConfirmationId -> PQSupport -> AE ConnId
|
||||
prepareConnectionToAccept c enableNtfs = withAgentEnv c .: newConnToAccept c "" enableNtfs
|
||||
{-# INLINE prepareConnectionToAccept #-}
|
||||
|
||||
-- | Join SMP agent connection (JOIN command).
|
||||
joinConnection :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured
|
||||
@@ -822,7 +824,7 @@ switchConnectionAsync' c corrId connId =
|
||||
pure . connectionStats $ DuplexConnection cData rqs' sqs
|
||||
_ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex"
|
||||
|
||||
newConn :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, (ConnectionRequestUri c, Maybe (ConnShortLink c)))
|
||||
newConn :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, CreatedConnLink c)
|
||||
newConn c userId enableNtfs cMode userData_ clientData pqInitKeys subMode = do
|
||||
srv <- getSMPServer c userId
|
||||
connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
|
||||
@@ -909,7 +911,7 @@ changeConnectionUser' c oldUserId connId newUserId = do
|
||||
where
|
||||
updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId
|
||||
|
||||
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 :: forall c. ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink 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"
|
||||
@@ -923,7 +925,7 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s
|
||||
Nothing -> do
|
||||
let qd = case cMode of SCMContact -> CQRContact Nothing; SCMInvitation -> CQRMessaging Nothing
|
||||
(_, qUri) <- createRcvQueue Nothing qd e2eKeys
|
||||
(,Nothing) <$> createConnReq qUri
|
||||
(`CCLink` Nothing) <$> createConnReq qUri
|
||||
where
|
||||
createRcvQueue :: Maybe C.CbNonce -> ClntQueueReqData -> C.KeyPairX25519 -> AM (RcvQueue, SMPQueueUri)
|
||||
createRcvQueue nonce_ qd e2eKeys = do
|
||||
@@ -971,21 +973,21 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s
|
||||
srvData <- liftIO $ SL.encryptLinkData g k linkData
|
||||
pure $ CQRMessaging $ Just CQRData {linkKey, privSigKey, srvReq = (sndId, srvData)}
|
||||
pure (nonce, qUri, connReq, qd)
|
||||
connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (ConnectionRequestUri c, Maybe (ConnShortLink c))
|
||||
connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c)
|
||||
connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of
|
||||
Just ShortLinkCreds {shortLinkId, shortLinkKey}
|
||||
| qUri == qUri' ->
|
||||
let link = case cReq of
|
||||
CRContactUri _ -> CSLContact srv CCTContact shortLinkKey
|
||||
CRInvitationUri {} -> CSLInvitation srv shortLinkId shortLinkKey
|
||||
in pure (cReq, Just link)
|
||||
in pure $ CCLink cReq (Just link)
|
||||
| otherwise -> throwE $ INTERNAL "different rcv queue address"
|
||||
Nothing ->
|
||||
let updated (ConnReqUriData _ vr _ _) = (ConnReqUriData SSSimplex vr [qUri] clientData)
|
||||
cReq' = case cReq of
|
||||
CRContactUri crData -> CRContactUri (updated crData)
|
||||
CRInvitationUri crData e2eParams -> CRInvitationUri (updated crData) e2eParams
|
||||
in pure (cReq', Nothing)
|
||||
in pure $ CCLink cReq' Nothing
|
||||
|
||||
newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> PQSupport -> AM ConnId
|
||||
newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
|
||||
@@ -1111,7 +1113,7 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod
|
||||
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 Nothing (CR.IKNoPQ pqSup) subMode srv
|
||||
CCLink 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
|
||||
@@ -1421,7 +1423,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 Nothing pqEnc subMode srv
|
||||
CCLink 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
|
||||
|
||||
@@ -112,7 +112,11 @@ module Simplex.Messaging.Agent.Protocol
|
||||
ServiceScheme,
|
||||
FixedLinkData (..),
|
||||
UserLinkData (..),
|
||||
ConnectionLink (..),
|
||||
AConnectionLink (..),
|
||||
ConnShortLink (..),
|
||||
AConnShortLink (..),
|
||||
CreatedConnLink (..),
|
||||
ContactConnType (..),
|
||||
LinkKey (..),
|
||||
sameConnReqContact,
|
||||
@@ -175,7 +179,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Time.Clock.System (SystemTime)
|
||||
import Data.Type.Equality
|
||||
import Data.Typeable ()
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Word (Word16, Word32)
|
||||
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
|
||||
import Simplex.FileTransfer.Description
|
||||
@@ -1129,6 +1133,13 @@ instance ToJSON AConnectionRequestUri where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
instance ConnectionModeI m => FromJSON (ConnShortLink m) where
|
||||
parseJSON = strParseJSON "ConnShortLink"
|
||||
|
||||
instance ConnectionModeI m => ToJSON (ConnShortLink m) where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
-- debug :: Show a => String -> a -> a
|
||||
-- debug name value = unsafePerformIO (putStrLn $ name <> ": " <> show value) `seq` value
|
||||
-- {-# INLINE debug #-}
|
||||
@@ -1345,6 +1356,8 @@ data ConnShortLink (m :: ConnectionMode) where
|
||||
CSLInvitation :: SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
|
||||
CSLContact :: SMPServer -> ContactConnType -> LinkKey -> ConnShortLink 'CMContact
|
||||
|
||||
deriving instance Eq (ConnShortLink m)
|
||||
|
||||
deriving instance Show (ConnShortLink m)
|
||||
|
||||
newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
|
||||
@@ -1353,15 +1366,49 @@ newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
|
||||
|
||||
instance ToField LinkKey where toField (LinkKey s) = toField $ Binary s
|
||||
|
||||
data ContactConnType = CCTContact | CCTGroup deriving (Show)
|
||||
instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode
|
||||
|
||||
instance (Typeable c, ConnectionModeI c) => FromField (ConnectionLink c) where fromField = blobFieldDecoder strDecode
|
||||
|
||||
instance ConnectionModeI c => ToField (ConnShortLink c) where toField = toField . Binary . strEncode
|
||||
|
||||
instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fromField = blobFieldDecoder strDecode
|
||||
|
||||
data ContactConnType = CCTContact | CCTGroup deriving (Eq, Show)
|
||||
|
||||
data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
|
||||
|
||||
-- TODO [short link] parser, parsing tests
|
||||
data ConnectionLink m = CLFull (ConnectionRequestUri m) | CLShort (ConnShortLink m)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data CreatedConnLink m = CCLink {connFullLink :: ConnectionRequestUri m, connShortLink :: Maybe (ConnShortLink m)}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AConnectionLink = forall m. ConnectionModeI m => ACL (SConnectionMode m) (ConnectionLink m)
|
||||
|
||||
deriving instance Show AConnectionLink
|
||||
|
||||
instance ConnectionModeI m => StrEncoding (ConnectionLink m) where
|
||||
strEncode = \case
|
||||
CLFull cr -> strEncode cr
|
||||
CLShort sl -> strEncode sl
|
||||
strP = (\(ACL _ cl) -> checkConnMode cl) <$?> strP
|
||||
{-# INLINE strP #-}
|
||||
|
||||
instance StrEncoding AConnectionLink where
|
||||
strEncode (ACL _ cl) = strEncode cl
|
||||
{-# INLINE strEncode #-}
|
||||
strP =
|
||||
(\(ACR m cr) -> ACL m (CLFull cr)) <$> strP
|
||||
<|> (\(ACSL m sl) -> ACL m (CLShort sl)) <$> strP
|
||||
|
||||
instance ConnectionModeI m => ToJSON (ConnectionLink m) where
|
||||
toEncoding = strToJEncoding
|
||||
toJSON = strToJSON
|
||||
|
||||
instance ConnectionModeI m => FromJSON (ConnectionLink m) where
|
||||
parseJSON = strParseJSON "ConnectionLink"
|
||||
|
||||
instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
|
||||
strEncode = \case
|
||||
CSLInvitation srv (SMP.EntityId lnkId) (LinkKey k) -> encLink srv (lnkId <> k) "i"
|
||||
@@ -1695,3 +1742,10 @@ $(J.deriveJSON (sumTypeJSON id) ''AgentErrorType)
|
||||
$(J.deriveJSON (enumJSON $ dropPrefix "QD") ''QueueDirection)
|
||||
|
||||
$(J.deriveJSON (enumJSON $ dropPrefix "SP") ''SwitchPhase)
|
||||
|
||||
instance ConnectionModeI m => FromJSON (CreatedConnLink m) where
|
||||
parseJSON = $(J.mkParseJSON defaultJSON ''CreatedConnLink)
|
||||
|
||||
instance ConnectionModeI m => ToJSON (CreatedConnLink m) where
|
||||
toEncoding = $(J.mkToEncoding defaultJSON ''CreatedConnLink)
|
||||
toJSON = $(J.mkToJSON defaultJSON ''CreatedConnLink)
|
||||
|
||||
@@ -28,10 +28,6 @@ deriving instance Eq ClientNtfCreds
|
||||
|
||||
deriving instance Eq ShortLinkCreds
|
||||
|
||||
deriving instance Eq ContactConnType
|
||||
|
||||
deriving instance Eq (ConnShortLink m)
|
||||
|
||||
deriving instance Show ProxiedRelay
|
||||
|
||||
deriving instance Eq ProxiedRelay
|
||||
|
||||
@@ -60,7 +60,7 @@ import Control.Concurrent (forkIO, killThread, threadDelay)
|
||||
import Control.Monad
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor (first, second)
|
||||
import Data.Bifunctor (first)
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
@@ -252,8 +252,9 @@ inAnyOrder g rs = withFrozenCallStack $ do
|
||||
expected r rp = rp r
|
||||
|
||||
createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c)
|
||||
createConnection c userId enableNtfs cMode clientData =
|
||||
fmap (second fst) . A.createConnection c userId enableNtfs cMode Nothing clientData (IKNoPQ PQSupportOn)
|
||||
createConnection c userId enableNtfs cMode clientData subMode = do
|
||||
(connId, CCLink cReq _) <- A.createConnection c userId enableNtfs cMode Nothing clientData (IKNoPQ PQSupportOn) subMode
|
||||
pure (connId, cReq)
|
||||
|
||||
joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
|
||||
joinConnection c userId enableNtfs cReq connInfo subMode = do
|
||||
@@ -615,7 +616,7 @@ runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId =
|
||||
runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
|
||||
runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
|
||||
runRight_ $ do
|
||||
(bobId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing aPQ SMSubscribe
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing aPQ SMSubscribe
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
|
||||
sqSecured' <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
|
||||
liftIO $ sqSecured' `shouldBe` sqSecured
|
||||
@@ -817,7 +818,7 @@ runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
|
||||
runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
|
||||
runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
|
||||
runRight_ $ do
|
||||
(_, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe
|
||||
(_, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
|
||||
sqSecuredJoin <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
|
||||
liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
|
||||
@@ -861,7 +862,7 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b
|
||||
|
||||
runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
|
||||
runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
|
||||
(_, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe
|
||||
(_, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe
|
||||
(bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo
|
||||
sentMessages abPQEnc alice bobId bob bAliceId
|
||||
(tAliceId, tomId, atPQEnc) <- connectViaContact tom tPQ qInfo
|
||||
@@ -914,7 +915,7 @@ noMessages_ ingoreQCONT c err = tryGet `shouldReturn` ()
|
||||
testRejectContactRequest :: HasCallStack => IO ()
|
||||
testRejectContactRequest =
|
||||
withAgentClients2 $ \alice bob -> runRight_ $ do
|
||||
(addrConnId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe
|
||||
(addrConnId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` False -- joining via contact address connection
|
||||
@@ -1085,7 +1086,7 @@ testInviationShortLink :: HasCallStack => (ATransport, AStoreType) -> IO ()
|
||||
testInviationShortLink ps =
|
||||
withAgentClients3 $ \a b c -> withSmpServer ps $ do
|
||||
let userData = "some user data"
|
||||
(bId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
|
||||
(bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
|
||||
(connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
@@ -1113,7 +1114,7 @@ testInviationShortLinkAsync :: HasCallStack => (ATransport, AStoreType) -> IO ()
|
||||
testInviationShortLinkAsync ps =
|
||||
withAgentClients2 $ \a b -> withSmpServer ps $ do
|
||||
let userData = "some user data"
|
||||
(bId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
|
||||
(bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
|
||||
(connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
connReq' `shouldBe` connReq
|
||||
@@ -1132,7 +1133,7 @@ testContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO ()
|
||||
testContactShortLink ps =
|
||||
withAgentClients3 $ \a b c -> withSmpServer ps $ do
|
||||
let userData = "some user data"
|
||||
(contactId, (connReq0, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
|
||||
(contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
|
||||
Right connReq <- pure $ smpDecode (smpEncode connReq0)
|
||||
(connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
|
||||
strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
@@ -1177,7 +1178,7 @@ testContactShortLink ps =
|
||||
testAddContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO ()
|
||||
testAddContactShortLink ps =
|
||||
withAgentClients3 $ \a b c -> withSmpServer ps $ do
|
||||
(contactId, (connReq0, Nothing)) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe
|
||||
(contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe
|
||||
Right connReq <- pure $ smpDecode (smpEncode connReq0) --
|
||||
let userData = "some user data"
|
||||
shortLink <- runRight $ setContactShortLink a contactId userData
|
||||
@@ -1901,7 +1902,7 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True
|
||||
|
||||
makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
|
||||
makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do
|
||||
(bobId, (qInfo, Nothing)) <- A.createConnection alice aliceUserId True SCMInvitation Nothing Nothing (CR.IKNoPQ pqSupport) SMSubscribe
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice aliceUserId True SCMInvitation Nothing Nothing (CR.IKNoPQ pqSupport) SMSubscribe
|
||||
aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
|
||||
sqSecured' <- A.joinConnection bob bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe
|
||||
liftIO $ sqSecured' `shouldBe` sqSecured
|
||||
|
||||
@@ -225,7 +225,7 @@ agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty
|
||||
agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 baseId =
|
||||
withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
|
||||
withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
|
||||
(bobId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` True
|
||||
@@ -281,7 +281,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
|
||||
-- agent connections have to be set up in advance
|
||||
-- otherwise the CONF messages would get mixed with MSG
|
||||
prePair alice bob = do
|
||||
(bobId, (qInfo, Nothing)) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
(bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- runExceptT' $ A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` True
|
||||
@@ -332,7 +332,7 @@ agentViaProxyVersionError =
|
||||
withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
|
||||
Left (A.BROKER _ (TRANSPORT TEVersion)) <-
|
||||
withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
|
||||
(_bobId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
(_bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
pure ()
|
||||
@@ -352,7 +352,7 @@ agentViaProxyRetryOffline = do
|
||||
let pqEnc = CR.PQEncOn
|
||||
withServer $ \_ -> do
|
||||
(aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
|
||||
(bobId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` True
|
||||
|
||||
Reference in New Issue
Block a user