diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 4cc48b2dc..98fe0bbc2 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -52,7 +52,7 @@ module Simplex.Messaging.Agent.Client logServer, removeSubscription, hasActiveSubscription, - agentStore, + agentClientStore, AgentOperation (..), AgentOpState (..), AgentState (..), @@ -235,8 +235,8 @@ newAgentClient InitialAgentServers {smp, ntf, netCfg} agentEnv = do lock <- newTMVar () return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, useNetworkConfig, subscrConns, activeSubs, pendingSubs, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, connCmdsQueued, asyncCmdQueues, asyncCmdProcesses, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, reconnections, asyncClients, clientId, agentEnv, lock} -agentStore :: AgentClient -> SQLiteStore -agentStore AgentClient {agentEnv = Env {store}} = store +agentClientStore :: AgentClient -> SQLiteStore +agentClientStore AgentClient {agentEnv = Env {store}} = store class ProtocolServerClient msg where getProtocolServerClient :: AgentMonad m => AgentClient -> ProtoServer msg -> m (ProtocolClient msg) diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 9004a2bd9..945a3254f 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RankNTypes #-} @@ -12,6 +13,8 @@ module Simplex.Messaging.Agent.Env.SQLite ( AgentMonad, AgentConfig (..), + AgentDatabase (..), + databaseFile, InitialAgentServers (..), NetworkConfig (..), defaultAgentConfig, @@ -60,13 +63,21 @@ data InitialAgentServers = InitialAgentServers netCfg :: NetworkConfig } +data AgentDatabase + = AgentDB SQLiteStore + | AgentDBFile {dbFile :: FilePath, dbKey :: String} + +databaseFile :: AgentDatabase -> FilePath +databaseFile = \case + AgentDB (SQLiteStore {dbFilePath}) -> dbFilePath + AgentDBFile {dbFile} -> dbFile + data AgentConfig = AgentConfig { tcpPort :: ServiceName, cmdSignAlg :: C.SignAlg, connIdBytes :: Int, tbqSize :: Natural, - dbFile :: FilePath, - dbKey :: String, + database :: AgentDatabase, yesToMigrations :: Bool, smpCfg :: ProtocolClientConfig, ntfCfg :: ProtocolClientConfig, @@ -109,8 +120,7 @@ defaultAgentConfig = cmdSignAlg = C.SignAlg C.SEd448, connIdBytes = 12, tbqSize = 64, - dbFile = "smp-agent.db", - dbKey = "", + database = AgentDBFile {dbFile = "smp-agent.db", dbKey = ""}, yesToMigrations = False, smpCfg = defaultClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)}, ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)}, @@ -142,9 +152,11 @@ data Env = Env } newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env -newSMPAgentEnv config@AgentConfig {dbFile, dbKey, yesToMigrations} = do +newSMPAgentEnv config@AgentConfig {database, yesToMigrations} = do idsDrg <- newTVarIO =<< drgNew - store <- liftIO $ createAgentStore dbFile dbKey yesToMigrations + store <- case database of + AgentDB st -> pure st + AgentDBFile {dbFile, dbKey} -> liftIO $ createAgentStore dbFile dbKey yesToMigrations clientCounter <- newTVarIO 0 randomServer <- newTVarIO =<< liftIO newStdGen ntfSupervisor <- atomically . newNtfSubSupervisor $ tbqSize config diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 1ad5a0ba5..6e9399db9 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -22,6 +22,7 @@ import qualified Data.ByteString.Char8 as B import Network.HTTP.Types (urlEncode) import SMPAgentClient import SMPClient (testKeyHash, testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn) +import Simplex.Messaging.Agent.Env.SQLite (AgentDatabase, databaseFile) import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Agent.Protocol as A import Simplex.Messaging.Encoding.String @@ -343,14 +344,14 @@ testServerConnectionAfterError t _ = do bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False removeFile testStoreLogFile - removeFile testDB - removeFile testDB2 + removeFile $ databaseFile testDB + removeFile $ databaseFile testDB2 where server = SMPServer "localhost" testPort2 testKeyHash withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` () withAgent1 = withAgent agentTestPort testDB withAgent2 = withAgent agentTestPort2 testDB2 - withAgent :: String -> String -> (c -> IO a) -> IO a + withAgent :: String -> AgentDatabase -> (c -> IO a) -> IO a withAgent agentPort agentDB = withSmpAgentThreadOn_ (ATransport t) (agentPort, testPort2, agentDB) (pure ()) . const . testSMPAgentClientOn agentPort testMsgDeliveryAgentRestart :: Transport c => TProxy c -> c -> IO () @@ -383,7 +384,7 @@ testMsgDeliveryAgentRestart t bob = do bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK) removeFile testStoreLogFile - removeFile testDB + removeFile $ databaseFile testDB where withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` () withAgent = withSmpAgentThreadOn_ (ATransport t) (agentTestPort, testPort, testDB) (pure ()) . const . testSMPAgentClientOn agentTestPort diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index cf42e9dc8..b21c00493 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -123,49 +123,49 @@ functionalAPITests t = do testAgentClient :: IO () testAgentClient = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers runAgentClientTest alice bob 3 testAgentClientV1toV1 :: IO () testAgentClientV1toV1 = do alice <- getSMPAgentClient agentCfgV1 initAgentServers - bob <- getSMPAgentClient agentCfgV1 {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfgV1 {database = testDB2} initAgentServers runAgentClientTest alice bob 4 testAgentClientV1toV2 :: IO () testAgentClientV1toV2 = do alice <- getSMPAgentClient agentCfgV1 initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers runAgentClientTest alice bob 4 testAgentClientV2toV1 :: IO () testAgentClientV2toV1 = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfgV1 {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfgV1 {database = testDB2} initAgentServers runAgentClientTest alice bob 4 testAgentClientContact :: IO () testAgentClientContact = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers runAgentClientContactTest alice bob 3 testAgentClientContactV1toV1 :: IO () testAgentClientContactV1toV1 = do alice <- getSMPAgentClient agentCfgV1 initAgentServers - bob <- getSMPAgentClient agentCfgV1 {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfgV1 {database = testDB2} initAgentServers runAgentClientContactTest alice bob 4 testAgentClientContactV1toV2 :: IO () testAgentClientContactV1toV2 = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfgV1 {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfgV1 {database = testDB2} initAgentServers runAgentClientContactTest alice bob 4 testAgentClientContactV2toV1 :: IO () testAgentClientContactV2toV1 = do alice <- getSMPAgentClient agentCfgV1 initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers runAgentClientContactTest alice bob 4 runAgentClientTest :: AgentClient -> AgentClient -> AgentMsgId -> IO () @@ -253,7 +253,7 @@ noMessages c err = tryGet `shouldReturn` () testAsyncInitiatingOffline :: IO () testAsyncInitiatingOffline = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do (bobId, cReq) <- createConnection alice True SCMInvitation disconnectAgentClient alice @@ -271,14 +271,14 @@ testAsyncInitiatingOffline = do testAsyncJoiningOfflineBeforeActivation :: IO () testAsyncJoiningOfflineBeforeActivation = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do (bobId, qInfo) <- createConnection alice True SCMInvitation aliceId <- joinConnection bob True qInfo "bob's connInfo" disconnectAgentClient bob ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" - bob' <- liftIO $ getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob' <- liftIO $ getSMPAgentClient agentCfg {database = testDB2} initAgentServers subscribeConnection bob' aliceId get alice ##> ("", bobId, CON) get bob' ##> ("", aliceId, INFO "alice's connInfo") @@ -289,7 +289,7 @@ testAsyncJoiningOfflineBeforeActivation = do testAsyncBothOffline :: IO () testAsyncBothOffline = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do (bobId, cReq) <- createConnection alice True SCMInvitation disconnectAgentClient alice @@ -299,7 +299,7 @@ testAsyncBothOffline = do subscribeConnection alice' bobId ("", _, CONF confId _ "bob's connInfo") <- get alice' allowConnection alice' bobId confId "alice's connInfo" - bob' <- liftIO $ getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob' <- liftIO $ getSMPAgentClient agentCfg {database = testDB2} initAgentServers subscribeConnection bob' aliceId get alice' ##> ("", bobId, CON) get bob' ##> ("", aliceId, INFO "alice's connInfo") @@ -310,7 +310,7 @@ testAsyncBothOffline = do testAsyncServerOffline :: ATransport -> IO () testAsyncServerOffline t = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers -- create connection and shutdown the server Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ -> runExceptT $ createConnection alice True SCMInvitation @@ -338,7 +338,7 @@ testAsyncHelloTimeout :: IO () testAsyncHelloTimeout = do -- this test would only work if any of the agent is v1, there is no HELLO timeout in v2 alice <- getSMPAgentClient agentCfgV1 initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2, helloTimeout = 1} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2, helloTimeout = 1} initAgentServers Right () <- runExceptT $ do (_, cReq) <- createConnection alice True SCMInvitation disconnectAgentClient alice @@ -349,7 +349,7 @@ testAsyncHelloTimeout = do testDuplicateMessage :: ATransport -> IO () testDuplicateMessage t = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers (aliceId, bobId, bob1) <- withSmpServerStoreMsgLogOn t testPort $ \_ -> do Right (aliceId, bobId) <- runExceptT $ makeConnection alice bob Right () <- runExceptT $ do @@ -359,7 +359,7 @@ testDuplicateMessage t = do disconnectAgentClient bob -- if the agent user did not send ACK, the message will be delivered again - bob1 <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob1 <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do subscribeConnection bob1 aliceId get bob1 =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False @@ -381,7 +381,7 @@ testDuplicateMessage t = do disconnectAgentClient bob1 alice2 <- getSMPAgentClient agentCfg initAgentServers - bob2 <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob2 <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers withSmpServerStoreMsgLogOn t testPort $ \_ -> do Right () <- runExceptT $ do @@ -447,7 +447,7 @@ testActiveClientNotDisconnected t = do testSuspendingAgent :: IO () testSuspendingAgent = do a <- getSMPAgentClient agentCfg initAgentServers - b <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + b <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do (aId, bId) <- makeConnection a b 4 <- sendMessage a bId SMP.noMsgFlags "hello" @@ -466,7 +466,7 @@ testSuspendingAgent = do testSuspendingAgentCompleteSending :: ATransport -> IO () testSuspendingAgentCompleteSending t = do a <- getSMPAgentClient agentCfg initAgentServers - b <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + b <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runExceptT $ do (aId, bId) <- makeConnection a b 4 <- sendMessage a bId SMP.noMsgFlags "hello" @@ -500,7 +500,7 @@ testSuspendingAgentCompleteSending t = do testSuspendingAgentTimeout :: ATransport -> IO () testSuspendingAgentTimeout t = do a <- getSMPAgentClient agentCfg initAgentServers - b <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + b <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (aId, _) <- withSmpServer t . runExceptT $ do (aId, bId) <- makeConnection a b 4 <- sendMessage a bId SMP.noMsgFlags "hello" @@ -523,7 +523,7 @@ testSuspendingAgentTimeout t = do testBatchedSubscriptions :: ATransport -> IO () testBatchedSubscriptions t = do a <- getSMPAgentClient agentCfg initAgentServers2 - b <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers2 + b <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers2 Right conns <- runServers $ do conns <- forM [1 .. 200 :: Int] . const $ makeConnection a b forM_ conns $ \(aId, bId) -> exchangeGreetings a bId b aId @@ -568,7 +568,7 @@ testBatchedSubscriptions t = do testAsyncCommands :: IO () testAsyncCommands = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do bobId <- createConnectionAsync alice "1" True SCMInvitation ("1", bobId', INV (ACR _ qInfo)) <- get alice diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index a8dbd1a17..f9213c252 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -22,7 +22,7 @@ import NtfClient import SMPAgentClient (agentCfg, initAgentServers, testDB, testDB2) import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn) import Simplex.Messaging.Agent -import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..)) +import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), databaseFile) import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String @@ -44,7 +44,7 @@ removeFileIfExists filePath = do notificationTests :: ATransport -> Spec notificationTests t = - after_ (removeFile testDB >> removeFileIfExists testDB2) $ do + after_ (removeFile (databaseFile testDB) >> removeFileIfExists (databaseFile testDB2)) $ do describe "Managing notification tokens" $ do it "should register and verify notification token" $ withAPNSMockServer $ \apns -> @@ -142,7 +142,7 @@ testNtfTokenSecondRegistration APNSMockServer {apnsQ} = do -- setLogLevel LogError -- LogDebug -- withGlobalLogging logCfg $ do a <- getSMPAgentClient agentCfg initAgentServers - a' <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + a' <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do let tkn = DeviceToken PPApnsTest "abcd" NTRegistered <- registerNtfToken a tkn NMPeriodic @@ -207,7 +207,7 @@ testNtfTokenServerRestart t APNSMockServer {apnsQ} = do testNotificationSubscriptionExistingConnection :: APNSMockServer -> IO () testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (bobId, aliceId, nonce, message) <- runExceptT $ do -- establish connection (bobId, qInfo) <- createConnection alice True SCMInvitation @@ -264,7 +264,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} = do testNotificationSubscriptionNewConnection :: APNSMockServer -> IO () testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do -- alice registers notification token _ <- registerTestToken alice "abcd" NMInstant apnsQ @@ -321,7 +321,7 @@ registerTestToken a token mode apnsQ = do testChangeNotificationsMode :: APNSMockServer -> IO () testChangeNotificationsMode APNSMockServer {apnsQ} = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do -- establish connection (bobId, qInfo) <- createConnection alice True SCMInvitation @@ -386,7 +386,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} = do testChangeToken :: APNSMockServer -> IO () testChangeToken APNSMockServer {apnsQ} = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (aliceId, bobId) <- runExceptT $ do -- establish connection (bobId, qInfo) <- createConnection alice True SCMInvitation @@ -430,7 +430,7 @@ testChangeToken APNSMockServer {apnsQ} = do testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO () testNotificationsStoreLog t APNSMockServer {apnsQ} = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runExceptT $ do (aliceId, bobId) <- makeConnection alice bob _ <- registerTestToken alice "abcd" NMInstant apnsQ @@ -457,7 +457,7 @@ testNotificationsStoreLog t APNSMockServer {apnsQ} = do testNotificationsSMPRestart :: ATransport -> APNSMockServer -> IO () testNotificationsSMPRestart t APNSMockServer {apnsQ} = do alice <- getSMPAgentClient agentCfg initAgentServers - bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers + bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \threadId -> runExceptT $ do (aliceId, bobId) <- makeConnection alice bob _ <- registerTestToken alice "abcd" NMInstant apnsQ diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index dbe026271..322c66921 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -48,14 +48,14 @@ agentTestPort2 = "5011" agentTestPort3 :: ServiceName agentTestPort3 = "5012" -testDB :: String -testDB = "tests/tmp/smp-agent.test.protocol.db" +testDB :: AgentDatabase +testDB = AgentDBFile {dbFile = "tests/tmp/smp-agent.test.protocol.db", dbKey = ""} -testDB2 :: String -testDB2 = "tests/tmp/smp-agent2.test.protocol.db" +testDB2 :: AgentDatabase +testDB2 = AgentDBFile {dbFile = "tests/tmp/smp-agent2.test.protocol.db", dbKey = ""} -testDB3 :: String -testDB3 = "tests/tmp/smp-agent3.test.protocol.db" +testDB3 :: AgentDatabase +testDB3 = AgentDBFile {dbFile = "tests/tmp/smp-agent3.test.protocol.db", dbKey = ""} smpAgentTest :: forall c. Transport c => TProxy c -> ARawTransmission -> IO ARawTransmission smpAgentTest _ cmd = runSmpAgentTest $ \(h :: c) -> tPutRaw h cmd >> get h @@ -83,10 +83,10 @@ runSmpAgentServerTest test = smpAgentServerTest :: Transport c => ((ThreadId, ThreadId) -> c -> IO ()) -> Expectation smpAgentServerTest test' = runSmpAgentServerTest test' `shouldReturn` () -runSmpAgentTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => [(ServiceName, ServiceName, String)] -> ([c] -> m a) -> m a +runSmpAgentTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => [(ServiceName, ServiceName, AgentDatabase)] -> ([c] -> m a) -> m a runSmpAgentTestN agents test = withSmpServer t $ run agents [] where - run :: [(ServiceName, ServiceName, String)] -> [c] -> m a + run :: [(ServiceName, ServiceName, AgentDatabase)] -> [c] -> m a run [] hs = test hs run (a@(p, _, _) : as) hs = withSmpAgentOn t a $ testSMPAgentClientOn p $ \h -> run as (h : hs) t = transport @c @@ -99,7 +99,7 @@ runSmpAgentTestN_1 nClients test = withSmpServer t . withSmpAgent t $ run nClien run n hs = testSMPAgentClient $ \h -> run (n - 1) (h : hs) t = transport @c -smpAgentTestN :: Transport c => [(ServiceName, ServiceName, String)] -> ([c] -> IO ()) -> Expectation +smpAgentTestN :: Transport c => [(ServiceName, ServiceName, AgentDatabase)] -> ([c] -> IO ()) -> Expectation smpAgentTestN agents test' = runSmpAgentTestN agents test' `shouldReturn` () smpAgentTestN_1 :: Transport c => Int -> ([c] -> IO ()) -> Expectation @@ -187,7 +187,7 @@ agentCfg = defaultAgentConfig { tcpPort = agentTestPort, tbqSize = 4, - dbFile = testDB, + database = testDB, smpCfg = defaultClientConfig { qSize = 1, @@ -207,18 +207,18 @@ agentCfg = certificateFile = "tests/fixtures/server.crt" } -withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a +withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, AgentDatabase) -> m () -> (ThreadId -> m a) -> m a withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess = - let cfg' = agentCfg {tcpPort = port', dbFile = db'} + let cfg' = agentCfg {tcpPort = port', database = db'} initServers' = initAgentServers {smp = L.fromList [SMPServer "localhost" smpPort' testKeyHash]} in serverBracket (\started -> runSMPAgentBlocking t started cfg' initServers') afterProcess -withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> (ThreadId -> m a) -> m a -withSmpAgentThreadOn t a@(_, _, db') = withSmpAgentThreadOn_ t a $ removeFile db' +withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, AgentDatabase) -> (ThreadId -> m a) -> m a +withSmpAgentThreadOn t a@(_, _, db') = withSmpAgentThreadOn_ t a $ removeFile (dbFile db') -withSmpAgentOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m a -> m a +withSmpAgentOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, AgentDatabase) -> m a -> m a withSmpAgentOn t (port', smpPort', db') = withSmpAgentThreadOn t (port', smpPort', db') . const withSmpAgent :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a