Merge branch 'master' into master-ghc8107

This commit is contained in:
Evgeny Poberezkin
2023-12-11 14:56:25 +00:00
35 changed files with 1031 additions and 289 deletions
+4 -3
View File
@@ -15,6 +15,7 @@ import Control.Concurrent.STM
import Control.Exception (bracket, bracket_)
import Control.Monad
import Control.Monad.Except
import Data.ByteArray (ScrubbedBytes)
import Data.Functor (($>))
import Data.List (dropWhileEnd, find)
import Data.Maybe (fromJust, isNothing)
@@ -86,7 +87,7 @@ testOpts =
maintenance = False
}
getTestOpts :: Bool -> String -> ChatOpts
getTestOpts :: Bool -> ScrubbedBytes -> ChatOpts
getTestOpts maintenance dbKey = testOpts {maintenance, coreOptions = (coreOptions testOpts) {dbKey}}
termSettings :: VirtualTerminalSettings
@@ -160,13 +161,13 @@ groupLinkViaContactVRange = mkVersionRange 1 2
createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
createTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefix profile = do
Right db@ChatDatabase {chatStore} <- createChatDatabase (tmp </> dbPrefix) dbKey MCError
Right db@ChatDatabase {chatStore} <- createChatDatabase (tmp </> dbPrefix) dbKey False MCError
Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True
startTestChat_ db cfg opts user
startTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> IO TestCC
startTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefix = do
Right db@ChatDatabase {chatStore} <- createChatDatabase (tmp </> dbPrefix) dbKey MCError
Right db@ChatDatabase {chatStore} <- createChatDatabase (tmp </> dbPrefix) dbKey False MCError
Just user <- find activeUser <$> withTransaction chatStore getUsers
startTestChat_ db cfg opts user
+1 -1
View File
@@ -209,7 +209,7 @@ testChatApi :: FilePath -> IO ()
testChatApi tmp = do
let dbPrefix = tmp </> "1"
f = chatStoreFile dbPrefix
Right st <- createChatStore f "myKey" MCYesUp
Right st <- createChatStore f "myKey" False MCYesUp
Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp"
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp"
+2 -2
View File
@@ -36,14 +36,14 @@ testVerifySchemaDump :: IO ()
testVerifySchemaDump = withTmpFiles $ do
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
savedSchema `deepseq` pure ()
void $ createChatStore testDB "" MCError
void $ createChatStore testDB "" False MCError
getSchema testDB appSchema `shouldReturn` savedSchema
removeFile testDB
testSchemaMigrations :: IO ()
testSchemaMigrations = withTmpFiles $ do
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations
Right st <- createSQLiteStore testDB "" noDownMigrations MCError
Right st <- createSQLiteStore testDB "" False noDownMigrations MCError
mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
closeSQLiteStore st
removeFile testDB