core: change database encryption API to require current passphrase on all changes (#1019)

2026-03-30 12:05:46 +00:00 · 2022-09-05 14:54:39 +01:00
parent 229f385f42
commit 082e12683b
8 changed files with 88 additions and 71 deletions
--- 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: e4b47825b56122222e5bf4716285b419acdac83d
+    tag: 50c210c5c0c7f792c39123c2177bb60b307295b9

 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"."e4b47825b56122222e5bf4716285b419acdac83d" = "1dvr1s4kicf8z3x0bl7v6q1hphdngwcmcbmmqmj99b8728zh8fk4";
+  "https://github.com/simplex-chat/simplexmq.git"."50c210c5c0c7f792c39123c2177bb60b307295b9" = "1f23p5crfy8fhfmcv96r7c6xpzgj2ab8nwqzdhis6mskhrfhyj4g";
  "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
@@ -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, ord)
+import Data.Char (isSpace)
 import Data.Either (fromRight)
 import Data.Fixed (div')
 import Data.Functor (($>))
@@ -238,8 +238,7 @@ processChatCommand = \case
  APIExportArchive cfg -> checkChatStopped $ exportArchive cfg $> CRCmdOk
  APIImportArchive cfg -> withStoreChanged $ importArchive cfg
  APIDeleteStorage -> withStoreChanged $ deleteStorage
-  APIEncryptStorage key -> checkStoreNotChanged . withStoreChanged $ encryptStorage key
-  APIDecryptStorage -> checkStoreNotChanged $ withStoreChanged decryptStorage
+  APIStorageEncryption cfg -> withStoreChanged $ sqlCipherExport cfg
  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)
@@ -2538,8 +2537,10 @@ chatCommandP =
      "/_db export " *> (APIExportArchive <$> jsonP),
      "/_db import " *> (APIImportArchive <$> jsonP),
      "/_db delete" $> APIDeleteStorage,
-      "/db encrypt " *> (APIEncryptStorage <$> encryptionKeyP),
-      "/db decrypt" $> APIDecryptStorage,
+      "/_db encryption" *> (APIStorageEncryption <$> jsonP),
+      "/db encrypt " *> (APIStorageEncryption . DBEncryptionConfig "" <$> dbKeyP),
+      "/db password " *> (APIStorageEncryption <$> (DBEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)),
+      "/db decrypt " *> (APIStorageEncryption . (`DBEncryptionConfig` "") <$> dbKeyP),
      "/_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),
@@ -2689,7 +2690,8 @@ 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)
+    dbKeyP = nonEmptyKey <$?> strP
+    nonEmptyKey k@(DBEncryptionKey s) = if null s then Left "empty key" else Right k

 adminContactReq :: ConnReqContact
 adminContactReq =
--- a/src/Simplex/Chat/Archive.hs
+++ b/src/Simplex/Chat/Archive.hs
@@ -8,8 +8,7 @@ module Simplex.Chat.Archive
  ( exportArchive,
    importArchive,
    deleteStorage,
-    encryptStorage,
-    decryptStorage,
+    sqlCipherExport,
  )
 where

@@ -21,7 +20,7 @@ import qualified Database.SQLite3 as SQL
 import Simplex.Chat.Controller
 import Simplex.Messaging.Agent.Client (agentStore)
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), sqlString)
-import Simplex.Messaging.Util (unlessM, whenM)
+import Simplex.Messaging.Util (ifM, unlessM, whenM)
 import System.FilePath
 import UnliftIO.Directory
 import UnliftIO.Exception (SomeException, bracket, catch)
@@ -87,63 +86,58 @@ deleteStorage = do

 data StorageFiles = StorageFiles
  { chatDb :: FilePath,
-    chatKey :: String,
+    chatEncrypted :: TVar Bool,
    agentDb :: FilePath,
-    agentKey :: String,
+    agentEncrypted :: TVar Bool,
    filesPath :: Maybe FilePath
  }

 storageFiles :: ChatMonad m => m StorageFiles
 storageFiles = do
  ChatController {chatStore, filesFolder, smpAgent} <- ask
-  let SQLiteStore {dbFilePath = chatDb, dbKey = chatKey} = chatStore
-      SQLiteStore {dbFilePath = agentDb, dbKey = agentKey} = agentStore smpAgent
+  let SQLiteStore {dbFilePath = chatDb, dbEncrypted = chatEncrypted} = chatStore
+      SQLiteStore {dbFilePath = agentDb, dbEncrypted = agentEncrypted} = agentStore smpAgent
  filesPath <- readTVarIO filesFolder
-  pure StorageFiles {chatDb, chatKey, agentDb, agentKey, filesPath}
+  pure StorageFiles {chatDb, chatEncrypted, agentDb, agentEncrypted, 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
+sqlCipherExport :: forall m. ChatMonad m => DBEncryptionConfig -> m ()
+sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = DBEncryptionKey key'} =
+  when (key /= key') $ do
+    fs@StorageFiles {chatDb, chatEncrypted, agentDb, agentEncrypted} <- storageFiles
+    checkFile `with` fs
+    backup `with` fs
+    (export chatDb chatEncrypted >> export agentDb agentEncrypted)
+      `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 $ show e)
-    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)]
+    checkFile f = unlessM (doesFileExist f) $ throwDBError $ DBErrorNoFile f
+    export f dbEnc = do
+      enc <- readTVarIO dbEnc
+      when (enc && null key) $ throwDBError DBErrorEncrypted
+      when (not enc && not (null key)) $ throwDBError DBErrorPlaintext
+      withDB (`SQL.exec` exportSQL) DBErrorExport
+      renameFile (f <> ".exported") f
+      withDB (`SQL.exec` testSQL) DBErrorOpen
+      atomically $ writeTVar dbEnc $ not (null key')
+      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 $ show e)
+        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)]
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -17,9 +17,13 @@ import Control.Monad.Reader
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Char (ord)
 import Data.Int (Int64)
 import Data.Map.Strict (Map)
+import Data.String
 import Data.Text (Text)
 import Data.Time (ZonedTime)
 import Data.Time.Clock (UTCTime)
@@ -38,8 +42,9 @@ import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, InitialAgentServers, Net
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -112,8 +117,7 @@ data ChatCommand
  | APIExportArchive ArchiveConfig
  | APIImportArchive ArchiveConfig
  | APIDeleteStorage
-  | APIEncryptStorage String
-  | APIDecryptStorage
+  | APIStorageEncryption DBEncryptionConfig
  | APIGetChats {pendingConnections :: Bool}
  | APIGetChat ChatRef ChatPagination (Maybe String)
  | APIGetChatItems Int
@@ -324,6 +328,21 @@ instance ToJSON ChatResponse where
 data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
  deriving (Show, Generic, FromJSON)

+data DBEncryptionConfig = DBEncryptionConfig {currentKey :: DBEncryptionKey, newKey :: DBEncryptionKey}
+  deriving (Show, Generic, FromJSON)
+
+newtype DBEncryptionKey = DBEncryptionKey String
+  deriving (Show)
+
+instance IsString DBEncryptionKey where fromString = parseString $ parseAll strP
+
+instance StrEncoding DBEncryptionKey where
+  strEncode (DBEncryptionKey s) = B.pack s
+  strP = DBEncryptionKey . B.unpack <$> A.takeWhile (\c -> c /= ' ' && ord c >= 0x21 && ord c <= 0x7E)
+
+instance FromJSON DBEncryptionKey where
+  parseJSON = strParseJSON "DBEncryptionKey"
+
 data ContactSubStatus = ContactSubStatus
  { contact :: Contact,
    contactError :: Maybe ChatError
@@ -432,10 +451,11 @@ instance ToJSON ChatErrorType where
  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CE"

 data DatabaseError
-  = DBENotEncrypted
-  | DBENoFile
-  | DBEExportFailed {databaseError :: String}
-  | DBEOpenFailed {databaseError :: String}
+  = DBErrorEncrypted
+  | DBErrorPlaintext
+  | DBErrorNoFile {dbFile :: String}
+  | DBErrorExport {databaseError :: String}
+  | DBErrorOpen {databaseError :: String}
  deriving (Show, Exception, Generic)

 instance ToJSON DatabaseError where
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -933,7 +933,8 @@ viewChatError = \case
    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"]
+    DBErrorEncrypted -> ["error: chat database is already encrypted"]
+    DBErrorPlaintext -> ["error: chat database is not encrypted"]
    e -> ["chat database error: " <> sShow e]
  ChatErrorAgent err -> case err of
    SMP SMP.AUTH ->
--- 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: e4b47825b56122222e5bf4716285b419acdac83d
+    commit: 50c210c5c0c7f792c39123c2177bb60b307295b9
  # - ../direct-sqlcipher
  - github: simplex-chat/direct-sqlcipher
    commit: 34309410eb2069b029b8fc1872deb1e0db123294
--- a/tests/ChatTests.hs
+++ b/tests/ChatTests.hs
@@ -2769,11 +2769,11 @@ testDatabaseEncryption = withTmpFiles $ do
      bob <# "alice> hi"
      alice ##> "/db encrypt mykey"
      alice <## "error: chat not stopped"
-      alice ##> "/db decrypt"
+      alice ##> "/db decrypt mykey"
      alice <## "error: chat not stopped"
      alice ##> "/_stop"
      alice <## "chat stopped"
-      alice ##> "/db decrypt"
+      alice ##> "/db decrypt mykey"
      alice <## "error: chat database is not encrypted"
      alice ##> "/db encrypt mykey"
      alice <## "ok"
@@ -2785,7 +2785,7 @@ testDatabaseEncryption = withTmpFiles $ do
      testChatWorking alice bob
      alice ##> "/_stop"
      alice <## "chat stopped"
-      alice ##> "/db encrypt nextkey"
+      alice ##> "/db password mykey nextkey"
      alice <## "ok"
    withTestChatOpts testOpts {maintenance = True, dbKey = "nextkey"} "alice" $ \alice -> do
      alice ##> "/_start"
@@ -2793,7 +2793,7 @@ testDatabaseEncryption = withTmpFiles $ do
      testChatWorking alice bob
      alice ##> "/_stop"
      alice <## "chat stopped"
-      alice ##> "/db decrypt"
+      alice ##> "/db decrypt nextkey"
      alice <## "ok"
    withTestChat "alice" $ \alice -> testChatWorking alice bob