diff --git a/cabal.project b/cabal.project index de7ae67bb..f0b9607db 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 26d149d17c0ceb5cc17d0fd1c1357d95bd47e549 + tag: e4b47825b56122222e5bf4716285b419acdac83d source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 622500603..42647833c 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."26d149d17c0ceb5cc17d0fd1c1357d95bd47e549" = "135knaxsyag3mlml62w2j4y8shvi82q8frhcn5b28qd8hlg5q2rq"; + "https://github.com/simplex-chat/simplexmq.git"."e4b47825b56122222e5bf4716285b419acdac83d" = "1dvr1s4kicf8z3x0bl7v6q1hphdngwcmcbmmqmj99b8728zh8fk4"; "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0"; "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 48146abdc..ee7a6b3b9 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -133,7 +133,7 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, de firstTime <- not <$> doesFileExist f currentUser <- newTVarIO user servers <- resolveServers defaultServers - smpAgent <- getSMPAgentClient aCfg {dbFile = dbFilePrefix <> "_agent.db", dbKey} servers {netCfg = networkConfig} + smpAgent <- getSMPAgentClient aCfg {dbFile = agentStoreFile dbFilePrefix, dbKey} servers {netCfg = networkConfig} agentAsync <- newTVarIO Nothing idsDrg <- newTVarIO =<< drgNew inputQ <- newTBQueueIO tbqSize diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 99097d7e0..13b77b202 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -23,7 +23,7 @@ simplexChatCore cfg@ChatConfig {yesToMigrations} opts sendToast chat where initRun = do let f = chatStoreFile $ dbFilePrefix opts - st <- createStore f (dbKey opts) yesToMigrations + st <- createChatStore f (dbKey opts) yesToMigrations u <- getCreateActiveUser st cc <- newChatController st (Just u) cfg opts sendToast runSimplexChat opts u cc chat diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 03cbf055e..2017b2703 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -1,18 +1,23 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Simplex.Chat.Mobile where import Control.Concurrent.STM +import Control.Exception (catch) import Control.Monad.Reader import Data.Aeson (ToJSON (..)) import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB +import Data.Functor (($>)) import Data.List (find) import Data.Maybe (fromMaybe) +import Database.SQLite.Simple (SQLError (..)) +import qualified Database.SQLite.Simple as DB import Foreign.C.String import Foreign.C.Types (CInt (..)) import Foreign.StablePtr @@ -24,11 +29,17 @@ import Simplex.Chat.Options import Simplex.Chat.Store import Simplex.Chat.Types import Simplex.Chat.Util (safeDecodeUtf8) -import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (yesToMigrations)) +import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (yesToMigrations), createAgentStore) +import Simplex.Messaging.Agent.Store.SQLite (closeSQLiteStore) import Simplex.Messaging.Client (defaultNetworkConfig) +import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (CorrId (..)) +import Simplex.Messaging.Util (catchAll) import System.Timeout (timeout) +foreign export ccall "chat_migrate_db" cChatMigrateDB :: CString -> CString -> IO CJSONString + +-- chat_init is deprecated foreign export ccall "chat_init" cChatInit :: CString -> IO (StablePtr ChatController) foreign export ccall "chat_init_key" cChatInitKey :: CString -> CString -> IO (StablePtr ChatController) @@ -41,7 +52,13 @@ foreign export ccall "chat_recv_msg_wait" cChatRecvMsgWait :: StablePtr ChatCont foreign export ccall "chat_parse_markdown" cChatParseMarkdown :: CString -> IO CJSONString --- | initialize chat controller +-- | check and migrate the database +-- This function validates that the encryption is correct and runs migrations - it should be called before cChatInitKey +cChatMigrateDB :: CString -> CString -> IO CJSONString +cChatMigrateDB fp key = + ((,) <$> peekCAString fp <*> peekCAString key) >>= uncurry chatMigrateDB >>= newCAString . LB.unpack . J.encode + +-- | initialize chat controller (deprecated) -- The active user has to be created and the chat has to be started before most commands can be used. cChatInit :: CString -> IO (StablePtr ChatController) cChatInit fp = peekCAString fp >>= chatInit >>= newStablePtr @@ -99,13 +116,39 @@ type CJSONString = CString getActiveUser_ :: SQLiteStore -> IO (Maybe User) getActiveUser_ st = find activeUser <$> withTransaction st getUsers +data DBMigrationResult + = DBMOk + | DBMErrorNotADatabase {dbFile :: String} + | DBMError {dbFile :: String, migrationError :: String} + deriving (Show, Generic) + +instance ToJSON DBMigrationResult where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DBM" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DBM" + +chatMigrateDB :: String -> String -> IO DBMigrationResult +chatMigrateDB dbFilePrefix dbKey = + migrate createChatStore (chatStoreFile dbFilePrefix) >>= \case + DBMOk -> migrate createAgentStore (agentStoreFile dbFilePrefix) + e -> pure e + where + migrate createStore dbFile = + ((createStore dbFile dbKey True >>= closeSQLiteStore) $> DBMOk) + `catch` (pure . checkDBError) + `catchAll` (pure . dbError) + where + checkDBError e = case sqlError e of + DB.ErrorNotADatabase -> DBMErrorNotADatabase dbFile + _ -> dbError e + dbError e = DBMError dbFile $ show e + chatInit :: String -> IO ChatController chatInit = (`chatInitKey` "") chatInitKey :: String -> String -> IO ChatController chatInitKey dbFilePrefix dbKey = do let f = chatStoreFile dbFilePrefix - chatStore <- createStore f dbKey (yesToMigrations (defaultMobileConfig :: ChatConfig)) + chatStore <- createChatStore f dbKey (yesToMigrations (defaultMobileConfig :: ChatConfig)) user_ <- getActiveUser_ chatStore newChatController chatStore user_ defaultMobileConfig mobileChatOpts {dbFilePrefix} Nothing diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 56ca84a1b..7b9b96e3f 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -20,8 +20,9 @@ module Simplex.Chat.Store ( SQLiteStore, StoreError (..), - createStore, + createChatStore, chatStoreFile, + agentStoreFile, createUser, getUsers, setActiveUser, @@ -276,12 +277,15 @@ migrations = sortBy (compare `on` name) $ map migration schemaMigrations where migration (name, query) = Migration {name = name, up = fromQuery query} -createStore :: FilePath -> String -> Bool -> IO SQLiteStore -createStore dbFilePath dbKey = createSQLiteStore dbFilePath dbKey migrations +createChatStore :: FilePath -> String -> Bool -> IO SQLiteStore +createChatStore dbFilePath dbKey = createSQLiteStore dbFilePath dbKey migrations chatStoreFile :: FilePath -> FilePath chatStoreFile = (<> "_chat.db") +agentStoreFile :: FilePath -> FilePath +agentStoreFile = (<> "_agent.db") + checkConstraint :: StoreError -> ExceptT StoreError IO a -> ExceptT StoreError IO a checkConstraint err action = ExceptT $ runExceptT action `E.catch` (pure . Left . handleSQLError err) diff --git a/stack.yaml b/stack.yaml index 0e4cde28b..9cf489bbb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 26d149d17c0ceb5cc17d0fd1c1357d95bd47e549 + commit: e4b47825b56122222e5bf4716285b419acdac83d # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher commit: 34309410eb2069b029b8fc1872deb1e0db123294 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 40e12b183..00197bc58 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -105,14 +105,14 @@ testCfgV1 = testCfg {agentConfig = testAgentCfgV1} createTestChat :: ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC createTestChat cfg opts@ChatOpts {dbKey} dbPrefix profile = do let dbFilePrefix = testDBPrefix <> dbPrefix - st <- createStore (dbFilePrefix <> "_chat.db") dbKey False + st <- createChatStore (dbFilePrefix <> "_chat.db") dbKey False Right user <- withTransaction st $ \db -> runExceptT $ createUser db profile True startTestChat_ st cfg opts dbFilePrefix user startTestChat :: ChatConfig -> ChatOpts -> String -> IO TestCC startTestChat cfg opts@ChatOpts {dbKey} dbPrefix = do let dbFilePrefix = testDBPrefix <> dbPrefix - st <- createStore (dbFilePrefix <> "_chat.db") dbKey False + st <- createChatStore (dbFilePrefix <> "_chat.db") dbKey False Just user <- find activeUser <$> withTransaction st getUsers startTestChat_ st cfg opts dbFilePrefix user diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index fd66923a6..a7d4aaa70 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -73,7 +73,9 @@ parsedMarkdown = "{\"formattedText\":[{\"format\":{\"type\":\"bold\"},\"text\":\ testChatApiNoUser :: IO () testChatApiNoUser = withTmpFiles $ do + DBMOk <- chatMigrateDB testDBPrefix "" cc <- chatInit testDBPrefix + DBMErrorNotADatabase _ <- chatMigrateDB testDBPrefix "myKey" chatSendCmd cc "/u" `shouldReturn` noActiveUser chatSendCmd cc "/_start" `shouldReturn` noActiveUser chatSendCmd cc "/u alice Alice" `shouldReturn` activeUser @@ -81,10 +83,14 @@ testChatApiNoUser = withTmpFiles $ do testChatApi :: IO () testChatApi = withTmpFiles $ do - let f = chatStoreFile $ testDBPrefix <> "1" - st <- createStore f "" True + let dbPrefix = testDBPrefix <> "1" + f = chatStoreFile dbPrefix + st <- createChatStore f "myKey" True Right _ <- withTransaction st $ \db -> runExceptT $ createUser db aliceProfile True - cc <- chatInit $ testDBPrefix <> "1" + DBMOk <- chatMigrateDB testDBPrefix "myKey" + cc <- chatInitKey dbPrefix "myKey" + DBMErrorNotADatabase _ <- chatMigrateDB testDBPrefix "" + DBMErrorNotADatabase _ <- chatMigrateDB testDBPrefix "anotherKey" chatSendCmd cc "/u" `shouldReturn` activeUser chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists chatSendCmd cc "/_start" `shouldReturn` chatStarted diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index 7140846fb..808e1773a 100644 --- a/tests/SchemaDump.hs +++ b/tests/SchemaDump.hs @@ -5,7 +5,7 @@ module SchemaDump where import ChatClient (withTmpFiles) import Control.DeepSeq import Control.Monad (void) -import Simplex.Chat.Store (createStore) +import Simplex.Chat.Store (createChatStore) import System.Process (readCreateProcess, shell) import Test.Hspec @@ -22,7 +22,7 @@ schemaDumpTest = testVerifySchemaDump :: IO () testVerifySchemaDump = withTmpFiles $ do - void $ createStore testDB "" False + void $ createChatStore testDB "" False void $ readCreateProcess (shell $ "touch " <> schema) "" savedSchema <- readFile schema savedSchema `deepseq` pure ()