mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-06 23:40:18 +00:00
Merge branch 'master' into pq
This commit is contained in:
Evgeny Poberezkin
@@ -4,6 +4,7 @@
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
|
||||
@@ -16,7 +17,7 @@ import Simplex.Messaging.Agent.Protocol
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.Ratchet
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Protocol (ProtocolServer (..), supportedSMPClientVRange)
|
||||
import Simplex.Messaging.Protocol (ProtocolServer (..), pattern VersionSMPC, supportedSMPClientVRange)
|
||||
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
|
||||
import Simplex.Messaging.Version
|
||||
import Test.Hspec
|
||||
@@ -53,7 +54,7 @@ queue :: SMPQueueUri
|
||||
queue = SMPQueueUri supportedSMPClientVRange queueAddr
|
||||
|
||||
queueV1 :: SMPQueueUri
|
||||
queueV1 = SMPQueueUri (mkVersionRange 1 1) queueAddr
|
||||
queueV1 = SMPQueueUri (mkVersionRange (VersionSMPC 1) (VersionSMPC 1)) queueAddr
|
||||
|
||||
testDhKey :: C.PublicKeyX25519
|
||||
testDhKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
|
||||
@@ -68,7 +69,7 @@ connReqData :: ConnReqUriData
|
||||
connReqData =
|
||||
ConnReqUriData
|
||||
{ crScheme = SSSimplex,
|
||||
crAgentVRange = mkVersionRange 2 2,
|
||||
crAgentVRange = mkVersionRange (VersionSMPA 2) (VersionSMPA 2),
|
||||
crSmpQueues = [queueV1],
|
||||
crClientData = Nothing
|
||||
}
|
||||
@@ -77,7 +78,7 @@ testDhPubKey :: C.PublicKeyX448
|
||||
testDhPubKey = "MEIwBQYDK2VvAzkAmKuSYeQ/m0SixPDS8Wq8VBaTS1cW+Lp0n0h4Diu+kUpR+qXx4SDJ32YGEFoGFGSbGPry5Ychr6U="
|
||||
|
||||
testE2ERatchetParams :: RcvE2ERatchetParamsUri 'C.X448
|
||||
testE2ERatchetParams = E2ERatchetParamsUri (mkVersionRange 1 1) testDhPubKey testDhPubKey Nothing
|
||||
testE2ERatchetParams = E2ERatchetParamsUri (mkVersionRange (VersionE2E 1) (VersionE2E 1)) testDhPubKey testDhPubKey Nothing
|
||||
|
||||
testE2ERatchetParams12 :: RcvE2ERatchetParamsUri 'C.X448
|
||||
testE2ERatchetParams12 = E2ERatchetParamsUri supportedE2EEncryptVRange testDhPubKey testDhPubKey Nothing
|
||||
@@ -113,7 +114,7 @@ connectionRequestTests =
|
||||
it "should serialize SMP queue URIs" $ do
|
||||
strEncode (queue :: SMPQueueUri) {queueAddress = queueAddrNoPort}
|
||||
`shouldBe` "smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
|
||||
strEncode queue {clientVRange = mkVersionRange 1 2}
|
||||
strEncode queue {clientVRange = mkVersionRange (VersionSMPC 1) (VersionSMPC 2)}
|
||||
`shouldBe` "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
|
||||
it "should parse SMP queue URIs" $ do
|
||||
strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-2&dh=" <> testDhKeyStr)
|
||||
|
||||
@@ -18,7 +18,7 @@ import Control.Monad (when)
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.IO.Class
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import Data.Aeson (FromJSON, ToJSON, (.=))
|
||||
import qualified Data.Aeson as J
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
@@ -44,6 +44,7 @@ doubleRatchetTests = do
|
||||
it "should encode/decode ratchet as JSON" $ do
|
||||
testAlgs testKeyJSON
|
||||
testAlgs testRatchetJSON
|
||||
testVersionJSON
|
||||
it "should agree the same ratchet parameters" $ testAlgs testX3dh
|
||||
it "should agree the same ratchet parameters with version 1" $ testAlgs testX3dhV1
|
||||
describe "post-quantum hybrid KEM double-ratchet algorithm" $ do
|
||||
@@ -87,12 +88,12 @@ testAlgs test = test C.SX25519 >> test C.SX448
|
||||
paddedMsgLen :: Int
|
||||
paddedMsgLen = 100
|
||||
|
||||
fullMsgLen :: Version -> Int
|
||||
fullMsgLen :: VersionE2E -> Int
|
||||
fullMsgLen v = headerLenLength + fullHeaderLen + C.authTagSize + paddedMsgLen
|
||||
where
|
||||
headerLenLength = if v < pqRatchetVersion then 1 else 3 -- two bytes are added because of two Large used in new encoding
|
||||
|
||||
testMessageHeader :: forall a. AlgorithmI a => Version -> C.SAlgorithm a -> Expectation
|
||||
testMessageHeader :: forall a. AlgorithmI a => VersionE2E -> C.SAlgorithm a -> Expectation
|
||||
testMessageHeader v _ = do
|
||||
(k, _) <- atomically . C.generateKeyPair @a =<< C.newRandom
|
||||
let hdr = MsgHeader {msgMaxVersion = v, msgDHRs = k, msgKEM = Nothing, msgPN = 0, msgNs = 0}
|
||||
@@ -335,6 +336,20 @@ testRatchetJSON _ = do
|
||||
testEncodeDecode alice
|
||||
testEncodeDecode bob
|
||||
|
||||
testVersionJSON :: IO ()
|
||||
testVersionJSON = do
|
||||
testEncodeDecode $ rv 1 1
|
||||
testEncodeDecode $ rv 1 2
|
||||
-- let bad = RVersions 2 1
|
||||
-- Left err <- pure $ J.eitherDecode' @RatchetVersions (J.encode bad)
|
||||
-- err `shouldContain` "bad version range"
|
||||
testDecodeRV $ (1 :: Int, 2 :: Int)
|
||||
testDecodeRV $ J.object ["current" .= (1 :: Int), "maxSupported" .= (2 :: Int)]
|
||||
where
|
||||
rv v1 v2 = ratchetVersions $ mkVersionRange (VersionE2E v1) (VersionE2E v2)
|
||||
testDecodeRV :: ToJSON a => a -> Expectation
|
||||
testDecodeRV a = J.eitherDecode' (J.encode a) `shouldBe` Right (rv 1 2)
|
||||
|
||||
testEncodeDecode :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Expectation
|
||||
testEncodeDecode x = do
|
||||
let j = J.encode x
|
||||
@@ -354,8 +369,8 @@ testX3dh _ = do
|
||||
testX3dhV1 :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
testX3dhV1 _ = do
|
||||
g <- C.newRandom
|
||||
(pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g 1 Nothing
|
||||
(pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g 1 PQEncOff
|
||||
(pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g (VersionE2E 1) Nothing
|
||||
(pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g (VersionE2E 1) PQEncOff
|
||||
let paramsBob = pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
|
||||
paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
|
||||
paramsAlice `shouldBe` paramsBob
|
||||
@@ -544,7 +559,7 @@ encrypt_ enableKem (_, rc, _) msg =
|
||||
>>= either (pure . Left) checkLength
|
||||
where
|
||||
checkLength (msg', rc') = do
|
||||
B.length msg' `shouldBe` fullMsgLen (maxVersion $ rcVersion rc)
|
||||
B.length msg' `shouldBe` fullMsgLen (maxSupported $ rcVersion rc)
|
||||
pure $ Right (msg', rc', SMDNoChange)
|
||||
|
||||
decrypt_ :: (AlgorithmI a, DhAlgorithm a) => (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff))
|
||||
|
||||
@@ -58,6 +58,7 @@ import qualified Data.Set as S
|
||||
import Data.Time.Clock (diffUTCTime, getCurrentTime)
|
||||
import Data.Time.Clock.System (SystemTime (..), getSystemTime)
|
||||
import Data.Type.Equality
|
||||
import Data.Word (Word16)
|
||||
import qualified Database.SQLite.Simple as SQL
|
||||
import SMPAgentClient
|
||||
import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn, withSmpServerV7)
|
||||
@@ -74,13 +75,15 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), pattern PQEncOn, pattern PQEncOff)
|
||||
import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Notifications.Transport (authBatchCmdsNTFVersion)
|
||||
import Simplex.Messaging.Notifications.Transport (NTFVersion, pattern VersionNTF, authBatchCmdsNTFVersion)
|
||||
import Simplex.Messaging.Protocol (AProtocolType (..), BasicAuth, ErrorType (..), MsgBody, ProtocolServer (..), SubscriptionMode (..), supportedSMPClientVRange)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
|
||||
import Simplex.Messaging.Server.Expiration
|
||||
import Simplex.Messaging.Transport (ATransport (..), authCmdsSMPVersion, basicAuthSMPVersion, currentServerSMPRelayVersion)
|
||||
import Simplex.Messaging.Version
|
||||
import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, batchCmdsSMPVersion, basicAuthSMPVersion, currentServerSMPRelayVersion)
|
||||
import Simplex.Messaging.Version (VersionRange (..))
|
||||
import qualified Simplex.Messaging.Version as V
|
||||
import Simplex.Messaging.Version.Internal (Version (..))
|
||||
import System.Directory (copyFile, renameFile)
|
||||
import Test.Hspec
|
||||
import UnliftIO
|
||||
@@ -156,14 +159,14 @@ pattern MsgErr msgId err msgBody <- MSG MsgMeta {recipient = (msgId, _), integri
|
||||
pattern Rcvd :: AgentMsgId -> ACommand 'Agent 'AEConn
|
||||
pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMsgId, msgRcptStatus = MROk}]
|
||||
|
||||
smpCfgVPrev :: ProtocolClientConfig
|
||||
smpCfgVPrev :: ProtocolClientConfig SMPVersion
|
||||
smpCfgVPrev = (smpCfg agentCfg) {serverVRange = prevRange $ serverVRange $ smpCfg agentCfg}
|
||||
|
||||
smpCfgV7 :: ProtocolClientConfig
|
||||
smpCfgV7 = (smpCfg agentCfg) {serverVRange = mkVersionRange 4 authCmdsSMPVersion}
|
||||
smpCfgV7 :: ProtocolClientConfig SMPVersion
|
||||
smpCfgV7 = (smpCfg agentCfg) {serverVRange = V.mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}
|
||||
|
||||
ntfCfgV2 :: ProtocolClientConfig
|
||||
ntfCfgV2 = (smpCfg agentCfg) {serverVRange = mkVersionRange 1 authBatchCmdsNTFVersion}
|
||||
ntfCfgV2 :: ProtocolClientConfig NTFVersion
|
||||
ntfCfgV2 = (smpCfg agentCfg) {serverVRange = V.mkVersionRange (VersionNTF 1) authBatchCmdsNTFVersion}
|
||||
|
||||
agentCfgVPrev :: AgentConfig
|
||||
agentCfgVPrev =
|
||||
@@ -186,8 +189,14 @@ agentCfgV7 =
|
||||
agentCfgRatchetVPrev :: AgentConfig
|
||||
agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}
|
||||
|
||||
prevRange :: VersionRange -> VersionRange
|
||||
prevRange vr = vr {maxVersion = max (minVersion vr) (maxVersion vr - 1)}
|
||||
prevRange :: VersionRange v -> VersionRange v
|
||||
prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr)}
|
||||
|
||||
prevVersion :: Version v -> Version v
|
||||
prevVersion (Version v) = Version (v - 1)
|
||||
|
||||
mkVersionRange :: Word16 -> Word16 -> VersionRange v
|
||||
mkVersionRange v1 v2 = V.mkVersionRange (Version v1) (Version v2)
|
||||
|
||||
runRight_ :: (Eq e, Show e, HasCallStack) => ExceptT e IO () -> Expectation
|
||||
runRight_ action = runExceptT action `shouldReturn` Right ()
|
||||
@@ -352,8 +361,8 @@ functionalAPITests t = do
|
||||
describe "should switch two connections simultaneously, abort one" $
|
||||
testServerMatrix2 t testSwitch2ConnectionsAbort1
|
||||
describe "SMP basic auth" $ do
|
||||
let v4 = basicAuthSMPVersion - 1
|
||||
forM_ (nub [authCmdsSMPVersion - 1, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
|
||||
let v4 = prevVersion basicAuthSMPVersion
|
||||
forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
|
||||
describe ("v" <> show v <> ": with server auth") $ do
|
||||
-- allow NEW | server auth, v | clnt1 auth, v | clnt2 auth, v | 2 - success, 1 - JOIN fail, 0 - NEW fail
|
||||
it "success " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) `shouldReturn` 2
|
||||
@@ -397,9 +406,9 @@ functionalAPITests t = do
|
||||
it "should send delivery receipt only in connection v3+" $ testDeliveryReceiptsVersion t
|
||||
it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent t
|
||||
|
||||
testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
|
||||
testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> IO Int
|
||||
testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
|
||||
let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = mkVersionRange 4 srvVersion}
|
||||
let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion}
|
||||
canCreate1 = canCreateQueue allowNewQueues srv clnt1
|
||||
canCreate2 = canCreateQueue allowNewQueues srv clnt2
|
||||
expected
|
||||
@@ -410,7 +419,7 @@ testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
|
||||
created `shouldBe` expected
|
||||
pure created
|
||||
|
||||
canCreateQueue :: Bool -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> Bool
|
||||
canCreateQueue :: Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> Bool
|
||||
canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
|
||||
let v = basicAuthSMPVersion
|
||||
in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth))
|
||||
@@ -733,10 +742,10 @@ testIncreaseConnAgentVersion t = do
|
||||
disconnectAgentClient alice3
|
||||
disconnectAgentClient bob3
|
||||
|
||||
checkVersion :: AgentClient -> ConnId -> Version -> ExceptT AgentErrorType IO ()
|
||||
checkVersion :: AgentClient -> ConnId -> Word16 -> ExceptT AgentErrorType IO ()
|
||||
checkVersion c connId v = do
|
||||
ConnectionStats {connAgentVersion} <- getConnectionServers c connId
|
||||
liftIO $ connAgentVersion `shouldBe` v
|
||||
liftIO $ connAgentVersion `shouldBe` VersionSMPA v
|
||||
|
||||
testIncreaseConnAgentVersionMaxCompatible :: HasCallStack => ATransport -> IO ()
|
||||
testIncreaseConnAgentVersionMaxCompatible t = do
|
||||
@@ -2276,7 +2285,7 @@ testSwitch2ConnectionsAbort1 servers = do
|
||||
withB :: (AgentClient -> IO a) -> IO a
|
||||
withB = withAgent 2 agentCfg servers testDB2
|
||||
|
||||
testCreateQueueAuth :: HasCallStack => Version -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
|
||||
testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> IO Int
|
||||
testCreateQueueAuth srvVersion clnt1 clnt2 = do
|
||||
a <- getClient 1 clnt1 testDB
|
||||
b <- getClient 2 clnt2 testDB2
|
||||
@@ -2302,7 +2311,7 @@ testCreateQueueAuth srvVersion clnt1 clnt2 = do
|
||||
where
|
||||
getClient clientId (clntAuth, clntVersion) db =
|
||||
let servers = initAgentServers {smp = userServers [ProtoServerWithAuth testSMPServer clntAuth]}
|
||||
smpCfg = (defaultSMPClientConfig :: ProtocolClientConfig) {serverVRange = mkVersionRange (basicAuthSMPVersion - 1) clntVersion}
|
||||
smpCfg = (defaultSMPClientConfig :: ProtocolClientConfig SMPVersion) {serverVRange = V.mkVersionRange (prevVersion basicAuthSMPVersion) clntVersion}
|
||||
sndAuthAlg = if srvVersion >= authCmdsSMPVersion && clntVersion >= authCmdsSMPVersion then C.AuthAlg C.SX25519 else C.AuthAlg C.SEd25519
|
||||
in getSMPAgentClient' clientId agentCfg {smpCfg, sndAuthAlg} servers db
|
||||
|
||||
|
||||
@@ -49,7 +49,7 @@ import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQEncOn)
|
||||
import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..))
|
||||
import Simplex.Messaging.Encoding.String (StrEncoding (..))
|
||||
import Simplex.Messaging.Protocol (SubscriptionMode (..))
|
||||
import Simplex.Messaging.Protocol (SubscriptionMode (..), pattern VersionSMPC)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import System.Random
|
||||
import Test.Hspec
|
||||
@@ -185,7 +185,7 @@ cData1 =
|
||||
ConnData
|
||||
{ userId = 1,
|
||||
connId = "conn1",
|
||||
connAgentVersion = 1,
|
||||
connAgentVersion = VersionSMPA 1,
|
||||
enableNtfs = True,
|
||||
lastExternalSndId = 0,
|
||||
deleted = False,
|
||||
@@ -222,7 +222,7 @@ rcvQueue1 =
|
||||
primary = True,
|
||||
dbReplaceQueueId = Nothing,
|
||||
rcvSwchStatus = Nothing,
|
||||
smpClientVersion = 1,
|
||||
smpClientVersion = VersionSMPC 1,
|
||||
clientNtfCreds = Nothing,
|
||||
deleteErrors = 0
|
||||
}
|
||||
@@ -243,7 +243,7 @@ sndQueue1 =
|
||||
primary = True,
|
||||
dbReplaceQueueId = Nothing,
|
||||
sndSwchStatus = Nothing,
|
||||
smpClientVersion = 1
|
||||
smpClientVersion = VersionSMPC 1
|
||||
}
|
||||
|
||||
createRcvConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> NewRcvQueue -> SConnectionMode c -> IO (Either StoreError (ConnId, RcvQueue))
|
||||
@@ -387,7 +387,7 @@ testUpgradeRcvConnToDuplex =
|
||||
sndSwchStatus = Nothing,
|
||||
primary = True,
|
||||
dbReplaceQueueId = Nothing,
|
||||
smpClientVersion = 1
|
||||
smpClientVersion = VersionSMPC 1
|
||||
}
|
||||
upgradeRcvConnToDuplex db "conn1" anotherSndQueue
|
||||
`shouldReturn` Left (SEBadConnType CSnd)
|
||||
@@ -416,7 +416,7 @@ testUpgradeSndConnToDuplex =
|
||||
rcvSwchStatus = Nothing,
|
||||
primary = True,
|
||||
dbReplaceQueueId = Nothing,
|
||||
smpClientVersion = 1,
|
||||
smpClientVersion = VersionSMPC 1,
|
||||
clientNtfCreds = Nothing,
|
||||
deleteErrors = 0
|
||||
}
|
||||
|
||||
@@ -15,7 +15,6 @@ import Simplex.Messaging.Client
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Protocol
|
||||
import Simplex.Messaging.Transport
|
||||
import Simplex.Messaging.Version (Version)
|
||||
import Test.Hspec
|
||||
|
||||
batchingTests :: Spec
|
||||
@@ -253,27 +252,27 @@ testClientBatchWithLargeMessageV7 = do
|
||||
(length rs1', length rs2') `shouldBe` (74, 136)
|
||||
all lenOk [s1', s2'] `shouldBe` True
|
||||
|
||||
testClientStub :: IO (ProtocolClient ErrorType BrokerMsg)
|
||||
testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
|
||||
testClientStub = do
|
||||
g <- C.newRandom
|
||||
sessId <- atomically $ C.randomBytes 32 g
|
||||
atomically $ clientStub g sessId (authCmdsSMPVersion - 1) Nothing
|
||||
atomically $ smpClientStub g sessId subModeSMPVersion Nothing
|
||||
|
||||
clientStubV7 :: IO (ProtocolClient ErrorType BrokerMsg)
|
||||
clientStubV7 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
|
||||
clientStubV7 = do
|
||||
g <- C.newRandom
|
||||
sessId <- atomically $ C.randomBytes 32 g
|
||||
(rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
|
||||
thAuth_ <- testTHandleAuth authCmdsSMPVersion g rKey
|
||||
atomically $ clientStub g sessId authCmdsSMPVersion thAuth_
|
||||
atomically $ smpClientStub g sessId authCmdsSMPVersion thAuth_
|
||||
|
||||
randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSUB = randomSUB_ C.SEd25519 (authCmdsSMPVersion - 1)
|
||||
randomSUB = randomSUB_ C.SEd25519 subModeSMPVersion
|
||||
|
||||
randomSUBv7 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSUBv7 = randomSUB_ C.SEd25519 authCmdsSMPVersion
|
||||
|
||||
randomSUB_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> Version -> ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSUB_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSUB_ a v sessId = do
|
||||
g <- C.newRandom
|
||||
rId <- atomically $ C.randomBytes 24 g
|
||||
@@ -284,13 +283,13 @@ randomSUB_ a v sessId = do
|
||||
TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (corrId, rId, Cmd SRecipient SUB)
|
||||
pure $ (,tToSend) <$> authTransmission thAuth_ (Just rpKey) corrId tForAuth
|
||||
|
||||
randomSUBCmd :: ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSUBCmd = randomSUBCmd_ C.SEd25519
|
||||
|
||||
randomSUBCmdV7 :: ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSUBCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSUBCmdV7 = randomSUBCmd_ C.SEd25519 -- same as v6
|
||||
|
||||
randomSUBCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSUBCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSUBCmd_ a c = do
|
||||
g <- C.newRandom
|
||||
rId <- atomically $ C.randomBytes 24 g
|
||||
@@ -298,12 +297,12 @@ randomSUBCmd_ a c = do
|
||||
mkTransmission c (Just rpKey, rId, Cmd SRecipient SUB)
|
||||
|
||||
randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSEND = randomSEND_ C.SEd25519 (authCmdsSMPVersion - 1)
|
||||
randomSEND = randomSEND_ C.SEd25519 subModeSMPVersion
|
||||
|
||||
randomSENDv7 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSENDv7 = randomSEND_ C.SX25519 authCmdsSMPVersion
|
||||
|
||||
randomSEND_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> Version -> ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSEND_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
|
||||
randomSEND_ a v sessId len = do
|
||||
g <- C.newRandom
|
||||
sId <- atomically $ C.randomBytes 24 g
|
||||
@@ -315,7 +314,7 @@ randomSEND_ a v sessId len = do
|
||||
TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (corrId, sId, Cmd SSender $ SEND noMsgFlags msg)
|
||||
pure $ (,tToSend) <$> authTransmission thAuth_ (Just spKey) corrId tForAuth
|
||||
|
||||
testTHandleParams :: Version -> ByteString -> THandleParams
|
||||
testTHandleParams :: VersionSMP -> ByteString -> THandleParams SMPVersion
|
||||
testTHandleParams v sessionId =
|
||||
THandleParams
|
||||
{ sessionId,
|
||||
@@ -326,20 +325,20 @@ testTHandleParams v sessionId =
|
||||
batch = True
|
||||
}
|
||||
|
||||
testTHandleAuth :: Version -> TVar ChaChaDRG -> C.APublicAuthKey -> IO (Maybe THandleAuth)
|
||||
testTHandleAuth :: VersionSMP -> TVar ChaChaDRG -> C.APublicAuthKey -> IO (Maybe THandleAuth)
|
||||
testTHandleAuth v g (C.APublicAuthKey a k) = case a of
|
||||
C.SX25519 | v >= authCmdsSMPVersion -> do
|
||||
(_, privKey) <- atomically $ C.generateKeyPair g
|
||||
pure $ Just THandleAuth {peerPubKey = k, privKey}
|
||||
_ -> pure Nothing
|
||||
|
||||
randomSENDCmd :: ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSENDCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSENDCmd = randomSENDCmd_ C.SEd25519
|
||||
|
||||
randomSENDCmdV7 :: ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSENDCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSENDCmdV7 = randomSENDCmd_ C.SX25519
|
||||
|
||||
randomSENDCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSENDCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
|
||||
randomSENDCmd_ a c len = do
|
||||
g <- C.newRandom
|
||||
sId <- atomically $ C.randomBytes 24 g
|
||||
|
||||
@@ -12,7 +12,7 @@ import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import GHC.Generics (Generic)
|
||||
import Generic.Random (genericArbitraryU)
|
||||
import Simplex.FileTransfer.Protocol (XFTPErrorType (..))
|
||||
import Simplex.FileTransfer.Transport (XFTPErrorType (..))
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module CoreTests.TRcvQueuesTests where
|
||||
@@ -12,7 +13,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, QueueStatus (..), UserId)
|
||||
import Simplex.Messaging.Agent.Store (DBQueueId (..), RcvQueue, StoredRcvQueue (..))
|
||||
import qualified Simplex.Messaging.Agent.TRcvQueues as RQ
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Protocol (SMPServer)
|
||||
import Simplex.Messaging.Protocol (SMPServer, pattern VersionSMPC)
|
||||
import Test.Hspec
|
||||
import UnliftIO
|
||||
|
||||
@@ -137,7 +138,7 @@ dummyRQ userId server connId =
|
||||
primary = True,
|
||||
dbReplaceQueueId = Nothing,
|
||||
rcvSwchStatus = Nothing,
|
||||
smpClientVersion = 123,
|
||||
smpClientVersion = VersionSMPC 123,
|
||||
clientNtfCreds = Nothing,
|
||||
deleteErrors = 0
|
||||
}
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module CoreTests.VersionRangeTests where
|
||||
@@ -8,6 +9,7 @@ module CoreTests.VersionRangeTests where
|
||||
import GHC.Generics (Generic)
|
||||
import Generic.Random (genericArbitraryU)
|
||||
import Simplex.Messaging.Version
|
||||
import Simplex.Messaging.Version.Internal
|
||||
import Test.Hspec
|
||||
import Test.Hspec.QuickCheck (modifyMaxSuccess)
|
||||
import Test.QuickCheck
|
||||
@@ -16,6 +18,10 @@ data V = V1 | V2 | V3 | V4 | V5 deriving (Eq, Enum, Ord, Generic, Show)
|
||||
|
||||
instance Arbitrary V where arbitrary = genericArbitraryU
|
||||
|
||||
data T
|
||||
|
||||
instance VersionScope T
|
||||
|
||||
versionRangeTests :: Spec
|
||||
versionRangeTests = modifyMaxSuccess (const 1000) $ do
|
||||
describe "VersionRange construction" $ do
|
||||
@@ -25,31 +31,31 @@ versionRangeTests = modifyMaxSuccess (const 1000) $ do
|
||||
(pure $! vr 2 1) `shouldThrow` anyErrorCall
|
||||
describe "compatible version" $ do
|
||||
it "should choose mutually compatible max version" $ do
|
||||
(vr 1 1, vr 1 1) `compatible` Just 1
|
||||
(vr 1 1, vr 1 2) `compatible` Just 1
|
||||
(vr 1 2, vr 1 2) `compatible` Just 2
|
||||
(vr 1 2, vr 2 3) `compatible` Just 2
|
||||
(vr 1 3, vr 2 3) `compatible` Just 3
|
||||
(vr 1 3, vr 2 4) `compatible` Just 3
|
||||
(vr 1 1, vr 1 1) `compatible` Just (Version 1)
|
||||
(vr 1 1, vr 1 2) `compatible` Just (Version 1)
|
||||
(vr 1 2, vr 1 2) `compatible` Just (Version 2)
|
||||
(vr 1 2, vr 2 3) `compatible` Just (Version 2)
|
||||
(vr 1 3, vr 2 3) `compatible` Just (Version 3)
|
||||
(vr 1 3, vr 2 4) `compatible` Just (Version 3)
|
||||
(vr 1 2, vr 3 4) `compatible` Nothing
|
||||
it "should check if version is compatible" $ do
|
||||
isCompatible (1 :: Version) (vr 1 2) `shouldBe` True
|
||||
isCompatible (2 :: Version) (vr 1 2) `shouldBe` True
|
||||
isCompatible (2 :: Version) (vr 1 1) `shouldBe` False
|
||||
isCompatible (1 :: Version) (vr 2 2) `shouldBe` False
|
||||
isCompatible @T (Version 1) (vr 1 2) `shouldBe` True
|
||||
isCompatible @T (Version 2) (vr 1 2) `shouldBe` True
|
||||
isCompatible @T (Version 2) (vr 1 1) `shouldBe` False
|
||||
isCompatible @T (Version 1) (vr 2 2) `shouldBe` False
|
||||
it "compatibleVersion should pass isCompatible check" . property $
|
||||
\((min1, max1) :: (V, V)) ((min2, max2) :: (V, V)) ->
|
||||
min1 > max1
|
||||
|| min2 > max2 -- one of ranges is invalid, skip testing it
|
||||
|| let w = fromIntegral . fromEnum
|
||||
vr1 = mkVersionRange (w min1) (w max1) :: VersionRange
|
||||
vr2 = mkVersionRange (w min2) (w max2) :: VersionRange
|
||||
|| let w = Version . fromIntegral . fromEnum
|
||||
vr1 = mkVersionRange (w min1) (w max1) :: VersionRange T
|
||||
vr2 = mkVersionRange (w min2) (w max2) :: VersionRange T
|
||||
in case compatibleVersion vr1 vr2 of
|
||||
Just (Compatible v) -> v `isCompatible` vr1 && v `isCompatible` vr2
|
||||
_ -> True
|
||||
where
|
||||
vr = mkVersionRange
|
||||
compatible :: (VersionRange, VersionRange) -> Maybe Version -> Expectation
|
||||
vr v1 v2 = mkVersionRange (Version v1) (Version v2)
|
||||
compatible :: (VersionRange T, VersionRange T) -> Maybe (Version T) -> Expectation
|
||||
(vr1, vr2) `compatible` v = do
|
||||
(vr1, vr2) `checkCompatible` v
|
||||
(vr2, vr1) `checkCompatible` v
|
||||
|
||||
+8
-7
@@ -34,6 +34,7 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost,
|
||||
import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Notifications.Protocol (NtfResponse)
|
||||
import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
|
||||
import Simplex.Messaging.Notifications.Server.Env
|
||||
import Simplex.Messaging.Notifications.Server.Push.APNS
|
||||
@@ -70,7 +71,7 @@ testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
|
||||
ntfTestStoreLogFile :: FilePath
|
||||
ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log"
|
||||
|
||||
testNtfClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
|
||||
testNtfClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandleNTF c -> m a) -> m a
|
||||
testNtfClient client = do
|
||||
Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
|
||||
runTransportClient defaultTransportClientConfig Nothing host ntfTestPort (Just testKeyHash) $ \h -> do
|
||||
@@ -114,8 +115,8 @@ ntfServerCfg =
|
||||
ntfServerCfgV2 :: NtfServerConfig
|
||||
ntfServerCfgV2 =
|
||||
ntfServerCfg
|
||||
{ ntfServerVRange = mkVersionRange 1 authBatchCmdsNTFVersion,
|
||||
smpAgentCfg = defaultSMPClientAgentConfig {smpCfg = (smpCfg defaultSMPClientAgentConfig) {serverVRange = mkVersionRange 4 authCmdsSMPVersion}}
|
||||
{ ntfServerVRange = mkVersionRange initialNTFVersion authBatchCmdsNTFVersion,
|
||||
smpAgentCfg = defaultSMPClientAgentConfig {smpCfg = (smpCfg defaultSMPClientAgentConfig) {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}}
|
||||
}
|
||||
|
||||
withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
|
||||
@@ -139,7 +140,7 @@ withNtfServerOn t port' = withNtfServerThreadOn t port' . const
|
||||
withNtfServer :: ATransport -> IO a -> IO a
|
||||
withNtfServer t = withNtfServerOn t ntfTestPort
|
||||
|
||||
runNtfTest :: forall c a. Transport c => (THandle c -> IO a) -> IO a
|
||||
runNtfTest :: forall c a. Transport c => (THandleNTF c -> IO a) -> IO a
|
||||
runNtfTest test = withNtfServer (transport @c) $ testNtfClient test
|
||||
|
||||
ntfServerTest ::
|
||||
@@ -147,10 +148,10 @@ ntfServerTest ::
|
||||
(Transport c, Encoding smp) =>
|
||||
TProxy c ->
|
||||
(Maybe TransmissionAuth, ByteString, ByteString, smp) ->
|
||||
IO (Maybe TransmissionAuth, ByteString, ByteString, BrokerMsg)
|
||||
IO (Maybe TransmissionAuth, ByteString, ByteString, NtfResponse)
|
||||
ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
|
||||
where
|
||||
tPut' :: THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
|
||||
tPut' :: THandleNTF c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
|
||||
tPut' h@THandle {params = THandleParams {sessionId, implySessId}} (sig, corrId, queueId, smp) = do
|
||||
let t' = if implySessId then smpEncode (corrId, queueId, smp) else smpEncode (sessionId, corrId, queueId, smp)
|
||||
[Right ()] <- tPut h [Right (sig, t')]
|
||||
@@ -159,7 +160,7 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
|
||||
[(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
|
||||
pure (Nothing, corrId, qId, cmd)
|
||||
|
||||
ntfTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
|
||||
ntfTest :: Transport c => TProxy c -> (THandleNTF c -> IO ()) -> Expectation
|
||||
ntfTest _ test' = runNtfTest test' `shouldReturn` ()
|
||||
|
||||
data APNSMockRequest = APNSMockRequest
|
||||
|
||||
+13
-8
@@ -5,7 +5,9 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module NtfServerTests where
|
||||
|
||||
@@ -37,6 +39,7 @@ import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Notifications.Protocol
|
||||
import Simplex.Messaging.Notifications.Server.Push.APNS
|
||||
import qualified Simplex.Messaging.Notifications.Server.Push.APNS as APNS
|
||||
import Simplex.Messaging.Notifications.Transport (THandleNTF)
|
||||
import Simplex.Messaging.Parsers (parse, parseAll)
|
||||
import Simplex.Messaging.Protocol hiding (notification)
|
||||
import Simplex.Messaging.Transport
|
||||
@@ -50,30 +53,32 @@ ntfServerTests t = do
|
||||
|
||||
ntfSyntaxTests :: ATransport -> Spec
|
||||
ntfSyntaxTests (ATransport t) = do
|
||||
it "unknown command" $ ("", "abcd", "1234", ('H', 'E', 'L', 'L', 'O')) >#> ("", "abcd", "1234", ERR $ CMD UNKNOWN)
|
||||
it "unknown command" $ ("", "abcd", "1234", ('H', 'E', 'L', 'L', 'O')) >#> ("", "abcd", "1234", NRErr $ CMD UNKNOWN)
|
||||
describe "NEW" $ do
|
||||
it "no parameters" $ (sampleSig, "bcda", "", TNEW_) >#> ("", "bcda", "", ERR $ CMD SYNTAX)
|
||||
it "many parameters" $ (sampleSig, "cdab", "", (TNEW_, (' ', '\x01', 'A'), ('T', 'A', 'T', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "cdab", "", ERR $ CMD SYNTAX)
|
||||
it "no signature" $ ("", "dabc", "", (TNEW_, ' ', ('T', 'A', 'T', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
|
||||
it "token ID" $ (sampleSig, "abcd", "12345678", (TNEW_, ' ', ('T', 'A', 'T', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
|
||||
it "no parameters" $ (sampleSig, "bcda", "", TNEW_) >#> ("", "bcda", "", NRErr $ CMD SYNTAX)
|
||||
it "many parameters" $ (sampleSig, "cdab", "", (TNEW_, (' ', '\x01', 'A'), ('T', 'A', 'T', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "cdab", "", NRErr $ CMD SYNTAX)
|
||||
it "no signature" $ ("", "dabc", "", (TNEW_, ' ', ('T', 'A', 'T', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "dabc", "", NRErr $ CMD NO_AUTH)
|
||||
it "token ID" $ (sampleSig, "abcd", "12345678", (TNEW_, ' ', ('T', 'A', 'T', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "abcd", "12345678", NRErr $ CMD HAS_AUTH)
|
||||
where
|
||||
(>#>) ::
|
||||
Encoding smp =>
|
||||
(Maybe TransmissionAuth, ByteString, ByteString, smp) ->
|
||||
(Maybe TransmissionAuth, ByteString, ByteString, BrokerMsg) ->
|
||||
(Maybe TransmissionAuth, ByteString, ByteString, NtfResponse) ->
|
||||
Expectation
|
||||
command >#> response = withAPNSMockServer $ \_ -> ntfServerTest t command `shouldReturn` response
|
||||
|
||||
pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> SignedTransmission ErrorType NtfResponse
|
||||
pattern RespNtf corrId queueId command <- (_, _, (corrId, queueId, Right command))
|
||||
|
||||
sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
|
||||
deriving instance Eq NtfResponse
|
||||
|
||||
sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c -> (Maybe TransmissionAuth, ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
|
||||
sendRecvNtf h@THandle {params} (sgn, corrId, qId, cmd) = do
|
||||
let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
|
||||
Right () <- tPut1 h (sgn, tToSend)
|
||||
tGet1 h
|
||||
|
||||
signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandle c -> C.APrivateAuthKey -> (ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
|
||||
signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c -> C.APrivateAuthKey -> (ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
|
||||
signSendRecvNtf h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
|
||||
let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
|
||||
Right () <- tPut1 h (authorize tForAuth, tToSend)
|
||||
|
||||
+18
-18
@@ -26,7 +26,7 @@ import Simplex.Messaging.Server.Env.STM
|
||||
import Simplex.Messaging.Transport
|
||||
import Simplex.Messaging.Transport.Client
|
||||
import Simplex.Messaging.Transport.Server
|
||||
import Simplex.Messaging.Version (VersionRange, mkVersionRange)
|
||||
import Simplex.Messaging.Version (mkVersionRange)
|
||||
import System.Environment (lookupEnv)
|
||||
import System.Info (os)
|
||||
import Test.Hspec
|
||||
@@ -68,10 +68,10 @@ xit'' d t = do
|
||||
ci <- runIO $ lookupEnv "CI"
|
||||
(if ci == Just "true" then skip "skipped on CI" . it d else it d) t
|
||||
|
||||
testSMPClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
|
||||
testSMPClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandleSMP c -> m a) -> m a
|
||||
testSMPClient = testSMPClientVR supportedClientSMPRelayVRange
|
||||
|
||||
testSMPClientVR :: (Transport c, MonadUnliftIO m, MonadFail m) => VersionRange -> (THandle c -> m a) -> m a
|
||||
testSMPClientVR :: (Transport c, MonadUnliftIO m, MonadFail m) => VersionRangeSMP -> (THandleSMP c -> m a) -> m a
|
||||
testSMPClientVR vr client = do
|
||||
Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
|
||||
runTransportClient defaultTransportClientConfig Nothing useHost testPort (Just testKeyHash) $ \h -> do
|
||||
@@ -110,7 +110,7 @@ cfg =
|
||||
}
|
||||
|
||||
cfgV7 :: ServerConfig
|
||||
cfgV7 = cfg {smpServerVRange = mkVersionRange 4 authCmdsSMPVersion}
|
||||
cfgV7 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}
|
||||
|
||||
withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
|
||||
withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
|
||||
@@ -149,16 +149,16 @@ withSmpServer t = withSmpServerOn t testPort
|
||||
withSmpServerV7 :: HasCallStack => ATransport -> IO a -> IO a
|
||||
withSmpServerV7 t = withSmpServerConfigOn t cfgV7 testPort . const
|
||||
|
||||
runSmpTest :: forall c a. (HasCallStack, Transport c) => (HasCallStack => THandle c -> IO a) -> IO a
|
||||
runSmpTest :: forall c a. (HasCallStack, Transport c) => (HasCallStack => THandleSMP c -> IO a) -> IO a
|
||||
runSmpTest test = withSmpServer (transport @c) $ testSMPClient test
|
||||
|
||||
runSmpTestN :: forall c a. (HasCallStack, Transport c) => Int -> (HasCallStack => [THandle c] -> IO a) -> IO a
|
||||
runSmpTestN :: forall c a. (HasCallStack, Transport c) => Int -> (HasCallStack => [THandleSMP c] -> IO a) -> IO a
|
||||
runSmpTestN = runSmpTestNCfg cfg supportedClientSMPRelayVRange
|
||||
|
||||
runSmpTestNCfg :: forall c a. (HasCallStack, Transport c) => ServerConfig -> VersionRange -> Int -> (HasCallStack => [THandle c] -> IO a) -> IO a
|
||||
runSmpTestNCfg :: forall c a. (HasCallStack, Transport c) => ServerConfig -> VersionRangeSMP -> Int -> (HasCallStack => [THandleSMP c] -> IO a) -> IO a
|
||||
runSmpTestNCfg srvCfg clntVR nClients test = withSmpServerConfigOn (transport @c) srvCfg testPort $ \_ -> run nClients []
|
||||
where
|
||||
run :: Int -> [THandle c] -> IO a
|
||||
run :: Int -> [THandleSMP c] -> IO a
|
||||
run 0 hs = test hs
|
||||
run n hs = testSMPClientVR clntVR $ \h -> run (n - 1) (h : hs)
|
||||
|
||||
@@ -170,7 +170,7 @@ smpServerTest ::
|
||||
IO (Maybe TransmissionAuth, ByteString, ByteString, BrokerMsg)
|
||||
smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
|
||||
where
|
||||
tPut' :: THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
|
||||
tPut' :: THandleSMP c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
|
||||
tPut' h@THandle {params = THandleParams {sessionId, implySessId}} (sig, corrId, queueId, smp) = do
|
||||
let t' = if implySessId then smpEncode (corrId, queueId, smp) else smpEncode (sessionId, corrId, queueId, smp)
|
||||
[Right ()] <- tPut h [Right (sig, t')]
|
||||
@@ -179,33 +179,33 @@ smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
|
||||
[(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
|
||||
pure (Nothing, corrId, qId, cmd)
|
||||
|
||||
smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> IO ()) -> Expectation
|
||||
smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c -> IO ()) -> Expectation
|
||||
smpTest _ test' = runSmpTest test' `shouldReturn` ()
|
||||
|
||||
smpTestN :: (HasCallStack, Transport c) => Int -> (HasCallStack => [THandle c] -> IO ()) -> Expectation
|
||||
smpTestN :: (HasCallStack, Transport c) => Int -> (HasCallStack => [THandleSMP c] -> IO ()) -> Expectation
|
||||
smpTestN n test' = runSmpTestN n test' `shouldReturn` ()
|
||||
|
||||
smpTest2 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> THandle c -> IO ()) -> Expectation
|
||||
smpTest2 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c -> THandleSMP c -> IO ()) -> Expectation
|
||||
smpTest2 = smpTest2Cfg cfg supportedClientSMPRelayVRange
|
||||
|
||||
smpTest2Cfg :: forall c. (HasCallStack, Transport c) => ServerConfig -> VersionRange -> TProxy c -> (HasCallStack => THandle c -> THandle c -> IO ()) -> Expectation
|
||||
smpTest2Cfg :: forall c. (HasCallStack, Transport c) => ServerConfig -> VersionRangeSMP -> TProxy c -> (HasCallStack => THandleSMP c -> THandleSMP c -> IO ()) -> Expectation
|
||||
smpTest2Cfg srvCfg clntVR _ test' = runSmpTestNCfg srvCfg clntVR 2 _test `shouldReturn` ()
|
||||
where
|
||||
_test :: HasCallStack => [THandle c] -> IO ()
|
||||
_test :: HasCallStack => [THandleSMP c] -> IO ()
|
||||
_test [h1, h2] = test' h1 h2
|
||||
_test _ = error "expected 2 handles"
|
||||
|
||||
smpTest3 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> THandle c -> THandle c -> IO ()) -> Expectation
|
||||
smpTest3 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c -> THandleSMP c -> THandleSMP c -> IO ()) -> Expectation
|
||||
smpTest3 _ test' = smpTestN 3 _test
|
||||
where
|
||||
_test :: HasCallStack => [THandle c] -> IO ()
|
||||
_test :: HasCallStack => [THandleSMP c] -> IO ()
|
||||
_test [h1, h2, h3] = test' h1 h2 h3
|
||||
_test _ = error "expected 3 handles"
|
||||
|
||||
smpTest4 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> THandle c -> THandle c -> THandle c -> IO ()) -> Expectation
|
||||
smpTest4 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c -> THandleSMP c -> THandleSMP c -> THandleSMP c -> IO ()) -> Expectation
|
||||
smpTest4 _ test' = smpTestN 4 _test
|
||||
where
|
||||
_test :: HasCallStack => [THandle c] -> IO ()
|
||||
_test :: HasCallStack => [THandleSMP c] -> IO ()
|
||||
_test [h1, h2, h3, h4] = test' h1 h2 h3 h4
|
||||
_test _ = error "expected 4 handles"
|
||||
|
||||
|
||||
+21
-20
@@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
@@ -77,13 +78,13 @@ pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh)
|
||||
pattern Msg :: MsgId -> MsgBody -> BrokerMsg
|
||||
pattern Msg msgId body <- MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body}
|
||||
|
||||
sendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
|
||||
sendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c -> (Maybe TransmissionAuth, ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
|
||||
sendRecv h@THandle {params} (sgn, corrId, qId, cmd) = do
|
||||
let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
|
||||
Right () <- tPut1 h (sgn, tToSend)
|
||||
tGet1 h
|
||||
|
||||
signSendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> C.APrivateAuthKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
|
||||
signSendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c -> C.APrivateAuthKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
|
||||
signSendRecv h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
|
||||
let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
|
||||
Right () <- tPut1 h (authorize tForAuth, tToSend)
|
||||
@@ -97,12 +98,12 @@ signSendRecv h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
|
||||
_sx448 -> undefined -- ghc8107 fails to the branch excluded by types
|
||||
#endif
|
||||
|
||||
tPut1 :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
|
||||
tPut1 :: Transport c => THandle v c -> SentRawTransmission -> IO (Either TransportError ())
|
||||
tPut1 h t = do
|
||||
[r] <- tPut h [Right t]
|
||||
pure r
|
||||
|
||||
tGet1 :: (ProtocolEncoding err cmd, Transport c, MonadIO m, MonadFail m) => THandle c -> m (SignedTransmission err cmd)
|
||||
tGet1 :: (ProtocolEncoding v err cmd, Transport c, MonadIO m, MonadFail m) => THandle v c -> m (SignedTransmission err cmd)
|
||||
tGet1 h = do
|
||||
[r] <- liftIO $ tGet h
|
||||
pure r
|
||||
@@ -383,7 +384,7 @@ testSwitchSub (ATransport t) =
|
||||
Resp "bcda" _ ok3 <- signSendRecv rh2 rKey ("bcda", rId, ACK mId3)
|
||||
(ok3, OK) #== "accepts ACK from the 2nd TCP connection"
|
||||
|
||||
1000 `timeout` tGet @ErrorType @BrokerMsg rh1 >>= \case
|
||||
1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh1 >>= \case
|
||||
Nothing -> return ()
|
||||
Just _ -> error "nothing else is delivered to the 1st TCP connection"
|
||||
|
||||
@@ -554,12 +555,12 @@ testWithStoreLog at@(ATransport t) =
|
||||
logSize testStoreLogFile `shouldReturn` 1
|
||||
removeFile testStoreLogFile
|
||||
where
|
||||
runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
|
||||
runTest :: Transport c => TProxy c -> (THandleSMP c -> IO ()) -> ThreadId -> Expectation
|
||||
runTest _ test' server = do
|
||||
testSMPClient test' `shouldReturn` ()
|
||||
killThread server
|
||||
|
||||
runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
|
||||
runClient :: Transport c => TProxy c -> (THandleSMP c -> IO ()) -> Expectation
|
||||
runClient _ test' = testSMPClient test' `shouldReturn` ()
|
||||
|
||||
logSize :: FilePath -> IO Int
|
||||
@@ -652,12 +653,12 @@ testRestoreMessages at@(ATransport t) =
|
||||
removeFile testStoreMsgsFile
|
||||
removeFile testServerStatsBackupFile
|
||||
where
|
||||
runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
|
||||
runTest :: Transport c => TProxy c -> (THandleSMP c -> IO ()) -> ThreadId -> Expectation
|
||||
runTest _ test' server = do
|
||||
testSMPClient test' `shouldReturn` ()
|
||||
killThread server
|
||||
|
||||
runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
|
||||
runClient :: Transport c => TProxy c -> (THandleSMP c -> IO ()) -> Expectation
|
||||
runClient _ test' = testSMPClient test' `shouldReturn` ()
|
||||
|
||||
checkStats :: ServerStatsData -> [RecipientId] -> Int -> Int -> Expectation
|
||||
@@ -726,15 +727,15 @@ testRestoreExpireMessages at@(ATransport t) =
|
||||
Right ServerStatsData {_msgExpired} <- strDecode <$> B.readFile testServerStatsBackupFile
|
||||
_msgExpired `shouldBe` 2
|
||||
where
|
||||
runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
|
||||
runTest :: Transport c => TProxy c -> (THandleSMP c -> IO ()) -> ThreadId -> Expectation
|
||||
runTest _ test' server = do
|
||||
testSMPClient test' `shouldReturn` ()
|
||||
killThread server
|
||||
|
||||
runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
|
||||
runClient :: Transport c => TProxy c -> (THandleSMP c -> IO ()) -> Expectation
|
||||
runClient _ test' = testSMPClient test' `shouldReturn` ()
|
||||
|
||||
createAndSecureQueue :: Transport c => THandle c -> SndPublicAuthKey -> IO (SenderId, RecipientId, RcvPrivateAuthKey, RcvDhSecret)
|
||||
createAndSecureQueue :: Transport c => THandleSMP c -> SndPublicAuthKey -> IO (SenderId, RecipientId, RcvPrivateAuthKey, RcvDhSecret)
|
||||
createAndSecureQueue h sPub = do
|
||||
g <- C.newRandom
|
||||
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
|
||||
@@ -750,7 +751,7 @@ testTiming (ATransport t) =
|
||||
describe "should have similar time for auth error, whether queue exists or not, for all key types" $
|
||||
forM_ timingTests $ \tst ->
|
||||
it (testName tst) $
|
||||
smpTest2Cfg cfgV7 (mkVersionRange 4 authCmdsSMPVersion) t $ \rh sh ->
|
||||
smpTest2Cfg cfgV7 (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh ->
|
||||
testSameTiming rh sh tst
|
||||
where
|
||||
testName :: (C.AuthAlg, C.AuthAlg, Int) -> String
|
||||
@@ -769,7 +770,7 @@ testTiming (ATransport t) =
|
||||
]
|
||||
timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
|
||||
similarTime t1 t2 = abs (t2 / t1 - 1) < 0.15 -- normally the difference between "no queue" and "wrong key" is less than 5%
|
||||
testSameTiming :: forall c. Transport c => THandle c -> THandle c -> (C.AuthAlg, C.AuthAlg, Int) -> Expectation
|
||||
testSameTiming :: forall c. Transport c => THandleSMP c -> THandleSMP c -> (C.AuthAlg, C.AuthAlg, Int) -> Expectation
|
||||
testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) = do
|
||||
g <- C.newRandom
|
||||
(rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
|
||||
@@ -790,7 +791,7 @@ testTiming (ATransport t) =
|
||||
|
||||
runTimingTest sh badKey sId $ _SEND "hello"
|
||||
where
|
||||
runTimingTest :: PartyI p => THandle c -> C.APrivateAuthKey -> ByteString -> Command p -> IO ()
|
||||
runTimingTest :: PartyI p => THandleSMP c -> C.APrivateAuthKey -> ByteString -> Command p -> IO ()
|
||||
runTimingTest h badKey qId cmd = do
|
||||
threadDelay 100000
|
||||
_ <- timeRepeat n $ do -- "warm up" the server
|
||||
@@ -840,14 +841,14 @@ testMessageNotifications (ATransport t) =
|
||||
Resp "5a" _ OK <- signSendRecv rh rKey ("5a", rId, ACK mId2)
|
||||
(dec mId2 msg2, Right "hello again") #== "delivered from queue again"
|
||||
Resp "" _ (NMSG _ _) <- tGet1 nh2
|
||||
1000 `timeout` tGet @ErrorType @BrokerMsg nh1 >>= \case
|
||||
1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg nh1 >>= \case
|
||||
Nothing -> pure ()
|
||||
Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"
|
||||
Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, NDEL)
|
||||
Resp "7" _ OK <- signSendRecv sh sKey ("7", sId, _SEND' "hello there")
|
||||
Resp "" _ (Msg mId3 msg3) <- tGet1 rh
|
||||
(dec mId3 msg3, Right "hello there") #== "delivered from queue again"
|
||||
1000 `timeout` tGet @ErrorType @BrokerMsg nh2 >>= \case
|
||||
1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg nh2 >>= \case
|
||||
Nothing -> pure ()
|
||||
Just _ -> error "nothing else should be delivered to the 2nd notifier's TCP connection"
|
||||
|
||||
@@ -867,7 +868,7 @@ testMsgExpireOnSend t =
|
||||
testSMPClient @c $ \rh -> do
|
||||
Resp "3" _ (Msg mId msg) <- signSendRecv rh rKey ("3", rId, SUB)
|
||||
(dec mId msg, Right "hello (should NOT expire)") #== "delivered"
|
||||
1000 `timeout` tGet @ErrorType @BrokerMsg rh >>= \case
|
||||
1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh >>= \case
|
||||
Nothing -> return ()
|
||||
Just _ -> error "nothing else should be delivered"
|
||||
|
||||
@@ -887,7 +888,7 @@ testMsgExpireOnInterval t =
|
||||
signSendRecv rh rKey ("2", rId, SUB) >>= \case
|
||||
Resp "2" _ OK -> pure ()
|
||||
r -> unexpected r
|
||||
1000 `timeout` tGet @ErrorType @BrokerMsg rh >>= \case
|
||||
1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh >>= \case
|
||||
Nothing -> return ()
|
||||
Just _ -> error "nothing should be delivered"
|
||||
|
||||
@@ -906,7 +907,7 @@ testMsgNOTExpireOnInterval t =
|
||||
testSMPClient @c $ \rh -> do
|
||||
Resp "2" _ (Msg mId msg) <- signSendRecv rh rKey ("2", rId, SUB)
|
||||
(dec mId msg, Right "hello (should NOT expire)") #== "delivered"
|
||||
1000 `timeout` tGet @ErrorType @BrokerMsg rh >>= \case
|
||||
1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh >>= \case
|
||||
Nothing -> return ()
|
||||
Just _ -> error "nothing else should be delivered"
|
||||
|
||||
|
||||
+2
-1
@@ -21,7 +21,8 @@ import Data.List (find, isSuffixOf)
|
||||
import Data.Maybe (fromJust)
|
||||
import SMPAgentClient (agentCfg, initAgentServers, testDB, testDB2, testDB3)
|
||||
import Simplex.FileTransfer.Description (FileDescription (..), FileDescriptionURI (..), ValidFileDescription, fileDescriptionURI, mb, qrSizeLimit, pattern ValidFileDescription)
|
||||
import Simplex.FileTransfer.Protocol (FileParty (..), XFTPErrorType (AUTH))
|
||||
import Simplex.FileTransfer.Protocol (FileParty (..))
|
||||
import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH))
|
||||
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
|
||||
import Simplex.Messaging.Agent (AgentClient, disconnectAgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpSendFile, xftpStartWorkers)
|
||||
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
|
||||
|
||||
@@ -20,9 +20,9 @@ import Data.List (isInfixOf)
|
||||
import ServerTests (logSize)
|
||||
import Simplex.FileTransfer.Client
|
||||
import Simplex.FileTransfer.Description (kb)
|
||||
import Simplex.FileTransfer.Protocol (FileInfo (..), XFTPErrorType (..))
|
||||
import Simplex.FileTransfer.Protocol (FileInfo (..))
|
||||
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
|
||||
import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..))
|
||||
import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..), XFTPErrorType (..))
|
||||
import Simplex.Messaging.Client (ProtocolClientError (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import qualified Simplex.Messaging.Crypto.Lazy as LC
|
||||
|
||||
Reference in New Issue
Block a user