tests wip

simplexmq.cabal

@@ -403,44 +403,46 @@ test-suite simplexmq-test
   type: exitcode-stdio-1.0
   main-is: Test.hs
   other-modules:
-      AgentTests
-      AgentTests.ConnectionRequestTests
-      AgentTests.DoubleRatchetTests
-      AgentTests.EqInstances
-      AgentTests.FunctionalAPITests
+      -- AgentTests
+      -- AgentTests.ConnectionRequestTests
+      -- AgentTests.DoubleRatchetTests
+      -- AgentTests.EqInstances
+      -- AgentTests.FunctionalAPITests
       AgentTests.MigrationTests
-      AgentTests.NotificationTests
-      AgentTests.SchemaDump
-      AgentTests.ServerChoice
-      AgentTests.SQLiteTests
-      CLITests
-      CoreTests.BatchingTests
-      CoreTests.CryptoFileTests
-      CoreTests.CryptoTests
-      CoreTests.EncodingTests
-      CoreTests.MsgStoreTests
-      CoreTests.RetryIntervalTests
-      CoreTests.SOCKSSettings
-      CoreTests.StoreLogTests
-      CoreTests.TRcvQueuesTests
-      CoreTests.UtilTests
-      CoreTests.VersionRangeTests
-      FileDescriptionTests
-      NtfClient
-      NtfServerTests
-      RemoteControl
-      ServerTests
-      SMPAgentClient
-      SMPClient
-      SMPProxyTests
-      Util
-      XFTPAgent
-      XFTPCLI
-      XFTPClient
-      XFTPServerTests
+      -- AgentTests.SchemaDump
+      -- AgentTests.ServerChoice
+      -- CLITests
+      -- CoreTests.BatchingTests
+      -- CoreTests.CryptoFileTests
+      -- CoreTests.CryptoTests
+      -- CoreTests.EncodingTests
+      -- CoreTests.MsgStoreTests
+      -- CoreTests.RetryIntervalTests
+      -- CoreTests.SOCKSSettings
+      -- CoreTests.StoreLogTests
+      -- CoreTests.TRcvQueuesTests
+      -- CoreTests.UtilTests
+      -- CoreTests.VersionRangeTests
+      -- FileDescriptionTests
+      -- NtfClient
+      -- NtfServerTests
+      -- RemoteControl
+      -- ServerTests
+      -- SMPAgentClient
+      -- SMPClient
+      -- SMPProxyTests
+      -- Util
+      -- XFTPAgent
+      -- XFTPCLI
+      -- XFTPClient
+      -- XFTPServerTests
       Static
       Static.Embedded
       Paths_simplexmq
+  if !flag(client_postgres)
+      other-modules:
+          AgentTests.NotificationTests
+          AgentTests.SQLiteTests
   hs-source-dirs:
       tests
       apps/smp-server/web

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

@@ -7,12 +7,16 @@ module Simplex.Messaging.Agent.Store.Postgres
     defaultSimplexConnectInfo,
     closeDBStore,
     execSQL,
+    -- for tests
+    dropDatabaseAndUser,
+    dropSchema,
   )
 where
 
 import Control.Exception (bracket, throwIO)
 import Control.Monad (unless, void)
 import Data.Functor (($>))
+import Data.String (fromString)
 import Data.Text (Text)
 import Database.PostgreSQL.Simple (ConnectInfo (..), Only (..), defaultConnectInfo)
 import qualified Database.PostgreSQL.Simple as PSQL
@@ -64,7 +68,7 @@ createDBAndUserIfNotExists ConnectInfo {connectUser = user, connectDatabase = db
             )
           |]
           (Only user)
-      unless userExists $ void $ PSQL.execute db "CREATE USER ?" (Only user)
+      unless userExists $ void $ PSQL.execute_ db (fromString $ "CREATE USER " <> user)
       -- check if the database exists, create if not
       [Only dbExists] <-
         PSQL.query
@@ -76,7 +80,7 @@ createDBAndUserIfNotExists ConnectInfo {connectUser = user, connectDatabase = db
             )
           |]
           (Only dbName)
-      unless dbExists $ void $ PSQL.execute db "CREATE DATABASE ? OWNER ?" (dbName, user)
+      unless dbExists $ void $ PSQL.execute_ db (fromString $ "CREATE DATABASE " <> dbName <> " OWNER " <> user)
 
 connectPostgresStore :: ConnectInfo -> String -> IO DBStore
 connectPostgresStore dbConnectInfo schema = do
@@ -87,11 +91,10 @@ connectPostgresStore dbConnectInfo schema = do
 
 connectDB :: ConnectInfo -> String -> IO (DB.Connection, Bool)
 connectDB dbConnectInfo schema = do
-  bracket (PSQL.connect dbConnectInfo) PSQL.close $
-    \db -> do
-      schemaExists <- prepare db
-      let dbNew = not schemaExists
-      pure (db, dbNew)
+  db <- PSQL.connect dbConnectInfo
+  schemaExists <- prepare db `onException` PSQL.close db
+  let dbNew = not schemaExists
+  pure (db, dbNew)
   where
     prepare db = do
       [Only schemaExists] <-
@@ -104,8 +107,8 @@ connectDB dbConnectInfo schema = do
             )
           |]
           (Only schema)
-      unless schemaExists $ void $ PSQL.execute db "CREATE SCHEMA ?" (Only schema)
-      void $ PSQL.execute db "SET search_path TO ?" (Only schema)
+      unless schemaExists $ void $ PSQL.execute_ db (fromString $ "CREATE SCHEMA " <> schema)
+      void $ PSQL.execute_ db (fromString $ "SET search_path TO " <> schema)
       pure schemaExists
 
 -- can share with SQLite
@@ -119,3 +122,16 @@ closeDBStore st@DBStore {dbClosed} =
 -- TODO [postgres] not necessary for postgres (used for ExecAgentStoreSQL, ExecChatStoreSQL)
 execSQL :: PSQL.Connection -> Text -> IO [Text]
 execSQL _db _query = throwIO (userError "not implemented")
+
+dropSchema :: ConnectInfo -> String -> IO ()
+dropSchema connectInfo schema = do
+  bracket (PSQL.connect connectInfo) PSQL.close $
+    \db ->
+      void $ PSQL.execute_ db (fromString $ "DROP SCHEMA IF EXISTS " <> schema <> " CASCADE")
+
+dropDatabaseAndUser :: ConnectInfo -> IO ()
+dropDatabaseAndUser ConnectInfo {connectUser = user, connectDatabase = dbName} = do
+  bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
+    \db -> do
+      void $ PSQL.execute_ db (fromString $ "DROP USER " <> user)
+      void $ PSQL.execute_ db (fromString $ "DROP DATABASE " <> dbName)

tests/AgentTests.hs

@@ -1,31 +1,33 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PostfixOperators #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 
 module AgentTests (agentTests) where
 
 import AgentTests.ConnectionRequestTests
 import AgentTests.DoubleRatchetTests (doubleRatchetTests)
 import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.MigrationTests (migrationTests)
-import AgentTests.NotificationTests (notificationTests)
-import AgentTests.SQLiteTests (storeTests)
 import AgentTests.ServerChoice (serverChoiceTests)
 import Simplex.Messaging.Transport (ATransport (..))
 import Test.Hspec
+#if !defined(dbPostgres)
+import AgentTests.NotificationTests (notificationTests)
+import AgentTests.SQLiteTests (storeTests)
+#endif
 
 agentTests :: ATransport -> Spec
 agentTests (ATransport t) = do
   describe "Connection request" connectionRequestTests
   describe "Double ratchet tests" doubleRatchetTests
   describe "Functional API" $ functionalAPITests (ATransport t)
+#if !defined(dbPostgres)
   describe "Notification tests" $ notificationTests (ATransport t)
   describe "SQLite store" storeTests
+#endif
   describe "Chosen servers" serverChoiceTests
   describe "Migration tests" migrationTests

tests/AgentTests/MigrationTests.hs

@@ -1,28 +1,34 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module AgentTests.MigrationTests (migrationTests) where
 
 import Control.Monad
 import Data.Maybe (fromJust)
 import Data.Word (Word32)
-import Database.SQLite.Simple (fromOnly)
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
 import Simplex.Messaging.Agent.Store.Migrations (migrationsToRun)
-import Simplex.Messaging.Agent.Store.SQLite (closeDBStore, createDBStore)
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Agent.Store.Shared
-import System.Directory (removeFile)
 import System.Random (randomIO)
 import Test.Hspec
+#if defined(dbPostgres)
+import Database.PostgreSQL.Simple (ConnectInfo (..), fromOnly)
+import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore, defaultSimplexConnectInfo, dropSchema)
+import qualified Simplex.Messaging.Agent.Store.Postgres.DB as DB
+#else
+import Database.SQLite.Simple (fromOnly)
+import Simplex.Messaging.Agent.Store.SQLite (closeDBStore, createDBStore)
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import System.Directory (removeFile)
+#endif
 
--- TODO [postgres] run with postgres
 migrationTests :: Spec
 migrationTests = do
   it "should determine migrations to run" testMigrationsToRun
   describe "run migrations" $ do
     -- (init migrs, tables)
     -- (final migrs, confirm modes, final tables or error)
-    it "up 1-2 tables (yes)" $
+    fit "up 1-2 tables (yes)" $
       testMigration
         ([m1], [t1])
         ([m1, m2], [MCYesUp, MCYesUpDown], Right [t1, t2])
@@ -98,9 +104,6 @@ migrationTests = do
         ([m1, m2, m3, m4], [t1, t2, t3, t4])
         ([m1, m2, m4], [MCYesUp, MCYesUpDown, MCError], Left . MigrationError $ MTREDifferent (name m4) (name m3))
 
-testDB :: FilePath
-testDB = "tests/tmp/test_migrations.db"
-
 m1 :: Migration
 m1 = Migration "20230301-migration1" "create table test1 (id1 integer primary key);" Nothing
 
@@ -180,21 +183,49 @@ testMigration ::
   IO ()
 testMigration (initMs, initTables) (finalMs, confirmModes, tablesOrError) = forM_ confirmModes $ \confirmMode -> do
   r <- randomIO :: IO Word32
-  let dpPath = testDB <> show r
-  Right st <- createDBStore dpPath "" False initMs MCError
+  print 0
+  Right st <- createStore r initMs MCError
+  print 1
   st `shouldHaveTables` initTables
   closeDBStore st
   case tablesOrError of
     Right tables -> do
-      Right st' <- createDBStore dpPath "" False finalMs confirmMode
+      Right st' <- createStore r finalMs confirmMode
       st' `shouldHaveTables` tables
       closeDBStore st'
     Left e -> do
-      Left e' <- createDBStore dpPath "" False finalMs confirmMode
+      Left e' <- createStore r finalMs confirmMode
       e `shouldBe` e'
-  removeFile dpPath
+#if defined(dbPostgres)
+  dropSchema testDBConnectInfo (testSchema r)
+#else
+  removeFile (testDB r)
+#endif
   where
     shouldHaveTables :: DBStore -> [String] -> IO ()
     st `shouldHaveTables` expected = do
       tables <- map fromOnly <$> withTransaction st (`DB.query_` "SELECT name FROM sqlite_schema WHERE type = 'table' AND name NOT LIKE 'sqlite_%' ORDER BY 1;")
       tables `shouldBe` "migrations" : expected
+
+#if defined(dbPostgres)
+-- TODO [postgres] move to shared module
+testDBConnectInfo :: ConnectInfo
+testDBConnectInfo =
+  defaultSimplexConnectInfo {
+    connectUser = "test_user",
+    connectDatabase = "test_db"
+  }
+
+testSchema :: Word32 -> String
+testSchema randSuffix = "test_migrations_schema" <> show randSuffix
+
+createStore :: Word32 -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createStore randSuffix migrations confirmMigrations =
+  createDBStore testDBConnectInfo (testSchema randSuffix) migrations confirmMigrations
+#else
+testDB :: Word32 -> FilePath
+testDB randSuffix = "tests/tmp/test_migrations.db" <> show randSuffix
+
+createStore :: Word32 -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createStore randSuffix = createDBStore (testDB randSuffix) "" False
+#endif

tests/CoreTests/StoreLogTests.hs

@@ -10,13 +10,12 @@ module CoreTests.StoreLogTests where
 
 import Control.Concurrent.STM
 import Control.Monad
+import CoreTests.MsgStoreTests
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (partitionEithers)
 import qualified Data.Map.Strict as M
 import SMPClient
-import AgentTests.SQLiteTests
-import CoreTests.MsgStoreTests
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
@@ -27,6 +26,9 @@ import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.StoreLog
 import Test.Hspec
 
+testPublicAuthKey :: C.APublicAuthKey
+testPublicAuthKey = C.APublicAuthKey C.SEd25519 (C.publicKey "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe")
+
 testNtfCreds :: TVar ChaChaDRG -> IO NtfCreds
 testNtfCreds g = do
   (notifierKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
@@ -54,7 +56,8 @@ storeLogTests =
     ((rId, qr), ntfCreds, date) <- runIO $ do
       g <- C.newRandom
       (,,) <$> testNewQueueRec g sndSecure <*> testNtfCreds g <*> getSystemDate
-    testSMPStoreLog ("SMP server store log, sndSecure = " <> show sndSecure)
+    testSMPStoreLog
+      ("SMP server store log, sndSecure = " <> show sndSecure)
       [ SLTC
           { name = "create new queue",
             saved = [CreateQueue qr],
@@ -66,7 +69,7 @@ storeLogTests =
             saved = [CreateQueue qr, SecureQueue rId testPublicAuthKey],
             compacted = [CreateQueue qr {senderKey = Just testPublicAuthKey}],
             state = M.fromList [(rId, qr {senderKey = Just testPublicAuthKey})]
-          },          
+          },
         SLTC
           { name = "create and delete queue",
             saved = [CreateQueue qr, DeleteQueue rId],
@@ -90,7 +93,7 @@ storeLogTests =
             saved = [CreateQueue qr, UpdateTime rId date],
             compacted = [CreateQueue qr {updatedAt = Just date}],
             state = M.fromList [(rId, qr {updatedAt = Just date})]
-          }          
+          }
       ]
 
 testSMPStoreLog :: String -> [SMPStoreLogTestCase] -> Spec