mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-29 14:30:22 +00:00
5241f5fe5e
* rfc: client certificates for high volume clients (opertors' chat relays, notification servers, service bots) * client certificates types (WIP) * parameterize Transport * protocol/schema/api changes * agent API * rename command * agent subscriptions return local ClientServiceId to chat * verify transmissions * fix receiving client certificates, refactor * ntf server: remove shared queue for all notification subscriptions (#1543) * ntf server: remove shared queue for all notification subscriptions * wait for subscriber with timeout * safer * refactor * log * remove unused * WIP service subscriptions and associations, refactor * process service subscriptions * rename * simplify switching subscriptions * SMP service handshake with additional server handshake response * notification delivery and STM persistence for services * smp server: database storage, store log, fix encoding for STORE error, replace String with Text in locks and error * stats * more stats * rename SMP commands * service subscriptions in ntf server agent (tests fail) * fix * refactor * exports * subscribe ntf server as service for associated queues * test ntf service connection, fix SOKS response, fix service associations not removed in STM storage * INI option to support services * ntf server: downgrade subscriptions when service is no longer supported, track counts of subscribed queues * smp protocol: include service certificate fingerprint in the string signed over with entity key (TODO two tests fail) * fix test * ntf server prometheus stats, use Int64 in SOKS/ENDS responses (to avoid conversions), additional error status for ntf subscription * update RFC * refactor useServiceAuth to avoid ad hoc decisions about which commands use service signatures, and to prohibit service signatures on other commands * remove duplicate service signature syntax check from checkCredentials, it is checked in verifyTransmission * service errors, todos * fix checkCredentials in ntf server, service errors * refactor service auth * refactor * service agent: store returned queue count instead of expected * refactor serverThread * refactor serviceSig * rename * refactor, rename, test repeat NSUB service association * respond with error to SUBS * smp server: export/import service records between database and store log * comment * comments * ghc 8.10.7
71 lines
3.1 KiB
Haskell
71 lines
3.1 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module PostgresSchemaDump (postgresSchemaDumpTest) where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.DeepSeq
|
|
import Control.Monad (unless, void)
|
|
import qualified Data.ByteString.Char8 as B
|
|
import Data.List (dropWhileEnd)
|
|
import Data.Maybe (fromJust, isJust)
|
|
import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore)
|
|
import Simplex.Messaging.Agent.Store.Postgres.Common (DBOpts (..))
|
|
import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
|
|
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
|
|
import Simplex.Messaging.Util (ifM, whenM)
|
|
import System.Directory (doesFileExist, removeFile)
|
|
import System.Process (readCreateProcess, shell)
|
|
import Test.Hspec hiding (fit, it)
|
|
import Util
|
|
|
|
testSchemaPath :: FilePath
|
|
testSchemaPath = "tests/tmp/test_schema.sql"
|
|
|
|
postgresSchemaDumpTest :: [Migration] -> [String] -> DBOpts -> FilePath -> Spec
|
|
postgresSchemaDumpTest migrations skipComparisonForDownMigrations testDBOpts@DBOpts {connstr, schema = testDBSchema} srcSchemaPath = do
|
|
it "verify and overwrite schema dump" testVerifySchemaDump
|
|
it "verify schema down migrations" testSchemaMigrations
|
|
where
|
|
testVerifySchemaDump = do
|
|
savedSchema <- ifM (doesFileExist srcSchemaPath) (readFile srcSchemaPath) (pure "")
|
|
savedSchema `deepseq` pure ()
|
|
void $ createDBStore testDBOpts migrations MCConsole
|
|
getSchema srcSchemaPath `shouldReturn` savedSchema
|
|
|
|
testSchemaMigrations = do
|
|
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) migrations
|
|
Right st <- createDBStore testDBOpts noDownMigrations MCError
|
|
mapM_ (testDownMigration st) $ drop (length noDownMigrations) migrations
|
|
closeDBStore st
|
|
whenM (doesFileExist testSchemaPath) $ removeFile testSchemaPath
|
|
where
|
|
testDownMigration st m = do
|
|
putStrLn $ "down migration " <> name m
|
|
let downMigr = fromJust $ toDownMigration m
|
|
schema <- getSchema testSchemaPath
|
|
Migrations.run st $ MTRUp [m]
|
|
schema' <- getSchema testSchemaPath
|
|
schema' `shouldNotBe` schema
|
|
Migrations.run st $ MTRDown [downMigr]
|
|
unless (name m `elem` skipComparisonForDownMigrations) $ do
|
|
schema'' <- getSchema testSchemaPath
|
|
schema'' `shouldBe` schema
|
|
Migrations.run st $ MTRUp [m]
|
|
schema''' <- getSchema testSchemaPath
|
|
schema''' `shouldBe` schema'
|
|
|
|
getSchema :: FilePath -> IO String
|
|
getSchema schemaPath = do
|
|
ci <- envCI
|
|
let cmd =
|
|
("pg_dump " <> B.unpack connstr <> " --schema " <> B.unpack testDBSchema)
|
|
<> " --schema-only --no-owner --no-privileges --no-acl --no-subscriptions --no-tablespaces > "
|
|
<> schemaPath
|
|
void $ readCreateProcess (shell cmd) ""
|
|
threadDelay 20000
|
|
let sed = (if ci then "sed -i" else "sed -i ''")
|
|
void $ readCreateProcess (shell $ sed <> " '/^--/d' " <> schemaPath) ""
|
|
sch <- readFile schemaPath
|
|
sch `deepseq` pure sch
|