From 985b9837c38b465b21e580b5c91e4f109e7de962 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 8 Oct 2023 16:22:53 +0100
Subject: [PATCH] core: api to close database connection (#3186)

---
 src/Simplex/Chat/Mobile.hs | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs
index 700548bb12..0db9d7265e 100644
--- a/src/Simplex/Chat/Mobile.hs
+++ b/src/Simplex/Chat/Mobile.hs
@@ -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
@@ -95,6 +99,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
@@ -195,6 +202,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