From a977a0dd178f587266cff45ecba3f934c85d7b65 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 23 Sep 2022 19:22:56 +0100 Subject: [PATCH] core: single function to initialize the chat controller only if encryption key is correct (#1107) --- apps/android/app/src/main/cpp/simplex-api.c | 2 + cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 28 ++++++------ src/Simplex/Chat/Archive.hs | 5 ++- src/Simplex/Chat/Controller.hs | 2 + src/Simplex/Chat/Core.hs | 10 ++--- src/Simplex/Chat/Mobile.hs | 47 +++++++++++++++++++-- stack.yaml | 2 +- tests/ChatClient.hs | 22 +++++----- tests/MobileTests.hs | 12 +++--- 11 files changed, 89 insertions(+), 45 deletions(-) diff --git a/apps/android/app/src/main/cpp/simplex-api.c b/apps/android/app/src/main/cpp/simplex-api.c index 10c9efd6f..e6114feb4 100644 --- a/apps/android/app/src/main/cpp/simplex-api.c +++ b/apps/android/app/src/main/cpp/simplex-api.c @@ -24,6 +24,8 @@ Java_chat_simplex_app_SimplexAppKt_initHS(__unused JNIEnv *env, __unused jclass // from simplex-chat typedef void* chat_ctrl; +extern char *chat_migrate_init(const char *path, const char *key, chat_ctrl *ctrl); + extern char *chat_migrate_db(const char *path, const char *key); extern chat_ctrl chat_init_key(const char *path, const char *key); extern chat_ctrl chat_init(const char *path); // deprecated diff --git a/cabal.project b/cabal.project index 6c1497ffe..c911d28f0 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: f8505d4add64b2b2ce11a94d878857d404f30fe6 + tag: 413aad5139acee28033404aed2e5516fc71c337c source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 884ebdc2d..1c2e90c3a 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."f8505d4add64b2b2ce11a94d878857d404f30fe6" = "1h1dyk2m9kgv63nnnylm68371mg1vxpl6fggqdykg0dknmid3mpy"; + "https://github.com/simplex-chat/simplexmq.git"."413aad5139acee28033404aed2e5516fc71c337c" = "0vzmglhnbr2x9frs597sg6v8if1hfydbmnza5532sc486qms0vmg"; "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 69904ba60..ea9ffde95 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -56,9 +56,9 @@ import Simplex.Chat.Store import Simplex.Chat.Types import Simplex.Chat.Util (lastMaybe, safeDecodeUtf8, uncurry3) import Simplex.Messaging.Agent as Agent -import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), defaultAgentConfig) +import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), AgentDatabase (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig) import Simplex.Messaging.Agent.Protocol -import Simplex.Messaging.Agent.Store.SQLite (exexSQL) +import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (dbNew), exexSQL) import Simplex.Messaging.Client (defaultNetworkConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding @@ -86,8 +86,7 @@ defaultChatConfig = { agentConfig = defaultAgentConfig { tcpPort = undefined, -- agent does not listen to TCP - dbFile = "simplex_v1", - dbKey = "", + database = AgentDBFile {dbFile = "simplex_v1_agent", dbKey = ""}, yesToMigrations = False }, yesToMigrations = False, @@ -125,16 +124,21 @@ fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEA logCfg :: LogConfig logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} -newChatController :: SQLiteStore -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController -newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {dbFilePrefix, dbKey, smpServers, networkConfig, logConnections, logServerHosts} sendToast = do - let f = chatStoreFile dbFilePrefix - config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts} +createChatDatabase :: FilePath -> String -> Bool -> IO ChatDatabase +createChatDatabase filePrefix key yesToMigrations = do + chatStore <- createChatStore (chatStoreFile filePrefix) key yesToMigrations + agentStore <- createAgentStore (agentStoreFile filePrefix) key yesToMigrations + pure ChatDatabase {chatStore, agentStore} + +newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController +newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts} sendToast = do + let config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts} sendNotification = fromMaybe (const $ pure ()) sendToast + firstTime = dbNew chatStore activeTo <- newTVarIO ActiveNone - firstTime <- not <$> doesFileExist f currentUser <- newTVarIO user servers <- resolveServers defaultServers - smpAgent <- getSMPAgentClient aCfg {dbFile = agentStoreFile dbFilePrefix, dbKey} servers {netCfg = networkConfig} + smpAgent <- getSMPAgentClient aCfg {database = AgentDB agentStore} servers {netCfg = networkConfig} agentAsync <- newTVarIO Nothing idsDrg <- newTVarIO =<< drgNew inputQ <- newTBQueueIO tbqSize @@ -2653,9 +2657,9 @@ withStore :: (DB.Connection -> ExceptT StoreError IO a) -> m a withStore action = do - st <- asks chatStore + ChatController {chatStore} <- ask liftEitherError ChatErrorStore $ - withTransaction st (runExceptT . action) `E.catch` handleInternal + withTransaction chatStore (runExceptT . action) `E.catch` handleInternal where handleInternal :: E.SomeException -> IO (Either StoreError a) handleInternal = pure . Left . SEInternalError . show diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs index f4bcc5ca4..6ce3458cf 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -19,7 +20,7 @@ import Data.Functor (($>)) import qualified Data.Text as T import qualified Database.SQLite3 as SQL import Simplex.Chat.Controller -import Simplex.Messaging.Agent.Client (agentStore) +import Simplex.Messaging.Agent.Client (agentClientStore) import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), sqlString) import Simplex.Messaging.Util (unlessM, whenM) import System.FilePath @@ -97,7 +98,7 @@ storageFiles :: ChatMonad m => m StorageFiles storageFiles = do ChatController {chatStore, filesFolder, smpAgent} <- ask let SQLiteStore {dbFilePath = chatDb, dbEncrypted = chatEncrypted} = chatStore - SQLiteStore {dbFilePath = agentDb, dbEncrypted = agentEncrypted} = agentStore smpAgent + SQLiteStore {dbFilePath = agentDb, dbEncrypted = agentEncrypted} = agentClientStore smpAgent filesPath <- readTVarIO filesFolder pure StorageFiles {chatDb, chatEncrypted, agentDb, agentEncrypted, filesPath} diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 76188a6ee..51de29a11 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -75,6 +75,8 @@ data ChatConfig = ChatConfig data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName deriving (Eq) +data ChatDatabase = ChatDatabase {chatStore :: SQLiteStore, agentStore :: SQLiteStore} + data ChatController = ChatController { currentUser :: TVar (Maybe User), activeTo :: TVar ActiveTo, diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 13b77b202..4165a281f 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -10,22 +10,20 @@ import Data.Text.Encoding (encodeUtf8) import Simplex.Chat import Simplex.Chat.Controller import Simplex.Chat.Options (ChatOpts (..)) -import Simplex.Chat.Store import Simplex.Chat.Types import UnliftIO.Async simplexChatCore :: ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> (User -> ChatController -> IO ()) -> IO () -simplexChatCore cfg@ChatConfig {yesToMigrations} opts sendToast chat +simplexChatCore cfg@ChatConfig {yesToMigrations} opts@ChatOpts {dbFilePrefix, dbKey} sendToast chat | logAgent opts = do setLogLevel LogInfo -- LogError withGlobalLogging logCfg initRun | otherwise = initRun where initRun = do - let f = chatStoreFile $ dbFilePrefix opts - st <- createChatStore f (dbKey opts) yesToMigrations - u <- getCreateActiveUser st - cc <- newChatController st (Just u) cfg opts sendToast + db@ChatDatabase {chatStore} <- createChatDatabase dbFilePrefix dbKey yesToMigrations + u <- getCreateActiveUser chatStore + cc <- newChatController db (Just u) cfg opts sendToast runSimplexChat opts u cc chat runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO () diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 0e3d68d7a..c33b5a92a 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -8,6 +8,7 @@ module Simplex.Chat.Mobile where import Control.Concurrent.STM import Control.Exception (catch) +import Control.Monad.Except import Control.Monad.Reader import Data.Aeson (ToJSON (..)) import qualified Data.Aeson as J @@ -20,7 +21,9 @@ import Database.SQLite.Simple (SQLError (..)) import qualified Database.SQLite.Simple as DB import Foreign.C.String import Foreign.C.Types (CInt (..)) +import Foreign.Ptr import Foreign.StablePtr +import Foreign.Storable (poke) import GHC.Generics (Generic) import Simplex.Chat import Simplex.Chat.Controller @@ -37,11 +40,15 @@ import Simplex.Messaging.Protocol (CorrId (..)) import Simplex.Messaging.Util (catchAll) import System.Timeout (timeout) +foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString + +-- TODO remove 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) +-- TODO remove foreign export ccall "chat_init_key" cChatInitKey :: CString -> CString -> IO (StablePtr ChatController) foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString @@ -52,8 +59,20 @@ foreign export ccall "chat_recv_msg_wait" cChatRecvMsgWait :: StablePtr ChatCont foreign export ccall "chat_parse_markdown" cChatParseMarkdown :: CString -> IO CJSONString +-- | check / migrate database and initialize chat controller on success +cChatMigrateInit :: CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString +cChatMigrateInit fp key ctrl = do + dbPath <- peekCAString fp + dbKey <- peekCAString key + r <- + chatMigrateInit dbPath dbKey >>= \case + Right cc -> (newStablePtr cc >>= poke ctrl) $> DBMOk + Left e -> pure e + newCAString . LB.unpack $ J.encode r + -- | check and migrate the database -- This function validates that the encryption is correct and runs migrations - it should be called before cChatInitKey +-- TODO remove cChatMigrateDB :: CString -> CString -> IO CJSONString cChatMigrateDB fp key = ((,) <$> peekCAString fp <*> peekCAString key) >>= uncurry chatMigrateDB >>= newCAString . LB.unpack . J.encode @@ -65,6 +84,7 @@ cChatInit fp = peekCAString fp >>= chatInit >>= newStablePtr -- | initialize chat controller with encrypted database -- The active user has to be created and the chat has to be started before most commands can be used. +-- TODO remove cChatInitKey :: CString -> CString -> IO (StablePtr ChatController) cChatInitKey fp key = ((,) <$> peekCAString fp <*> peekCAString key) >>= uncurry chatInitKey >>= newStablePtr @@ -126,6 +146,27 @@ instance ToJSON DBMigrationResult where toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DBM" toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DBM" +chatMigrateInit :: String -> String -> IO (Either DBMigrationResult ChatController) +chatMigrateInit dbFilePrefix dbKey = runExceptT $ do + chatStore <- migrate createChatStore $ chatStoreFile dbFilePrefix + agentStore <- migrate createAgentStore $ agentStoreFile dbFilePrefix + liftIO $ initialize chatStore ChatDatabase {chatStore, agentStore} + where + initialize st db = do + user_ <- getActiveUser_ st + newChatController db user_ defaultMobileConfig mobileChatOpts {dbFilePrefix, dbKey} Nothing + migrate createStore dbFile = + ExceptT $ + (Right <$> createStore dbFile dbKey True) + `catch` (pure . checkDBError) + `catchAll` (pure . dbError) + where + checkDBError e = case sqlError e of + DB.ErrorNotADatabase -> Left $ DBMErrorNotADatabase dbFile + _ -> dbError e + dbError e = Left . DBMError dbFile $ show e + +-- TODO remove chatMigrateDB :: String -> String -> IO DBMigrationResult chatMigrateDB dbFilePrefix dbKey = migrate createChatStore (chatStoreFile dbFilePrefix) >>= \case @@ -145,12 +186,12 @@ chatMigrateDB dbFilePrefix dbKey = chatInit :: String -> IO ChatController chatInit = (`chatInitKey` "") +-- TODO remove chatInitKey :: String -> String -> IO ChatController chatInitKey dbFilePrefix dbKey = do - let f = chatStoreFile dbFilePrefix - chatStore <- createChatStore f dbKey (yesToMigrations (defaultMobileConfig :: ChatConfig)) + db@ChatDatabase {chatStore} <- createChatDatabase dbFilePrefix dbKey True user_ <- getActiveUser_ chatStore - newChatController chatStore user_ defaultMobileConfig mobileChatOpts {dbFilePrefix, dbKey} Nothing + newChatController db user_ defaultMobileConfig mobileChatOpts {dbFilePrefix, dbKey} Nothing chatSendCmd :: ChatController -> String -> IO JSONString chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc diff --git a/stack.yaml b/stack.yaml index 9312be861..7c3a53948 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: f8505d4add64b2b2ce11a94d878857d404f30fe6 + commit: 413aad5139acee28033404aed2e5516fc71c337c # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher commit: 34309410eb2069b029b8fc1872deb1e0db123294 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index c2329e4ab..8ba92d0fb 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -18,7 +18,7 @@ import Data.Maybe (fromJust, isNothing) import qualified Data.Text as T import Network.Socket import Simplex.Chat -import Simplex.Chat.Controller (ChatConfig (..), ChatController (..)) +import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatDatabase (..)) import Simplex.Chat.Core import Simplex.Chat.Options import Simplex.Chat.Store @@ -104,23 +104,21 @@ testCfgV1 = testCfg {agentConfig = testAgentCfgV1} createTestChat :: ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC createTestChat cfg opts@ChatOpts {dbKey} dbPrefix profile = do - let dbFilePrefix = testDBPrefix <> dbPrefix - st <- createChatStore (dbFilePrefix <> "_chat.db") dbKey False - Right user <- withTransaction st $ \db -> runExceptT $ createUser db profile True - startTestChat_ st cfg opts dbFilePrefix user + db@ChatDatabase {chatStore} <- createChatDatabase (testDBPrefix <> dbPrefix) dbKey False + Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUser db' profile True + startTestChat_ db cfg opts user startTestChat :: ChatConfig -> ChatOpts -> String -> IO TestCC startTestChat cfg opts@ChatOpts {dbKey} dbPrefix = do - let dbFilePrefix = testDBPrefix <> dbPrefix - st <- createChatStore (dbFilePrefix <> "_chat.db") dbKey False - Just user <- find activeUser <$> withTransaction st getUsers - startTestChat_ st cfg opts dbFilePrefix user + db@ChatDatabase {chatStore} <- createChatDatabase (testDBPrefix <> dbPrefix) dbKey False + Just user <- find activeUser <$> withTransaction chatStore getUsers + startTestChat_ db cfg opts user -startTestChat_ :: SQLiteStore -> ChatConfig -> ChatOpts -> FilePath -> User -> IO TestCC -startTestChat_ st cfg opts dbFilePrefix user = do +startTestChat_ :: ChatDatabase -> ChatConfig -> ChatOpts -> User -> IO TestCC +startTestChat_ db cfg opts user = do t <- withVirtualTerminal termSettings pure ct <- newChatTerminal t - cc <- newChatController st (Just user) cfg opts {dbFilePrefix} Nothing -- no notifications + cc <- newChatController db (Just user) cfg opts Nothing -- no notifications chatAsync <- async . runSimplexChat opts user cc . const $ runChatTerminal ct atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry termQ <- newTQueueIO diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index a7d4aaa70..31f3557bc 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -73,9 +73,8 @@ parsedMarkdown = "{\"formattedText\":[{\"format\":{\"type\":\"bold\"},\"text\":\ testChatApiNoUser :: IO () testChatApiNoUser = withTmpFiles $ do - DBMOk <- chatMigrateDB testDBPrefix "" - cc <- chatInit testDBPrefix - DBMErrorNotADatabase _ <- chatMigrateDB testDBPrefix "myKey" + Right cc <- chatMigrateInit testDBPrefix "" + Left (DBMErrorNotADatabase _) <- chatMigrateInit testDBPrefix "myKey" chatSendCmd cc "/u" `shouldReturn` noActiveUser chatSendCmd cc "/_start" `shouldReturn` noActiveUser chatSendCmd cc "/u alice Alice" `shouldReturn` activeUser @@ -87,10 +86,9 @@ testChatApi = withTmpFiles $ do f = chatStoreFile dbPrefix st <- createChatStore f "myKey" True Right _ <- withTransaction st $ \db -> runExceptT $ createUser db aliceProfile True - DBMOk <- chatMigrateDB testDBPrefix "myKey" - cc <- chatInitKey dbPrefix "myKey" - DBMErrorNotADatabase _ <- chatMigrateDB testDBPrefix "" - DBMErrorNotADatabase _ <- chatMigrateDB testDBPrefix "anotherKey" + Right cc <- chatMigrateInit dbPrefix "myKey" + Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" + Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey" chatSendCmd cc "/u" `shouldReturn` activeUser chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists chatSendCmd cc "/_start" `shouldReturn` chatStarted