core: encrypt chat database (#988)

* core: encrypt chat database

* check DB key error on start

* function to encrypt database

* encrypt database command

* decrypt, rekey

* remove rekey, refactor

* test for db encryption/decryption

* update simplexmq

src/Simplex/Chat.hs

@@ -26,7 +26,7 @@ import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (isSpace)
+import Data.Char (isSpace, ord)
 import Data.Either (fromRight)
 import Data.Fixed (div')
 import Data.Functor (($>))
@@ -217,11 +217,7 @@ processChatCommand = \case
   StartChat subConns -> withUser' $ \user ->
     asks agentAsync >>= readTVarIO >>= \case
       Just _ -> pure CRChatRunning
-      _ ->
-        ifM
-          (asks chatStoreChanged >>= readTVarIO)
-          (throwChatError CEChatStoreChanged)
-          (startChatController user subConns $> CRChatStarted)
+      _ -> checkStoreNotChanged $ startChatController user subConns $> CRChatStarted
   APIStopChat -> do
     ask >>= stopChatController
     pure CRChatStopped
@@ -240,8 +236,10 @@ processChatCommand = \case
     atomically . writeTVar incognito $ onOff
     pure CRCmdOk
   APIExportArchive cfg -> checkChatStopped $ exportArchive cfg $> CRCmdOk
-  APIImportArchive cfg -> checkChatStopped $ importArchive cfg >> setStoreChanged $> CRCmdOk
-  APIDeleteStorage -> checkChatStopped $ deleteStorage >> setStoreChanged $> CRCmdOk
+  APIImportArchive cfg -> withStoreChanged $ importArchive cfg
+  APIDeleteStorage -> withStoreChanged $ deleteStorage
+  APIEncryptStorage key -> checkStoreNotChanged . withStoreChanged $ encryptStorage key
+  APIDecryptStorage -> checkStoreNotChanged $ withStoreChanged decryptStorage
   APIGetChats withPCC -> CRApiChats <$> withUser (\user -> withStore' $ \db -> getChatPreviews db user withPCC)
   APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
     CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\db -> getDirectChat db user cId pagination search)
@@ -939,6 +937,10 @@ processChatCommand = \case
     checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
     setStoreChanged :: m ()
     setStoreChanged = asks chatStoreChanged >>= atomically . (`writeTVar` True)
+    withStoreChanged :: m () -> m ChatResponse
+    withStoreChanged a = checkChatStopped $ a >> setStoreChanged $> CRCmdOk
+    checkStoreNotChanged :: m ChatResponse -> m ChatResponse
+    checkStoreNotChanged = ifM (asks chatStoreChanged >>= readTVarIO) (throwChatError CEChatStoreChanged)
     getSentChatItemIdByText :: User -> ChatRef -> ByteString -> m Int64
     getSentChatItemIdByText user@User {userId, localDisplayName} (ChatRef cType cId) msg = case cType of
       CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd (safeDecodeUtf8 msg)
@@ -2536,6 +2538,8 @@ chatCommandP =
       "/_db export " *> (APIExportArchive <$> jsonP),
       "/_db import " *> (APIImportArchive <$> jsonP),
       "/_db delete" $> APIDeleteStorage,
+      "/db encrypt " *> (APIEncryptStorage <$> encryptionKeyP),
+      "/db decrypt" $> APIDecryptStorage,
       "/_get chats" *> (APIGetChats <$> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
       "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional searchP),
       "/_get items count=" *> (APIGetChatItems <$> A.decimal),
@@ -2685,6 +2689,7 @@ chatCommandP =
       t_ <- optional $ " timeout=" *> A.decimal
       let tcpTimeout = 1000000 * fromMaybe (maybe 5 (const 10) socksProxy) t_
       pure $ fullNetworkConfig socksProxy tcpTimeout
+    encryptionKeyP = B.unpack <$> A.takeWhile1 (\c -> ord c >= 0x20 && ord c <= 0x7E)
 
 adminContactReq :: ConnReqContact
 adminContactReq =

src/Simplex/Chat/Archive.hs

@@ -1,16 +1,30 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
-module Simplex.Chat.Archive where
+module Simplex.Chat.Archive
+  ( exportArchive,
+    importArchive,
+    deleteStorage,
+    encryptStorage,
+    decryptStorage,
+  )
+where
 
 import qualified Codec.Archive.Zip as Z
+import Control.Monad.Except
 import Control.Monad.Reader
+import qualified Data.Text as T
+import qualified Database.SQLite3 as SQL
 import Simplex.Chat.Controller
-import Simplex.Messaging.Agent.Client (agentDbPath)
-import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..))
-import Simplex.Messaging.Util (whenM)
+import Simplex.Messaging.Agent.Client (agentStore)
+import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), sqlString)
+import Simplex.Messaging.Util (unlessM, whenM)
 import System.FilePath
 import UnliftIO.Directory
+import UnliftIO.Exception (SomeException, bracket, catch)
 import UnliftIO.STM
 import UnliftIO.Temporary
 
@@ -73,14 +87,63 @@ deleteStorage = do
 
 data StorageFiles = StorageFiles
   { chatDb :: FilePath,
+    chatKey :: String,
     agentDb :: FilePath,
+    agentKey :: String,
     filesPath :: Maybe FilePath
   }
 
 storageFiles :: ChatMonad m => m StorageFiles
 storageFiles = do
   ChatController {chatStore, filesFolder, smpAgent} <- ask
-  let SQLiteStore {dbFilePath = chatDb} = chatStore
-      agentDb = agentDbPath smpAgent
+  let SQLiteStore {dbFilePath = chatDb, dbKey = chatKey} = chatStore
+      SQLiteStore {dbFilePath = agentDb, dbKey = agentKey} = agentStore smpAgent
   filesPath <- readTVarIO filesFolder
-  pure StorageFiles {chatDb, agentDb, filesPath}
+  pure StorageFiles {chatDb, chatKey, agentDb, agentKey, filesPath}
+
+encryptStorage :: forall m. ChatMonad m => String -> m ()
+encryptStorage key' = updateDatabase $ \f key -> export f key key'
+
+decryptStorage :: forall m. ChatMonad m => m ()
+decryptStorage = updateDatabase $ \f -> \case
+  "" -> throwDBError DBENotEncrypted
+  key -> export f key ""
+
+updateDatabase :: ChatMonad m => (FilePath -> String -> m ()) -> m ()
+updateDatabase update = do
+  fs@StorageFiles {chatDb, chatKey, agentDb, agentKey} <- storageFiles
+  checkFile `with` fs
+  backup `with` fs
+  (update chatDb chatKey >> update agentDb agentKey)
+    `catchError` \e -> (restore `with` fs) >> throwError e
+  where
+    action `with` StorageFiles {chatDb, agentDb} = action chatDb >> action agentDb
+    backup f = copyFile f (f <> ".bak")
+    restore f = copyFile (f <> ".bak") f
+    checkFile f = unlessM (doesFileExist f) $ throwDBError DBENoFile
+
+export :: ChatMonad m => FilePath -> String -> String -> m ()
+export f key key' = do
+  withDB (`SQL.exec` exportSQL) DBEExportFailed
+  renameFile (f <> ".exported") f
+  withDB (`SQL.exec` testSQL) DBEOpenFailed
+  where
+    withDB a err =
+      liftIO (bracket (SQL.open $ T.pack f) SQL.close a)
+        `catch` \(e :: SomeException) -> liftIO (putStrLn $ "Database error: " <> show e) >> throwDBError err
+    exportSQL =
+      T.unlines $
+        keySQL key
+          <> [ "ATTACH DATABASE " <> sqlString (f <> ".exported") <> " AS exported KEY " <> sqlString key' <> ";",
+               "SELECT sqlcipher_export('exported');",
+               "DETACH DATABASE exported;"
+             ]
+    testSQL =
+      T.unlines $
+        keySQL key'
+          <> [ "PRAGMA foreign_keys = ON;",
+               "PRAGMA secure_delete = ON;",
+               "PRAGMA auto_vacuum = FULL;",
+               "SELECT count(*) FROM sqlite_master;"
+             ]
+    keySQL k = ["PRAGMA key = " <> sqlString k <> ";" | not (null k)]

src/Simplex/Chat/Controller.hs

@@ -112,6 +112,8 @@ data ChatCommand
   | APIExportArchive ArchiveConfig
   | APIImportArchive ArchiveConfig
   | APIDeleteStorage
+  | APIEncryptStorage String
+  | APIDecryptStorage
   | APIGetChats {pendingConnections :: Bool}
   | APIGetChat ChatRef ChatPagination (Maybe String)
   | APIGetChatItems Int
@@ -371,6 +373,7 @@ data ChatError
   = ChatError {errorType :: ChatErrorType}
   | ChatErrorAgent {agentError :: AgentErrorType}
   | ChatErrorStore {storeError :: StoreError}
+  | ChatErrorDatabase {database :: DatabaseError}
   deriving (Show, Exception, Generic)
 
 instance ToJSON ChatError where
@@ -428,6 +431,20 @@ instance ToJSON ChatErrorType where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CE"
 
+data DatabaseError
+  = DBENotEncrypted
+  | DBENoFile
+  | DBEExportFailed
+  | DBEOpenFailed
+  deriving (Show, Exception, Generic)
+
+instance ToJSON DatabaseError where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DBE"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DBE"
+
+throwDBError :: ChatMonad m => DatabaseError -> m ()
+throwDBError = throwError . ChatErrorDatabase
+
 type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
 
 chatCmdError :: String -> ChatResponse

src/Simplex/Chat/Terminal.hs

@@ -5,8 +5,11 @@
 
 module Simplex.Chat.Terminal where
 
+import Control.Exception (handle, throwIO)
 import Control.Monad.Except
 import qualified Data.List.NonEmpty as L
+import Database.SQLite.Simple (SQLError (..))
+import qualified Database.SQLite.Simple as DB
 import Simplex.Chat (defaultChatConfig)
 import Simplex.Chat.Controller
 import Simplex.Chat.Core
@@ -18,6 +21,7 @@ import Simplex.Chat.Terminal.Output
 import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers (..))
 import Simplex.Messaging.Client (defaultNetworkConfig)
 import Simplex.Messaging.Util (raceAny_)
+import System.Exit (exitFailure)
 
 terminalChatConfig :: ChatConfig
 terminalChatConfig =
@@ -38,10 +42,17 @@ terminalChatConfig =
 simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
 simplexChatTerminal cfg opts t = do
   sendToast <- initializeNotifications
-  simplexChatCore cfg opts (Just sendToast) $ \u cc -> do
+  handle checkDBKeyError . simplexChatCore cfg opts (Just sendToast) $ \u cc -> do
     ct <- newChatTerminal t
     when (firstTime cc) . printToTerminal ct $ chatWelcome u
     runChatTerminal ct cc
 
+checkDBKeyError :: SQLError -> IO ()
+checkDBKeyError e = case sqlError e of
+  DB.ErrorNotADatabase -> do
+    putStrLn "Database file is invalid or you passed an incorrect encryption key"
+    exitFailure
+  _ -> throwIO e
+
 runChatTerminal :: ChatTerminal -> ChatController -> IO ()
 runChatTerminal ct cc = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc, runInputLoop ct cc]

src/Simplex/Chat/View.hs

@@ -875,7 +875,7 @@ viewChatError = \case
     CEActiveUserExists -> ["error: active user already exists"]
     CEChatNotStarted -> ["error: chat not started"]
     CEChatNotStopped -> ["error: chat not stopped"]
-    CEChatStoreChanged -> ["error: chat store changed"]
+    CEChatStoreChanged -> ["error: chat store changed, please restart chat"]
     CEInvalidConnReq -> viewInvalidConnReq
     CEInvalidChatMessage e -> ["chat message error: " <> sShow e]
     CEContactNotReady c -> [ttyContact' c <> ": not ready"]
@@ -932,6 +932,9 @@ viewChatError = \case
     SEConnectionNotFound _ -> [] -- TODO mutes delete group error, but also mutes any error from getConnectionEntity
     SEQuotedChatItemNotFound -> ["message not found - reply is not sent"]
     e -> ["chat db error: " <> sShow e]
+  ChatErrorDatabase err -> case err of
+    DBENotEncrypted -> ["error: chat database is not encrypted"]
+    e -> ["chat database error: " <> sShow e]
   ChatErrorAgent err -> case err of
     SMP SMP.AUTH ->
       [ "error: connection authorization failed - this could happen if connection was deleted,\