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

cabal.project

@@ -10,7 +10,7 @@ package direct-sqlcipher
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: c66a7e371f4e9ac79237a7042c76426a6a068899
+    tag: 26d149d17c0ceb5cc17d0fd1c1357d95bd47e549
 
 source-repository-package
     type: git

package.yaml

@@ -23,6 +23,7 @@ dependencies:
   - containers == 0.6.*
   - cryptonite >= 0.27 && < 0.30
   - directory == 1.3.*
+  - direct-sqlcipher == 2.3.*
   - email-validate == 2.3.*
   - exceptions == 0.10.*
   - filepath == 1.4.*

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."c66a7e371f4e9ac79237a7042c76426a6a068899" = "0pz2px1n108nfbqy0d8cgqx5230j17jhycyprbsky5ywsfhpahbv";
+  "https://github.com/simplex-chat/simplexmq.git"."26d149d17c0ceb5cc17d0fd1c1357d95bd47e549" = "135knaxsyag3mlml62w2j4y8shvi82q8frhcn5b28qd8hlg5q2rq";
   "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";

simplex-chat.cabal

@@ -77,6 +77,7 @@ library
     , composition ==1.0.*
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
@@ -118,6 +119,7 @@ executable simplex-bot
     , composition ==1.0.*
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
@@ -160,6 +162,7 @@ executable simplex-bot-advanced
     , composition ==1.0.*
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
@@ -203,6 +206,7 @@ executable simplex-chat
     , composition ==1.0.*
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
@@ -254,6 +258,7 @@ test-suite simplex-chat-test
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
     , deepseq ==1.4.*
+    , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*

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,\

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: c66a7e371f4e9ac79237a7042c76426a6a068899
+    commit: 26d149d17c0ceb5cc17d0fd1c1357d95bd47e549
   # - ../direct-sqlcipher
   - github: simplex-chat/direct-sqlcipher
     commit: 34309410eb2069b029b8fc1872deb1e0db123294

tests/ChatTests.hs

@@ -115,6 +115,7 @@ chatTests = do
   describe "maintenance mode" $ do
     it "start/stop/export/import chat" testMaintenanceMode
     it "export/import chat with files" testMaintenanceModeWithFiles
+    it "encrypt/decrypt database" testDatabaseEncryption
 
 versionTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec
 versionTestMatrix2 runTest = do
@@ -2714,7 +2715,7 @@ testMaintenanceMode = withTmpFiles $ do
       alice <## "ok"
       -- cannot start chat after import
       alice ##> "/_start"
-      alice <## "error: chat store changed"
+      alice <## "error: chat store changed, please restart chat"
     -- works after full restart
     withTestChat "alice" $ \alice -> testChatWorking alice bob
 
@@ -2749,7 +2750,7 @@ testMaintenanceModeWithFiles = withTmpFiles $ do
       alice <## "ok"
       -- cannot start chat after delete
       alice ##> "/_start"
-      alice <## "error: chat store changed"
+      alice <## "error: chat store changed, please restart chat"
       doesDirectoryExist "./tests/tmp/alice_files" `shouldReturn` False
       alice ##> "/_db import {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
       alice <## "ok"
@@ -2757,6 +2758,45 @@ testMaintenanceModeWithFiles = withTmpFiles $ do
     -- works after full restart
     withTestChat "alice" $ \alice -> testChatWorking alice bob
 
+testDatabaseEncryption :: IO ()
+testDatabaseEncryption = withTmpFiles $ do
+  withNewTestChat "bob" bobProfile $ \bob -> do
+    withNewTestChatOpts testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do
+      alice ##> "/_start"
+      alice <## "chat started"
+      connectUsers alice bob
+      alice #> "@bob hi"
+      bob <# "alice> hi"
+      alice ##> "/db encrypt mykey"
+      alice <## "error: chat not stopped"
+      alice ##> "/db decrypt"
+      alice <## "error: chat not stopped"
+      alice ##> "/_stop"
+      alice <## "chat stopped"
+      alice ##> "/db decrypt"
+      alice <## "error: chat database is not encrypted"
+      alice ##> "/db encrypt mykey"
+      alice <## "ok"
+      alice ##> "/_start"
+      alice <## "error: chat store changed, please restart chat"
+    withTestChatOpts testOpts {maintenance = True, dbKey = "mykey"} "alice" $ \alice -> do
+      alice ##> "/_start"
+      alice <## "chat started"
+      testChatWorking alice bob
+      alice ##> "/_stop"
+      alice <## "chat stopped"
+      alice ##> "/db encrypt nextkey"
+      alice <## "ok"
+    withTestChatOpts testOpts {maintenance = True, dbKey = "nextkey"} "alice" $ \alice -> do
+      alice ##> "/_start"
+      alice <## "chat started"
+      testChatWorking alice bob
+      alice ##> "/_stop"
+      alice <## "chat stopped"
+      alice ##> "/db decrypt"
+      alice <## "ok"
+    withTestChat "alice" $ \alice -> testChatWorking alice bob
+
 withTestChatContactConnected :: String -> (TestCC -> IO a) -> IO a
 withTestChatContactConnected dbPrefix action =
   withTestChat dbPrefix $ \cc -> do