dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-03-31 05:25:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'stable'

Browse Source
This commit is contained in:
Evgeny Poberezkin
2023-10-09 16:00:24 +01:00
parent d72c04682f 20995c6912
commit f31b4e4632
1 changed files with 17 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
src/Simplex/Chat/Mobile.hs
View File

@@ -3,11 +3,12 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Simplex.Chat.Mobile where
import Control.Concurrent.STM
import Control.Exception (catch)
import Control.Exception (catch, SomeException)
import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson (ToJSON (..))
@@ -40,8 +41,9 @@ import Simplex.Chat.Options
import Simplex.Chat.Store
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Client (agentClientStore)
import Simplex.Messaging.Agent.Env.SQLite (createAgentStore)
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError)
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, closeSQLiteStore)
import Simplex.Messaging.Client (defaultNetworkConfig)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
@@ -53,6 +55,8 @@ import System.Timeout (timeout)
foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString
foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
foreign export ccall "chat_recv_msg" cChatRecvMsg :: StablePtr ChatController -> IO CJSONString
@@ -97,6 +101,9 @@ cChatMigrateInit fp key conf ctrl = do
Left e -> pure e
newCStringFromLazyBS $ J.encode r
cChatCloseStore :: StablePtr ChatController -> IO CString
cChatCloseStore cPtr = deRefStablePtr cPtr >>= chatCloseStore >>= newCAString
-- | send command to chat (same syntax as in terminal for now)
cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
cChatSendCmd cPtr cCmd = do
@@ -201,6 +208,14 @@ chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
_ -> dbError e
dbError e = Left . DBMErrorSQL dbFile $ show e
chatCloseStore :: ChatController -> IO String
chatCloseStore ChatController {chatStore, smpAgent} = handleErr $ do
closeSQLiteStore chatStore
closeSQLiteStore $ agentClientStore smpAgent
handleErr :: IO () -> IO String
handleErr a = (a $> "") `catch` (pure . show @SomeException)
chatSendCmd :: ChatController -> ByteString -> IO JSONByteString
chatSendCmd cc s = J.encode . APIResponse Nothing <$> runReaderT (execChatCommand s) cc