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

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)]

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

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