Skip to content

Commit c3d7bd0

Browse files
spaced4ndyspaced4ndy
committed
tests wip
1 parent 909ccf4 commit c3d7bd0

File tree

6 files changed

+135
-62
lines changed

6 files changed

+135
-62
lines changed

‎simplexmq.cabal‎

Lines changed: 36 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -403,44 +403,46 @@ test-suite simplexmq-test
403403
type: exitcode-stdio-1.0
404404
main-is: Test.hs
405405
other-modules:
406-
AgentTests
407-
AgentTests.ConnectionRequestTests
408-
AgentTests.DoubleRatchetTests
409-
AgentTests.EqInstances
410-
AgentTests.FunctionalAPITests
406+
-- AgentTests
407+
-- AgentTests.ConnectionRequestTests
408+
-- AgentTests.DoubleRatchetTests
409+
-- AgentTests.EqInstances
410+
-- AgentTests.FunctionalAPITests
411411
AgentTests.MigrationTests
412-
AgentTests.NotificationTests
413-
AgentTests.SchemaDump
414-
AgentTests.ServerChoice
415-
AgentTests.SQLiteTests
416-
CLITests
417-
CoreTests.BatchingTests
418-
CoreTests.CryptoFileTests
419-
CoreTests.CryptoTests
420-
CoreTests.EncodingTests
421-
CoreTests.MsgStoreTests
422-
CoreTests.RetryIntervalTests
423-
CoreTests.SOCKSSettings
424-
CoreTests.StoreLogTests
425-
CoreTests.TRcvQueuesTests
426-
CoreTests.UtilTests
427-
CoreTests.VersionRangeTests
428-
FileDescriptionTests
429-
NtfClient
430-
NtfServerTests
431-
RemoteControl
432-
ServerTests
433-
SMPAgentClient
434-
SMPClient
435-
SMPProxyTests
436-
Util
437-
XFTPAgent
438-
XFTPCLI
439-
XFTPClient
440-
XFTPServerTests
412+
-- AgentTests.SchemaDump
413+
-- AgentTests.ServerChoice
414+
-- CLITests
415+
-- CoreTests.BatchingTests
416+
-- CoreTests.CryptoFileTests
417+
-- CoreTests.CryptoTests
418+
-- CoreTests.EncodingTests
419+
-- CoreTests.MsgStoreTests
420+
-- CoreTests.RetryIntervalTests
421+
-- CoreTests.SOCKSSettings
422+
-- CoreTests.StoreLogTests
423+
-- CoreTests.TRcvQueuesTests
424+
-- CoreTests.UtilTests
425+
-- CoreTests.VersionRangeTests
426+
-- FileDescriptionTests
427+
-- NtfClient
428+
-- NtfServerTests
429+
-- RemoteControl
430+
-- ServerTests
431+
-- SMPAgentClient
432+
-- SMPClient
433+
-- SMPProxyTests
434+
-- Util
435+
-- XFTPAgent
436+
-- XFTPCLI
437+
-- XFTPClient
438+
-- XFTPServerTests
441439
Static
442440
Static.Embedded
443441
Paths_simplexmq
442+
if !flag(client_postgres)
443+
other-modules:
444+
AgentTests.NotificationTests
445+
AgentTests.SQLiteTests
444446
hs-source-dirs:
445447
tests
446448
apps/smp-server/web

‎src/Simplex/Messaging/Agent/Store/Postgres.hs‎

Lines changed: 21 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,16 @@ module Simplex.Messaging.Agent.Store.Postgres
77
defaultSimplexConnectInfo,
88
closeDBStore,
99
execSQL,
10+
-- for tests
11+
dropDatabaseAndUser,
12+
dropSchema,
1013
)
1114
where
1215

1316
import Control.Exception (bracket, throwIO)
1417
import Control.Monad (unless, void)
1518
import Data.Functor (($>))
19+
import Data.String (fromString)
1620
import Data.Text (Text)
1721
import Database.PostgreSQL.Simple (ConnectInfo (..), Only (..), defaultConnectInfo)
1822
import qualified Database.PostgreSQL.Simple as PSQL
@@ -64,7 +68,7 @@ createDBAndUserIfNotExists ConnectInfo {connectUser = user, connectDatabase = db
6468
)
6569
|]
6670
(Only user)
67-
unless userExists $ void $ PSQL.execute db "CREATE USER ?" (Only user)
71+
unless userExists $ void $ PSQL.execute_ db (fromString $ "CREATE USER " <> user)
6872
-- check if the database exists, create if not
6973
[Only dbExists] <-
7074
PSQL.query
@@ -76,7 +80,7 @@ createDBAndUserIfNotExists ConnectInfo {connectUser = user, connectDatabase = db
7680
)
7781
|]
7882
(Only dbName)
79-
unless dbExists $ void $ PSQL.execute db "CREATE DATABASE ? OWNER ?" (dbName, user)
83+
unless dbExists $ void $ PSQL.execute_ db (fromString $ "CREATE DATABASE " <> dbName <> " OWNER " <> user)
8084

8185
connectPostgresStore :: ConnectInfo -> String -> IO DBStore
8286
connectPostgresStore dbConnectInfo schema = do
@@ -104,8 +108,8 @@ connectDB dbConnectInfo schema = do
104108
)
105109
|]
106110
(Only schema)
107-
unless schemaExists $ void $ PSQL.execute db "CREATE SCHEMA ?" (Only schema)
108-
void $ PSQL.execute db "SET search_path TO ?" (Only schema)
111+
unless schemaExists $ void $ PSQL.execute_ db (fromString $ "CREATE SCHEMA " <> schema)
112+
void $ PSQL.execute_ db (fromString $ "SET search_path TO " <> schema)
109113
pure schemaExists
110114

111115
-- can share with SQLite
@@ -119,3 +123,16 @@ closeDBStore st@DBStore {dbClosed} =
119123
-- TODO [postgres] not necessary for postgres (used for ExecAgentStoreSQL, ExecChatStoreSQL)
120124
execSQL :: PSQL.Connection -> Text -> IO [Text]
121125
execSQL _db _query = throwIO (userError "not implemented")
126+
127+
dropSchema :: ConnectInfo -> String -> IO ()
128+
dropSchema connectInfo schema = do
129+
bracket (PSQL.connect connectInfo) PSQL.close $
130+
\db ->
131+
void $ PSQL.execute_ db (fromString $ "DROP SCHEMA IF EXISTS " <> schema <> " CASCADE")
132+
133+
dropDatabaseAndUser :: ConnectInfo -> IO ()
134+
dropDatabaseAndUser ConnectInfo {connectUser = user, connectDatabase = dbName} = do
135+
bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
136+
\db -> do
137+
void $ PSQL.execute_ db (fromString $ "DROP USER " <> user)
138+
void $ PSQL.execute_ db (fromString $ "DROP DATABASE " <> dbName)

‎tests/AgentTests.hs‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,33 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE DataKinds #-}
23
{-# LANGUAGE GADTs #-}
3-
{-# LANGUAGE LambdaCase #-}
44
{-# LANGUAGE OverloadedStrings #-}
5-
{-# LANGUAGE PatternSynonyms #-}
65
{-# LANGUAGE PostfixOperators #-}
76
{-# LANGUAGE RankNTypes #-}
87
{-# LANGUAGE ScopedTypeVariables #-}
9-
{-# LANGUAGE TypeApplications #-}
108

119
module AgentTests (agentTests) where
1210

1311
import AgentTests.ConnectionRequestTests
1412
import AgentTests.DoubleRatchetTests (doubleRatchetTests)
1513
import AgentTests.FunctionalAPITests (functionalAPITests)
1614
import AgentTests.MigrationTests (migrationTests)
17-
import AgentTests.NotificationTests (notificationTests)
18-
import AgentTests.SQLiteTests (storeTests)
1915
import AgentTests.ServerChoice (serverChoiceTests)
2016
import Simplex.Messaging.Transport (ATransport (..))
2117
import Test.Hspec
18+
#if !defined(dbPostgres)
19+
import AgentTests.NotificationTests (notificationTests)
20+
import AgentTests.SQLiteTests (storeTests)
21+
#endif
2222

2323
agentTests :: ATransport -> Spec
2424
agentTests (ATransport t) = do
2525
describe "Connection request" connectionRequestTests
2626
describe "Double ratchet tests" doubleRatchetTests
2727
describe "Functional API" $ functionalAPITests (ATransport t)
28+
#if !defined(dbPostgres)
2829
describe "Notification tests" $ notificationTests (ATransport t)
2930
describe "SQLite store" storeTests
31+
#endif
3032
describe "Chosen servers" serverChoiceTests
3133
describe "Migration tests" migrationTests

‎tests/AgentTests/MigrationTests.hs‎

Lines changed: 42 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,34 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE OverloadedStrings #-}
23

34
module AgentTests.MigrationTests (migrationTests) where
45

56
import Control.Monad
67
import Data.Maybe (fromJust)
78
import Data.Word (Word32)
8-
import Database.SQLite.Simple (fromOnly)
99
import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
1010
import Simplex.Messaging.Agent.Store.Migrations (migrationsToRun)
11-
import Simplex.Messaging.Agent.Store.SQLite (closeDBStore, createDBStore)
12-
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
1311
import Simplex.Messaging.Agent.Store.Shared
14-
import System.Directory (removeFile)
1512
import System.Random (randomIO)
1613
import Test.Hspec
14+
#if defined(dbPostgres)
15+
import Database.PostgreSQL.Simple (ConnectInfo (..), fromOnly)
16+
import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore, defaultSimplexConnectInfo, dropSchema)
17+
import qualified Simplex.Messaging.Agent.Store.Postgres.DB as DB
18+
#else
19+
import Database.SQLite.Simple (fromOnly)
20+
import Simplex.Messaging.Agent.Store.SQLite (closeDBStore, createDBStore)
21+
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
22+
import System.Directory (removeFile)
23+
#endif
1724

18-
-- TODO [postgres] run with postgres
1925
migrationTests :: Spec
2026
migrationTests = do
2127
it "should determine migrations to run" testMigrationsToRun
2228
describe "run migrations" $ do
2329
-- (init migrs, tables)
2430
-- (final migrs, confirm modes, final tables or error)
25-
it "up 1-2 tables (yes)" $
31+
fit "up 1-2 tables (yes)" $
2632
testMigration
2733
([m1], [t1])
2834
([m1, m2], [MCYesUp, MCYesUpDown], Right [t1, t2])
@@ -98,9 +104,6 @@ migrationTests = do
98104
([m1, m2, m3, m4], [t1, t2, t3, t4])
99105
([m1, m2, m4], [MCYesUp, MCYesUpDown, MCError], Left . MigrationError $ MTREDifferent (name m4) (name m3))
100106

101-
testDB :: FilePath
102-
testDB = "tests/tmp/test_migrations.db"
103-
104107
m1 :: Migration
105108
m1 = Migration "20230301-migration1" "create table test1 (id1 integer primary key);" Nothing
106109

@@ -180,21 +183,46 @@ testMigration ::
180183
IO ()
181184
testMigration (initMs, initTables) (finalMs, confirmModes, tablesOrError) = forM_ confirmModes $ \confirmMode -> do
182185
r <- randomIO :: IO Word32
183-
let dpPath = testDB <> show r
184-
Right st <- createDBStore dpPath "" False initMs MCError
186+
Right st <- createStore r initMs MCError
185187
st `shouldHaveTables` initTables
186188
closeDBStore st
187189
case tablesOrError of
188190
Right tables -> do
189-
Right st' <- createDBStore dpPath "" False finalMs confirmMode
191+
Right st' <- createStore r finalMs confirmMode
190192
st' `shouldHaveTables` tables
191193
closeDBStore st'
192194
Left e -> do
193-
Left e' <- createDBStore dpPath "" False finalMs confirmMode
195+
Left e' <- createStore r finalMs confirmMode
194196
e `shouldBe` e'
195-
removeFile dpPath
197+
#if defined(dbPostgres)
198+
dropSchema testDBConnectInfo (testSchema r)
199+
#else
200+
removeFile (testDB r)
201+
#endif
196202
where
197203
shouldHaveTables :: DBStore -> [String] -> IO ()
198204
st `shouldHaveTables` expected = do
199205
tables <- map fromOnly <$> withTransaction st (`DB.query_` "SELECT name FROM sqlite_schema WHERE type = 'table' AND name NOT LIKE 'sqlite_%' ORDER BY 1;")
200206
tables `shouldBe` "migrations" : expected
207+
208+
#if defined(dbPostgres)
209+
testDBConnectInfo :: ConnectInfo
210+
testDBConnectInfo =
211+
defaultSimplexConnectInfo {
212+
connectUser = "test_user",
213+
connectDatabase = "test_db"
214+
}
215+
216+
testSchema :: Word32 -> String
217+
testSchema randSuffix = "test_migrations_schema" <> show randSuffix
218+
219+
createStore :: Word32 -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
220+
createStore randSuffix migrations confirmMigrations =
221+
createDBStore testDBConnectInfo (testSchema randSuffix) migrations confirmMigrations
222+
#else
223+
testDB :: Word32 -> FilePath
224+
testDB randSuffix = "tests/tmp/test_migrations.db" <> show randSuffix
225+
226+
createStore :: Word32 -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
227+
createStore randSuffix = createDBStore (testDB randSuffix) "" False
228+
#endif

‎tests/CoreTests/StoreLogTests.hs‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -10,13 +10,12 @@ module CoreTests.StoreLogTests where
1010

1111
import Control.Concurrent.STM
1212
import Control.Monad
13+
import CoreTests.MsgStoreTests
1314
import Crypto.Random (ChaChaDRG)
1415
import qualified Data.ByteString.Char8 as B
1516
import Data.Either (partitionEithers)
1617
import qualified Data.Map.Strict as M
1718
import SMPClient
18-
import AgentTests.SQLiteTests
19-
import CoreTests.MsgStoreTests
2019
import qualified Simplex.Messaging.Crypto as C
2120
import Simplex.Messaging.Encoding.String
2221
import Simplex.Messaging.Protocol
@@ -27,6 +26,9 @@ import Simplex.Messaging.Server.QueueStore
2726
import Simplex.Messaging.Server.StoreLog
2827
import Test.Hspec
2928

29+
testPublicAuthKey :: C.APublicAuthKey
30+
testPublicAuthKey = C.APublicAuthKey C.SEd25519 (C.publicKey "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe")
31+
3032
testNtfCreds :: TVar ChaChaDRG -> IO NtfCreds
3133
testNtfCreds g = do
3234
(notifierKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
@@ -54,7 +56,8 @@ storeLogTests =
5456
((rId, qr), ntfCreds, date) <- runIO $ do
5557
g <- C.newRandom
5658
(,,) <$> testNewQueueRec g sndSecure <*> testNtfCreds g <*> getSystemDate
57-
testSMPStoreLog ("SMP server store log, sndSecure = " <> show sndSecure)
59+
testSMPStoreLog
60+
("SMP server store log, sndSecure = " <> show sndSecure)
5861
[ SLTC
5962
{ name = "create new queue",
6063
saved = [CreateQueue qr],
@@ -66,7 +69,7 @@ storeLogTests =
6669
saved = [CreateQueue qr, SecureQueue rId testPublicAuthKey],
6770
compacted = [CreateQueue qr {senderKey = Just testPublicAuthKey}],
6871
state = M.fromList [(rId, qr {senderKey = Just testPublicAuthKey})]
69-
},
72+
},
7073
SLTC
7174
{ name = "create and delete queue",
7275
saved = [CreateQueue qr, DeleteQueue rId],
@@ -90,7 +93,7 @@ storeLogTests =
9093
saved = [CreateQueue qr, UpdateTime rId date],
9194
compacted = [CreateQueue qr {updatedAt = Just date}],
9295
state = M.fromList [(rId, qr {updatedAt = Just date})]
93-
}
96+
}
9497
]
9598

9699
testSMPStoreLog :: String -> [SMPStoreLogTestCase] -> Spec

‎tests/Test.hs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,13 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE NamedFieldPuns #-}
23
{-# LANGUAGE TypeApplications #-}
34

5+
-- TODO [postgres] fix and reenable tests
6+
#if defined(dbPostgres)
7+
import Control.Logger.Simple
8+
import AgentTests.MigrationTests (migrationTests)
9+
import Test.Hspec
10+
#else
411
import AgentTests (agentTests)
512
import AgentTests.SchemaDump (schemaDumpTest)
613
import CLITests
@@ -34,10 +41,23 @@ import Test.Hspec
3441
import XFTPAgent
3542
import XFTPCLI
3643
import XFTPServerTests (xftpServerTests)
44+
#endif
3745

3846
logCfg :: LogConfig
3947
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
4048

49+
#if defined(dbPostgres)
50+
main :: IO ()
51+
main = do
52+
setLogLevel LogError -- LogInfo
53+
withGlobalLogging logCfg $ do
54+
hspec
55+
-- . before_ (createDirectoryIfMissing False "tests/tmp")
56+
-- . after_ (eventuallyRemove "tests/tmp" 3)
57+
$ do
58+
describe "Migration tests" migrationTests
59+
60+
#else
4161
main :: IO ()
4262
main = do
4363
setLogLevel LogError -- LogInfo
@@ -89,3 +109,4 @@ eventuallyRemove path retries = case retries of
89109
_ -> E.throwIO ioe
90110
where
91111
action = removeDirectoryRecursive path
112+
#endif

0 commit comments

Comments
 (0)