mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: support down migrations to allow reverting to the previous version (#2072)
* core: support down migrations to allow reverting to the previous version * update schema * update simplexmq * rename errors * remove unused functions * migration UI, test migration * update migration UI * return current migrations in CRVersionInfo * update simplexmq * test down migrations * cleanup ios * show migrations in log
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
f5c11b8faf
commit
c96ba30018
+21
-74
@@ -12,6 +12,7 @@ import Control.Monad.Except
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson (ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import Data.Bifunctor (first)
|
||||
import qualified Data.ByteString.Base64.URL as U
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
@@ -37,26 +38,17 @@ import Simplex.Chat.Mobile.WebRTC
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Store
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (yesToMigrations), createAgentStore)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (closeSQLiteStore)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (createAgentStore)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError)
|
||||
import Simplex.Messaging.Client (defaultNetworkConfig)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (BasicAuth (..), CorrId (..), ProtoServerWithAuth (..), ProtocolServer (..), SMPServerWithAuth)
|
||||
import Simplex.Messaging.Util (catchAll, safeDecodeUtf8)
|
||||
import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
|
||||
import System.Timeout (timeout)
|
||||
|
||||
foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
|
||||
-- TODO remove
|
||||
foreign export ccall "chat_migrate_db" cChatMigrateDB :: CString -> CString -> IO CJSONString
|
||||
|
||||
-- chat_init is deprecated
|
||||
foreign export ccall "chat_init" cChatInit :: CString -> IO (StablePtr ChatController)
|
||||
|
||||
-- TODO remove
|
||||
foreign export ccall "chat_init_key" cChatInitKey :: CString -> CString -> IO (StablePtr ChatController)
|
||||
foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
|
||||
foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
|
||||
|
||||
@@ -75,35 +67,17 @@ foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Wo
|
||||
foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
|
||||
|
||||
-- | check / migrate database and initialize chat controller on success
|
||||
cChatMigrateInit :: CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
cChatMigrateInit fp key ctrl = do
|
||||
cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
cChatMigrateInit fp key conf ctrl = do
|
||||
dbPath <- peekCAString fp
|
||||
dbKey <- peekCAString key
|
||||
confirm <- peekCAString conf
|
||||
r <-
|
||||
chatMigrateInit dbPath dbKey >>= \case
|
||||
chatMigrateInit dbPath dbKey confirm >>= \case
|
||||
Right cc -> (newStablePtr cc >>= poke ctrl) $> DBMOk
|
||||
Left e -> pure e
|
||||
newCAString . LB.unpack $ J.encode r
|
||||
|
||||
-- | check and migrate the database
|
||||
-- This function validates that the encryption is correct and runs migrations - it should be called before cChatInitKey
|
||||
-- TODO remove
|
||||
cChatMigrateDB :: CString -> CString -> IO CJSONString
|
||||
cChatMigrateDB fp key =
|
||||
((,) <$> peekCAString fp <*> peekCAString key) >>= uncurry chatMigrateDB >>= newCAString . LB.unpack . J.encode
|
||||
|
||||
-- | initialize chat controller (deprecated)
|
||||
-- The active user has to be created and the chat has to be started before most commands can be used.
|
||||
cChatInit :: CString -> IO (StablePtr ChatController)
|
||||
cChatInit fp = peekCAString fp >>= chatInit >>= newStablePtr
|
||||
|
||||
-- | initialize chat controller with encrypted database
|
||||
-- The active user has to be created and the chat has to be started before most commands can be used.
|
||||
-- TODO remove
|
||||
cChatInitKey :: CString -> CString -> IO (StablePtr ChatController)
|
||||
cChatInitKey fp key =
|
||||
((,) <$> peekCAString fp <*> peekCAString key) >>= uncurry chatInitKey >>= newStablePtr
|
||||
|
||||
-- | send command to chat (same syntax as in terminal for now)
|
||||
cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
|
||||
cChatSendCmd cPtr cCmd = do
|
||||
@@ -159,10 +133,7 @@ mobileChatOpts dbFilePrefix dbKey =
|
||||
|
||||
defaultMobileConfig :: ChatConfig
|
||||
defaultMobileConfig =
|
||||
defaultChatConfig
|
||||
{ yesToMigrations = True,
|
||||
agentConfig = (agentConfig defaultChatConfig) {yesToMigrations = True}
|
||||
}
|
||||
defaultChatConfig {confirmMigrations = MCYesUp}
|
||||
|
||||
type CJSONString = CString
|
||||
|
||||
@@ -171,60 +142,36 @@ getActiveUser_ st = find activeUser <$> withTransaction st getUsers
|
||||
|
||||
data DBMigrationResult
|
||||
= DBMOk
|
||||
| DBMInvalidConfirmation
|
||||
| DBMErrorNotADatabase {dbFile :: String}
|
||||
| DBMError {dbFile :: String, migrationError :: String}
|
||||
| DBMErrorMigration {dbFile :: String, migrationError :: MigrationError}
|
||||
| DBMErrorSQL {dbFile :: String, migrationSQLError :: String}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON DBMigrationResult where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DBM"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DBM"
|
||||
|
||||
chatMigrateInit :: String -> String -> IO (Either DBMigrationResult ChatController)
|
||||
chatMigrateInit dbFilePrefix dbKey = runExceptT $ do
|
||||
chatStore <- migrate createChatStore $ chatStoreFile dbFilePrefix
|
||||
agentStore <- migrate createAgentStore $ agentStoreFile dbFilePrefix
|
||||
chatMigrateInit :: String -> String -> String -> IO (Either DBMigrationResult ChatController)
|
||||
chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
|
||||
confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
|
||||
chatStore <- migrate createChatStore (chatStoreFile dbFilePrefix) confirmMigrations
|
||||
agentStore <- migrate createAgentStore (agentStoreFile dbFilePrefix) confirmMigrations
|
||||
liftIO $ initialize chatStore ChatDatabase {chatStore, agentStore}
|
||||
where
|
||||
initialize st db = do
|
||||
user_ <- getActiveUser_ st
|
||||
newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix dbKey) Nothing
|
||||
migrate createStore dbFile =
|
||||
migrate createStore dbFile confirmMigrations =
|
||||
ExceptT $
|
||||
(Right <$> createStore dbFile dbKey True)
|
||||
(first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey confirmMigrations)
|
||||
`catch` (pure . checkDBError)
|
||||
`catchAll` (pure . dbError)
|
||||
where
|
||||
checkDBError e = case sqlError e of
|
||||
DB.ErrorNotADatabase -> Left $ DBMErrorNotADatabase dbFile
|
||||
_ -> dbError e
|
||||
dbError e = Left . DBMError dbFile $ show e
|
||||
|
||||
-- TODO remove
|
||||
chatMigrateDB :: String -> String -> IO DBMigrationResult
|
||||
chatMigrateDB dbFilePrefix dbKey =
|
||||
migrate createChatStore (chatStoreFile dbFilePrefix) >>= \case
|
||||
DBMOk -> migrate createAgentStore (agentStoreFile dbFilePrefix)
|
||||
e -> pure e
|
||||
where
|
||||
migrate createStore dbFile =
|
||||
((createStore dbFile dbKey True >>= closeSQLiteStore) $> DBMOk)
|
||||
`catch` (pure . checkDBError)
|
||||
`catchAll` (pure . dbError)
|
||||
where
|
||||
checkDBError e = case sqlError e of
|
||||
DB.ErrorNotADatabase -> DBMErrorNotADatabase dbFile
|
||||
_ -> dbError e
|
||||
dbError e = DBMError dbFile $ show e
|
||||
|
||||
chatInit :: String -> IO ChatController
|
||||
chatInit = (`chatInitKey` "")
|
||||
|
||||
-- TODO remove
|
||||
chatInitKey :: String -> String -> IO ChatController
|
||||
chatInitKey dbFilePrefix dbKey = do
|
||||
db@ChatDatabase {chatStore} <- createChatDatabase dbFilePrefix dbKey True
|
||||
user_ <- getActiveUser_ chatStore
|
||||
newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix dbKey) Nothing
|
||||
dbError e = Left . DBMErrorSQL dbFile $ show e
|
||||
|
||||
chatSendCmd :: ChatController -> String -> IO JSONString
|
||||
chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc
|
||||
|
||||
Reference in New Issue
Block a user