core: single function to initialize the chat controller only if encryption key is correct (#1107)

2022-09-23 19:22:56 +01:00 · 2022-09-23 19:22:56 +01:00 · a977a0dd17
commit a977a0dd17
parent e1a7b02e59
11 changed files with 89 additions and 45 deletions
--- 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
--- 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
--- 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";
--- 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
--- 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}

--- 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,
--- 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 ()
--- 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
--- 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
--- 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
--- 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