controller: add db passphrase test command (#3788)

* controller: add passphrase test

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
Alexander Bondarenko 2024-02-18 15:28:24 +02:00 committed by GitHub
parent d83a6b7133
commit 364b62320b
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
4 changed files with 42 additions and 20 deletions

View File

@ -604,6 +604,7 @@ processChatCommand' vr = \case
pure $ CRArchiveImported fileErrs
APIDeleteStorage -> withStoreChanged deleteStorage
APIStorageEncryption cfg -> withStoreChanged $ sqlCipherExport cfg
TestStorageEncryption key -> withStoreChanged $ sqlCipherTestKey key
ExecChatStoreSQL query -> CRSQLResult <$> withStore' (`execSQL` query)
ExecAgentStoreSQL query -> CRSQLResult <$> withAgent (`execAgentStoreSQL` query)
SlowSQLQueries -> do
@ -6510,6 +6511,7 @@ chatCommandP =
"/db encrypt " *> (APIStorageEncryption . dbEncryptionConfig "" <$> dbKeyP),
"/db key " *> (APIStorageEncryption <$> (dbEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)),
"/db decrypt " *> (APIStorageEncryption . (`dbEncryptionConfig` "") <$> dbKeyP),
"/db test key " *> (TestStorageEncryption <$> dbKeyP),
"/sql chat " *> (ExecChatStoreSQL <$> textP),
"/sql agent " *> (ExecAgentStoreSQL <$> textP),
"/sql slow" $> SlowSQLQueries,

View File

@ -9,6 +9,7 @@ module Simplex.Chat.Archive
importArchive,
deleteStorage,
sqlCipherExport,
sqlCipherTestKey,
archiveFilesFolder,
)
where
@ -20,6 +21,7 @@ import Control.Monad.Reader
import qualified Data.ByteArray as BA
import Data.Functor (($>))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Database.SQLite3 as SQL
import Simplex.Chat.Controller
@ -147,19 +149,8 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
atomically $ writeTVar dbKey $ storeKey key' (fromMaybe False keepKey)
export f = do
withDB f (`SQL.exec` exportSQL) DBErrorExport
withDB (exported f) (`SQL.exec` testSQL) DBErrorOpen
withDB (exported f) (`SQL.exec` testSQL key') DBErrorOpen
where
withDB f' a err =
liftIO (bracket (SQL.open $ T.pack f') SQL.close a $> Nothing)
`catch` checkSQLError
`catch` (\(e :: SomeException) -> sqliteError' e)
>>= mapM_ (throwDBError . err)
where
checkSQLError e = case SQL.sqlError e of
SQL.ErrorNotADatabase -> pure $ Just SQLiteErrorNotADatabase
_ -> sqliteError' e
sqliteError' :: Show e => e -> m (Maybe SQLiteError)
sqliteError' = pure . Just . SQLiteError . show
exportSQL =
T.unlines $
keySQL key
@ -167,14 +158,38 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
"SELECT sqlcipher_export('exported');",
"DETACH DATABASE exported;"
]
testSQL =
T.unlines $
keySQL key'
<> [ "PRAGMA foreign_keys = ON;",
"PRAGMA secure_delete = ON;",
"SELECT count(*) FROM sqlite_master;"
]
keySQL k = ["PRAGMA key = " <> keyString k <> ";" | not (BA.null k)]
withDB :: forall a m. ChatMonad m => FilePath -> (SQL.Database -> IO a) -> (SQLiteError -> DatabaseError) -> m ()
withDB f' a err =
liftIO (bracket (SQL.open $ T.pack f') SQL.close a $> Nothing)
`catch` checkSQLError
`catch` (\(e :: SomeException) -> sqliteError' e)
>>= mapM_ (throwDBError . err)
where
checkSQLError e = case SQL.sqlError e of
SQL.ErrorNotADatabase -> pure $ Just SQLiteErrorNotADatabase
_ -> sqliteError' e
sqliteError' :: Show e => e -> m (Maybe SQLiteError)
sqliteError' = pure . Just . SQLiteError . show
testSQL :: BA.ScrubbedBytes -> Text
testSQL k =
T.unlines $
keySQL k
<> [ "PRAGMA foreign_keys = ON;",
"PRAGMA secure_delete = ON;",
"SELECT count(*) FROM sqlite_master;"
]
keySQL :: BA.ScrubbedBytes -> [Text]
keySQL k = ["PRAGMA key = " <> keyString k <> ";" | not (BA.null k)]
sqlCipherTestKey :: forall m. ChatMonad m => DBEncryptionKey -> m ()
sqlCipherTestKey (DBEncryptionKey key) = do
fs <- storageFiles
testKey `withDBs` fs
where
testKey f = withDB f (`SQL.exec` testSQL key) DBErrorOpen
withDBs :: Monad m => (FilePath -> m b) -> StorageFiles -> m b
action `withDBs` StorageFiles {chatStore, agentStore} = action (dbFilePath chatStore) >> action (dbFilePath agentStore)

View File

@ -250,6 +250,7 @@ data ChatCommand
| APIImportArchive ArchiveConfig
| APIDeleteStorage
| APIStorageEncryption DBEncryptionConfig
| TestStorageEncryption DBEncryptionKey
| ExecChatStoreSQL Text
| ExecAgentStoreSQL Text
| SlowSQLQueries

View File

@ -1124,6 +1124,10 @@ testDatabaseEncryption tmp = do
testChatWorking alice bob
alice ##> "/_stop"
alice <## "chat stopped"
alice ##> "/db test key wrongkey"
alice <## "error opening database after encryption: wrong passphrase or invalid database file"
alice ##> "/db test key mykey"
alice <## "ok"
alice ##> "/db key wrongkey nextkey"
alice <## "error encrypting database: wrong passphrase or invalid database file"
alice ##> "/db key mykey nextkey"