mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-07-28 10:00:02 +00:00
smp-server: add serverInfoBytes to THandleParams and related functions
This commit is contained in:
Ed Asriyan
@@ -147,7 +147,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
|
||||
let HTTP2Client {sessionId, sessionALPN} = http2Client
|
||||
v = VersionXFTP 1
|
||||
thServerVRange = versionToRange v
|
||||
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
|
||||
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False, serverInfoBytes = Nothing}
|
||||
logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
|
||||
thParams@THandleParams {thVersion} <- case sessionALPN of
|
||||
Just alpn
|
||||
|
||||
@@ -157,7 +157,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
|
||||
reqBody <- getHTTP2Body r xftpBlockSize
|
||||
let v = VersionXFTP 1
|
||||
thServerVRange = versionToRange v
|
||||
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
|
||||
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False, serverInfoBytes = Nothing}
|
||||
req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse, sniUsed, addCORS = addCORS'}
|
||||
flip runReaderT env $ case sessionALPN of
|
||||
Nothing -> processRequest req0
|
||||
|
||||
@@ -200,6 +200,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
|
||||
import Simplex.Messaging.Agent.Store.Entity
|
||||
import Simplex.Messaging.Agent.Store.Interface (closeDBStore, execSQL, getCurrentMigrations)
|
||||
import Simplex.Messaging.Agent.Store.Shared (UpMigration (..), upMigration)
|
||||
import Simplex.Messaging.Server.Information (ServerPublicInfo)
|
||||
import qualified Simplex.Messaging.Agent.TSessionSubs as SS
|
||||
import Simplex.Messaging.Client (NetworkRequestMode (..), ProtocolClientError (..), SMPClientError, ServerTransmission (..), ServerTransmissionBatch, TransportSessionMode (..), nonBlockingWriteTBQueue, smpErrorClientNotice, temporaryClientError, unexpectedResponse)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
@@ -640,11 +641,11 @@ getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
|
||||
{-# INLINE getConnectionRatchetAdHash #-}
|
||||
|
||||
-- | Test protocol server
|
||||
testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Maybe ProtocolTestFailure)
|
||||
testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Either ProtocolTestFailure (Either String ServerPublicInfo))
|
||||
testProtocolServer c nm userId srv = withAgentEnv' c $ case protocolTypeI @p of
|
||||
SPSMP -> runSMPServerTest c nm userId srv
|
||||
SPXFTP -> runXFTPServerTest c nm userId srv
|
||||
SPNTF -> runNTFServerTest c nm userId srv
|
||||
SPXFTP -> maybe (Right (Left "no info for XFTP")) Left <$> runXFTPServerTest c nm userId srv
|
||||
SPNTF -> maybe (Right (Left "no info for NTF")) Left <$> runNTFServerTest c nm userId srv
|
||||
|
||||
-- | set SOCKS5 proxy on/off and optionally set TCP timeouts for fast network
|
||||
setNetworkConfig :: AgentClient -> NetworkConfig -> AE ()
|
||||
|
||||
@@ -206,6 +206,7 @@ import Control.Monad.Trans.Except
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Bifunctor (bimap, first, second)
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
@@ -304,11 +305,12 @@ import Simplex.Messaging.Protocol
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import Simplex.Messaging.Protocol.Types
|
||||
import Simplex.Messaging.Server.QueueStore.QueueInfo
|
||||
import Simplex.Messaging.Server.Information (ServerPublicInfo)
|
||||
import Simplex.Messaging.Session
|
||||
import Simplex.Messaging.SystemTime
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
|
||||
import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion, serverInfoBytes), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost (..))
|
||||
import Simplex.Messaging.Transport.Credentials
|
||||
import Simplex.Messaging.Util
|
||||
@@ -1281,7 +1283,7 @@ data ProtocolTestFailure = ProtocolTestFailure
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
|
||||
runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Either ProtocolTestFailure (Either String ServerPublicInfo))
|
||||
runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv auth) = do
|
||||
cfg <- getClientConfig c smpCfg
|
||||
C.AuthAlg ra <- asks $ rcvAuthAlg . config
|
||||
@@ -1292,6 +1294,9 @@ runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
|
||||
ts <- readTVarIO $ proxySessTs c
|
||||
getProtocolClient g nm tSess cfg presetDomains Nothing ts (\_ -> pure ()) >>= \case
|
||||
Right smp -> do
|
||||
let serverInfo = case serverInfoBytes (thParams smp) of
|
||||
Nothing -> Left "No server info received"
|
||||
Just bs -> J.eitherDecodeStrict bs
|
||||
rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
|
||||
(sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
|
||||
(dhKey, _) <- atomically $ C.generateKeyPair g
|
||||
@@ -1303,8 +1308,10 @@ runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
|
||||
_ -> secureSMPQueue smp nm rpKey rcvId sKey
|
||||
liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp nm rpKey rcvId
|
||||
ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient smp
|
||||
pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
|
||||
Left e -> pure (Just $ testErr TSConnect e)
|
||||
pure $ case either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok of
|
||||
Just failErr -> Left failErr
|
||||
Nothing -> Right serverInfo
|
||||
Left e -> pure $ Left (testErr TSConnect e)
|
||||
where
|
||||
addr = B.unpack $ strEncode srv
|
||||
testErr :: ProtocolTestStep -> SMPClientError -> ProtocolTestFailure
|
||||
|
||||
@@ -230,7 +230,8 @@ smpClientStub g sessionId thVersion thAuth = do
|
||||
implySessId = thVersion >= authCmdsSMPVersion,
|
||||
encryptBlock = Nothing,
|
||||
batch = True,
|
||||
serviceAuth = thVersion >= serviceCertsSMPVersion
|
||||
serviceAuth = thVersion >= serviceCertsSMPVersion,
|
||||
serverInfoBytes = Nothing
|
||||
},
|
||||
sessionTs = ts,
|
||||
client_ =
|
||||
|
||||
@@ -186,5 +186,6 @@ ntfTHandle c = THandle {connection = c, params}
|
||||
implySessId = False,
|
||||
encryptBlock = Nothing,
|
||||
batch = False,
|
||||
serviceAuth = False
|
||||
serviceAuth = False,
|
||||
serverInfoBytes = Nothing
|
||||
}
|
||||
|
||||
@@ -56,6 +56,7 @@ import Control.Monad.Trans.Except
|
||||
import Control.Monad.STM (retry)
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Bifunctor (first, second)
|
||||
import qualified Data.Aeson as J
|
||||
import Data.ByteString.Base64 (encode)
|
||||
import qualified Data.ByteString.Builder as BLD
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
@@ -739,9 +740,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
|
||||
idSize <- asks $ queueIdBytes . config
|
||||
kh <- asks serverIdentity
|
||||
ks <- atomically . C.generateKeyPair =<< asks random
|
||||
ServerConfig {smpServerVRange, smpHandshakeTimeout} <- asks config
|
||||
ServerConfig {smpServerVRange, smpHandshakeTimeout, information} <- asks config
|
||||
let serverInfo = LB.toStrict . J.encode <$> information
|
||||
labelMyThread $ "smp handshake for " <> transportName tp
|
||||
liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange $ getClientService ms g idSize) >>= \case
|
||||
liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange serverInfo $ getClientService ms g idSize) >>= \case
|
||||
Just (Right th) -> runClientTransport th
|
||||
_ -> pure ()
|
||||
|
||||
|
||||
@@ -58,6 +58,7 @@ module Simplex.Messaging.Transport
|
||||
clientNoticesSMPVersion,
|
||||
rcvServiceSMPVersion,
|
||||
namesSMPVersion,
|
||||
serverInfoSMPVersion,
|
||||
simplexMQVersion,
|
||||
smpBlockSize,
|
||||
TransportConfig (..),
|
||||
@@ -108,7 +109,7 @@ module Simplex.Messaging.Transport
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative (optional)
|
||||
import Control.Applicative (optional, (<|>))
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad
|
||||
import Control.Monad.Except
|
||||
@@ -173,6 +174,7 @@ smpBlockSize = 16384
|
||||
-- 17 - create notification credentials with NEW (7/12/2025)
|
||||
-- 18 - support client notices (10/10/2025)
|
||||
-- 19 - service subscriptions to messages (10/20/2025)
|
||||
-- 20 - server public information in handshake (7/5/2026)
|
||||
|
||||
data SMPVersion
|
||||
|
||||
@@ -227,6 +229,9 @@ rcvServiceSMPVersion = VersionSMP 19
|
||||
namesSMPVersion :: VersionSMP
|
||||
namesSMPVersion = VersionSMP 20
|
||||
|
||||
serverInfoSMPVersion :: VersionSMP
|
||||
serverInfoSMPVersion = VersionSMP 20
|
||||
|
||||
minClientSMPRelayVersion :: VersionSMP
|
||||
minClientSMPRelayVersion = VersionSMP 6
|
||||
|
||||
@@ -496,7 +501,9 @@ data THandleParams v p = THandleParams
|
||||
-- based on protocol version
|
||||
batch :: Bool,
|
||||
-- | include service signature (or '0' if it is absent), based on protocol version
|
||||
serviceAuth :: Bool
|
||||
serviceAuth :: Bool,
|
||||
-- | JSON-encoded ServerPublicInfo from handshake, present when server version >= serverInfoSMPVersion
|
||||
serverInfoBytes :: Maybe ByteString
|
||||
}
|
||||
|
||||
data THandleAuth (p :: TransportPeer) where
|
||||
@@ -548,7 +555,9 @@ data SMPServerHandshake = SMPServerHandshake
|
||||
sessionId :: SessionId,
|
||||
-- pub key to agree shared secrets for command authorization and entity ID encryption.
|
||||
-- todo C.PublicKeyX25519
|
||||
authPubKey :: Maybe CertChainPubKey
|
||||
authPubKey :: Maybe CertChainPubKey,
|
||||
-- | optional server public information (JSON-encoded ServerPublicInfo), sent when version >= serverInfoSMPVersion
|
||||
serverInfo :: Maybe ByteString
|
||||
}
|
||||
|
||||
-- This is the third handshake message that SMP server sends to services
|
||||
@@ -638,16 +647,21 @@ ifHasProxy v a b = if v >= proxyServerHandshakeSMPVersion then a else b
|
||||
ifHasService :: VersionSMP -> a -> a -> a
|
||||
ifHasService v a b = if v >= serviceCertsSMPVersion then a else b
|
||||
|
||||
ifHasServerInfo :: VersionSMP -> a -> a -> a
|
||||
ifHasServerInfo v a b = if v >= serverInfoSMPVersion then a else b
|
||||
|
||||
instance Encoding SMPServerHandshake where
|
||||
smpEncode SMPServerHandshake {smpVersionRange, sessionId, authPubKey} =
|
||||
smpEncode (smpVersionRange, sessionId) <> auth
|
||||
smpEncode SMPServerHandshake {smpVersionRange, sessionId, authPubKey, serverInfo} =
|
||||
smpEncode (smpVersionRange, sessionId) <> auth <> info
|
||||
where
|
||||
auth = encodeAuthEncryptCmds (maxVersion smpVersionRange) authPubKey
|
||||
info = ifHasServerInfo (maxVersion smpVersionRange) (smpEncode (Large <$> serverInfo)) ""
|
||||
smpP = do
|
||||
(smpVersionRange, sessionId) <- smpP
|
||||
-- TODO drop SMP v6: remove special parser and make key non-optional
|
||||
authPubKey <- authEncryptCmdsP (maxVersion smpVersionRange) smpP
|
||||
pure SMPServerHandshake {smpVersionRange, sessionId, authPubKey}
|
||||
serverInfo <- ifHasServerInfo (maxVersion smpVersionRange) ((fmap unLarge <$> smpP) <|> pure Nothing) (pure Nothing)
|
||||
pure SMPServerHandshake {smpVersionRange, sessionId, authPubKey, serverInfo}
|
||||
|
||||
-- newtype for CertificateChain and a session key signed with this certificate
|
||||
data CertChainPubKey = CertChainPubKey
|
||||
@@ -763,12 +777,13 @@ smpServerHandshake ::
|
||||
C.KeyPairX25519 ->
|
||||
C.KeyHash ->
|
||||
VersionRangeSMP ->
|
||||
Maybe ByteString ->
|
||||
(SMPServiceRole -> X.CertificateChain -> XV.Fingerprint -> ExceptT TransportError IO ServiceId) ->
|
||||
ExceptT TransportError IO (THandleSMP c 'TServer)
|
||||
smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange getService = do
|
||||
smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange serverInfo getService = do
|
||||
let sk = C.signX509 srvSignKey $ C.publicToX509 k
|
||||
smpVersionRange = maybe legacyServerSMPRelayVRange (const smpVRange) $ getSessionALPN c
|
||||
sendHandshake th $ SMPServerHandshake {sessionId, smpVersionRange, authPubKey = Just (CertChainPubKey srvCert sk)}
|
||||
sendHandshake th $ SMPServerHandshake {sessionId, smpVersionRange, authPubKey = Just (CertChainPubKey srvCert sk), serverInfo}
|
||||
SMPClientHandshake {smpVersion = v, keyHash, authPubKey = k', proxyServer, clientService} <- getHandshake th
|
||||
when (keyHash /= kh) $ throwE $ TEHandshake IDENTITY
|
||||
case compatibleVRange' smpVersionRange v of
|
||||
@@ -801,7 +816,7 @@ smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange getService = do
|
||||
-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
|
||||
smpClientHandshake :: forall c. Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleSMP c 'TClient)
|
||||
smpClientHandshake c ks_ keyHash@(C.KeyHash kh) vRange proxyServer serviceKeys_ = do
|
||||
SMPServerHandshake {sessionId = sessId, smpVersionRange, authPubKey} <- getHandshake th
|
||||
SMPServerHandshake {sessionId = sessId, smpVersionRange, authPubKey, serverInfo} <- getHandshake th
|
||||
when (sessionId /= sessId) $ throwE TEBadSession
|
||||
-- Below logic downgrades version range in case the "client" is SMP proxy server and it is
|
||||
-- connected to the destination server of the version 11 or older.
|
||||
@@ -838,7 +853,7 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) vRange proxyServer serviceKeys_
|
||||
hs = SMPClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer, clientService}
|
||||
sendHandshake th hs
|
||||
service <- mapM getClientService serviceKeys
|
||||
liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ proxyServer service
|
||||
liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ proxyServer service serverInfo
|
||||
Nothing -> throwE TEVersion
|
||||
where
|
||||
th@THandle {params = THandleParams {sessionId}} = smpTHandle c
|
||||
@@ -856,14 +871,14 @@ smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRang
|
||||
smpTHandleServer th v vr pk k_ proxyServer peerClientService = do
|
||||
let thAuth = Just THAuthServer {serverPrivKey = pk, peerClientService, sessSecret' = (`C.dh'` pk) <$!> k_}
|
||||
be <- blockEncryption th v proxyServer thAuth
|
||||
pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys <$> be
|
||||
pure $ smpTHandle_ th v vr thAuth (uncurry TSbChainKeys <$> be) Nothing
|
||||
|
||||
smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, CertChainPubKey) -> Bool -> Maybe THClientService -> IO (THandleSMP c 'TClient)
|
||||
smpTHandleClient th v vr pk_ ck_ proxyServer clientService = do
|
||||
smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, CertChainPubKey) -> Bool -> Maybe THClientService -> Maybe ByteString -> IO (THandleSMP c 'TClient)
|
||||
smpTHandleClient th v vr pk_ ck_ proxyServer clientService serverInfoBytes = do
|
||||
let thAuth = clientTHParams <$!> ck_
|
||||
be <- blockEncryption th v proxyServer thAuth
|
||||
-- swap is needed to use client's sndKey as server's rcvKey and vice versa
|
||||
pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys . swap <$> be
|
||||
pure $ smpTHandle_ th v vr thAuth (uncurry TSbChainKeys . swap <$> be) serverInfoBytes
|
||||
where
|
||||
clientTHParams (k, ck) =
|
||||
THAuthClient
|
||||
@@ -883,8 +898,8 @@ blockEncryption THandle {params = THandleParams {sessionId}} v proxyServer = \ca
|
||||
be :: Maybe C.DhSecretX25519 -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey))
|
||||
be = mapM $ \(C.DhSecretX25519 secret) -> bimapM newTVarIO newTVarIO $ C.sbcInit sessionId secret
|
||||
|
||||
smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> Maybe TSbChainKeys -> THandleSMP c p
|
||||
smpTHandle_ th@THandle {params} v vr thAuth encryptBlock =
|
||||
smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> Maybe TSbChainKeys -> Maybe ByteString -> THandleSMP c p
|
||||
smpTHandle_ th@THandle {params} v vr thAuth encryptBlock serverInfoBytes =
|
||||
-- TODO drop SMP v6: make thAuth non-optional
|
||||
-- * Note: update version-based parameters in smpTHParamsSetVersion as well.
|
||||
let params' =
|
||||
@@ -894,7 +909,8 @@ smpTHandle_ th@THandle {params} v vr thAuth encryptBlock =
|
||||
thAuth,
|
||||
implySessId = v >= authCmdsSMPVersion,
|
||||
encryptBlock,
|
||||
serviceAuth = v >= serviceCertsSMPVersion -- optional service signature will be encoded for all commands and responses
|
||||
serviceAuth = v >= serviceCertsSMPVersion, -- optional service signature will be encoded for all commands and responses
|
||||
serverInfoBytes
|
||||
}
|
||||
in (th :: THandleSMP c p) {params = params'}
|
||||
|
||||
@@ -933,7 +949,8 @@ smpTHandle c = THandle {connection = c, params}
|
||||
implySessId = False,
|
||||
encryptBlock = Nothing,
|
||||
batch = True,
|
||||
serviceAuth = False
|
||||
serviceAuth = False,
|
||||
serverInfoBytes = Nothing
|
||||
}
|
||||
|
||||
$(J.deriveJSON (sumTypeJSON id) ''HandshakeError)
|
||||
|
||||
@@ -3640,7 +3640,7 @@ testSMPServerConnectionTest (t, msType) newQueueBasicAuth srv =
|
||||
withSmpServerConfigOn t cfg' testPort2 $ \_ -> do
|
||||
-- initially passed server is not running
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a ->
|
||||
testProtocolServer a NRMInteractive 1 srv
|
||||
either Just (const Nothing) <$> testProtocolServer a NRMInteractive 1 srv
|
||||
where
|
||||
cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {newQueueBasicAuth}
|
||||
|
||||
|
||||
@@ -540,7 +540,7 @@ testRunNTFServerTests :: ASrvTransport -> NtfServer -> IO (Maybe ProtocolTestFai
|
||||
testRunNTFServerTests t srv =
|
||||
withNtfServer t $
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a ->
|
||||
testProtocolServer a NRMInteractive 1 $ ProtoServerWithAuth srv Nothing
|
||||
either Just (const Nothing) <$> testProtocolServer a NRMInteractive 1 (ProtoServerWithAuth srv Nothing)
|
||||
|
||||
testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
|
||||
testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
|
||||
|
||||
@@ -421,7 +421,8 @@ testTHandleParams v sessionId =
|
||||
implySessId = v >= authCmdsSMPVersion,
|
||||
encryptBlock = Nothing,
|
||||
batch = True,
|
||||
serviceAuth = v >= serviceCertsSMPVersion
|
||||
serviceAuth = v >= serviceCertsSMPVersion,
|
||||
serverInfoBytes = Nothing
|
||||
}
|
||||
|
||||
testTHandleAuth :: VersionSMP -> TVar ChaChaDRG -> C.APublicAuthKey -> IO (Maybe (THandleAuth 'TClient))
|
||||
|
||||
+2
-2
@@ -99,7 +99,7 @@ testXFTPServerTest newFileBasicAuth srv =
|
||||
withXFTPServerCfg testXFTPServerConfig {newFileBasicAuth, xftpPort = xftpTestPort2} $ \_ ->
|
||||
-- initially passed server is not running
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a ->
|
||||
testProtocolServer a NRMInteractive 1 srv
|
||||
either Just (const Nothing) <$> testProtocolServer a NRMInteractive 1 srv
|
||||
|
||||
rfProgress :: forall m. (HasCallStack, MonadIO m, MonadFail m) => AgentClient -> Int64 -> m ()
|
||||
rfProgress c expected = loop 0
|
||||
@@ -685,4 +685,4 @@ testXFTPServerTest_ :: HasCallStack => XFTPServerWithAuth -> IO (Maybe ProtocolT
|
||||
testXFTPServerTest_ srv =
|
||||
-- initially passed server is not running
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a ->
|
||||
testProtocolServer a NRMInteractive 1 srv
|
||||
either Just (const Nothing) <$> testProtocolServer a NRMInteractive 1 srv
|
||||
|
||||
Reference in New Issue
Block a user