diff --git a/package.yaml b/package.yaml index 58270289d..ea587f3b6 100644 --- a/package.yaml +++ b/package.yaml @@ -60,6 +60,7 @@ tests: - hspec == 2.7.* - hspec-core == 2.7.* - HUnit == 1.6.* + - random == 1.1.* ghc-options: # - -haddock diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 8c608447e..2a2d6a275 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -49,7 +49,8 @@ addRcvQueueQuery = |] data SQLiteStore = SQLiteStore - { conn :: DB.Connection, + { dbFilename :: String, + conn :: DB.Connection, serversLock :: TMVar (), rcvQueuesLock :: TMVar (), sndQueuesLock :: TMVar (), @@ -58,8 +59,8 @@ data SQLiteStore = SQLiteStore } newSQLiteStore :: MonadUnliftIO m => String -> m SQLiteStore -newSQLiteStore dbFile = do - conn <- liftIO $ DB.open dbFile +newSQLiteStore dbFilename = do + conn <- liftIO $ DB.open dbFilename liftIO $ createSchema conn serversLock <- newTMVarIO () rcvQueuesLock <- newTMVarIO () @@ -68,7 +69,8 @@ newSQLiteStore dbFile = do messagesLock <- newTMVarIO () return SQLiteStore - { conn, + { dbFilename, + conn, serversLock, rcvQueuesLock, sndQueuesLock, diff --git a/tests/AgentTests/SQLite.hs b/tests/AgentTests/SQLite.hs index 22cbd22dd..ed146dbdd 100644 --- a/tests/AgentTests/SQLite.hs +++ b/tests/AgentTests/SQLite.hs @@ -5,11 +5,13 @@ module AgentTests.SQLite where import Control.Monad.Except +import Data.Word (Word32) import qualified Database.SQLite.Simple as DB import Simplex.Messaging.Agent.Store import Simplex.Messaging.Agent.Store.SQLite import Simplex.Messaging.Agent.Store.Types import Simplex.Messaging.Agent.Transmission +import System.Random import Test.Hspec import UnliftIO.Directory @@ -17,9 +19,19 @@ testDB :: String testDB = "smp-agent.test.db" withStore :: SpecWith SQLiteStore -> Spec -withStore = - before (newSQLiteStore testDB) - . after (\store -> DB.close (conn store) >> removeFile testDB) +withStore = before createStore . after removeStore + where + createStore :: IO SQLiteStore + createStore = do + -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous + -- IO operations on multiple similarly named files; error specific to some environments + r <- randomIO :: IO Word32 + newSQLiteStore $ testDB <> show r + + removeStore :: SQLiteStore -> IO () + removeStore store = do + DB.close $ conn store + removeFile $ dbFilename store returnsResult :: (Eq a, Eq e, Show a, Show e) => ExceptT e IO a -> a -> Expectation action `returnsResult` r = runExceptT action `shouldReturn` Right r diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index d3f0071f3..9fd3536ff 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} module SMPAgentClient where @@ -56,7 +57,7 @@ withSmpAgent = testSMPAgentClient :: MonadUnliftIO m => (Handle -> m a) -> m a testSMPAgentClient client = do - threadDelay 25000 -- TODO hack: thread delay for SMP agent to start + threadDelay 100_000 -- TODO hack: thread delay for SMP agent to start runTCPClient agentTestHost agentTestPort $ \h -> do line <- getLn h if line == "Welcome to SMP v0.2.0 agent"