Merge branch 'master' into master-ghc8107

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -28,6 +28,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     createSQLiteStore,
     connectSQLiteStore,
     closeSQLiteStore,
+    openSQLiteStore,
     sqlString,
     execSQL,
     upMigration, -- used in tests
@@ -265,13 +266,13 @@ import Simplex.Messaging.Parsers (blobFieldParser, dropPrefix, fromTextField_, s
 import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (bshow, eitherToMaybe, groupOn, ($>>=), (<$$>))
+import Simplex.Messaging.Util (bshow, eitherToMaybe, groupOn, ifM, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (takeDirectory)
 import System.IO (hFlush, stdout)
-import UnliftIO.Exception (onException)
+import UnliftIO.Exception (onException, bracketOnError)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
@@ -375,10 +376,12 @@ confirmOrExit s = do
 connectSQLiteStore :: FilePath -> String -> IO SQLiteStore
 connectSQLiteStore dbFilePath dbKey = do
   dbNew <- not <$> doesFileExist dbFilePath
-  dbConn <- dbBusyLoop $ connectDB dbFilePath dbKey
-  dbConnVar <- newTMVarIO dbConn
-  dbEncrypted <- newTVarIO . not $ null dbKey
-  pure SQLiteStore {dbFilePath, dbEncrypted, dbConnection = dbConnVar, dbNew}
+  dbConn <- dbBusyLoop (connectDB dbFilePath dbKey)
+  atomically $ do
+    dbConnection <- newTMVar dbConn
+    dbEncrypted <- newTVar . not $ null dbKey
+    dbClosed <- newTVar False
+    pure SQLiteStore {dbFilePath, dbEncrypted, dbConnection, dbNew, dbClosed}
 
 connectDB :: FilePath -> String -> IO DB.Connection
 connectDB path key = do
@@ -400,7 +403,25 @@ connectDB path key = do
         |]
 
 closeSQLiteStore :: SQLiteStore -> IO ()
-closeSQLiteStore st = atomically (takeTMVar $ dbConnection st) >>= DB.close
+closeSQLiteStore st@SQLiteStore {dbClosed} =
+  ifM (readTVarIO dbClosed) (putStrLn "closeSQLiteStore: already closed") $
+    withConnection st $ \conn -> do
+      DB.close conn
+      atomically $ writeTVar dbClosed True
+
+openSQLiteStore :: SQLiteStore -> String -> IO ()
+openSQLiteStore SQLiteStore {dbConnection, dbFilePath, dbClosed} key =
+  ifM (readTVarIO dbClosed) open (putStrLn "closeSQLiteStore: already opened")
+  where
+    open =
+      bracketOnError
+        (atomically $ takeTMVar dbConnection)
+        (atomically . tryPutTMVar dbConnection)
+        $ \DB.Connection {slow} -> do
+          DB.Connection {conn} <- connectDB dbFilePath key
+          atomically $ do
+            putTMVar dbConnection DB.Connection {conn, slow}
+            writeTVar dbClosed False
 
 sqlString :: String -> Text
 sqlString s = quote <> T.replace quote "''" (T.pack s) <> quote

src/Simplex/Messaging/Agent/Store/SQLite/Common.hs

@@ -27,6 +27,7 @@ data SQLiteStore = SQLiteStore
   { dbFilePath :: FilePath,
     dbEncrypted :: TVar Bool,
     dbConnection :: TMVar DB.Connection,
+    dbClosed :: TVar Bool,
     dbNew :: Bool
   }