Don't forget to release HasBlockIO in the public API

There are a few places where functions in the public API create a `HasBlockIO`
for the user, but since #742 when a session is closed the `HasBlockIO` it
contains does not get closed automatically anymore. So in the public API, we
have to be extra careful to do so when the public API opens a `HasBlockIO`.

Author: jorisdral

src/Database/LSMTree.hs

@@ -24,7 +24,6 @@ module Database.LSMTree (
   withNewSession,
   withRestoreSession,
   openSession,
-  openSessionIO,
   newSession,
   restoreSession,
   closeSession,
@@ -275,7 +274,7 @@ import qualified Database.LSMTree.Internal.Unsafe as Internal
 import           Prelude hiding (lookup, take, takeWhile)
 import           System.FS.API (FsPath, HasFS (..), MountPoint (..), mkFsPath)
 import           System.FS.BlockIO.API (HasBlockIO (..), defaultIOCtxParams)
-import           System.FS.BlockIO.IO (ioHasBlockIO, withIOHasBlockIO)
+import           System.FS.BlockIO.IO (withIOHasBlockIO)
 import           System.FS.IO (HandleIO, ioHasFS)
 import           System.Random (randomIO)
 
@@ -622,22 +621,6 @@ openSession ::
 openSession tracer hasFS hasBlockIO sessionSalt sessionDir =
   Session <$> Internal.openSession tracer hasFS hasBlockIO sessionSalt sessionDir
 
--- | Variant of 'openSession' that is specialised to 'IO' using the real filesystem.
-openSessionIO ::
-  Tracer IO LSMTreeTrace ->
-  -- | The session directory.
-  FilePath ->
-  IO (Session IO)
-openSessionIO tracer sessionDir = do
-  let mountPoint = MountPoint sessionDir
-  let sessionDirFsPath = mkFsPath []
-  let hasFS = ioHasFS mountPoint
-  sessionSalt <- randomIO
-  let acquireHasBlockIO = ioHasBlockIO hasFS defaultIOCtxParams
-  let releaseHasBlockIO HasBlockIO{close} = close
-  bracketOnError acquireHasBlockIO releaseHasBlockIO $ \hasBlockIO ->
-    openSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath
-
 {- |
 Create a new session.
 

src/Database/LSMTree/Simple.hs

@@ -157,7 +157,8 @@ module Database.LSMTree.Simple (
 ) where
 
 import           Control.ActionRegistry (mapExceptionWithActionRegistry)
-import           Control.Exception.Base (Exception, SomeException (..))
+import           Control.Exception (Exception, SomeException (..),
+                     bracketOnError, finally)
 import           Data.Bifunctor (Bifunctor (..))
 import           Data.Coerce (coerce)
 import           Data.Kind (Type)
@@ -185,7 +186,14 @@ import           Database.LSMTree (BloomFilterAlloc, CursorClosedError (..),
                      serialiseValueIdentity, serialiseValueIdentityUpToSlicing,
                      toSnapshotName)
 import qualified Database.LSMTree as LSMT
+import qualified Database.LSMTree.Internal.Types as LSMT
+import qualified Database.LSMTree.Internal.Unsafe as Internal
 import           Prelude hiding (lookup, take, takeWhile)
+import           System.FS.API (MountPoint (..), mkFsPath)
+import           System.FS.BlockIO.API (HasBlockIO (..), defaultIOCtxParams)
+import           System.FS.BlockIO.IO (ioHasBlockIO)
+import           System.FS.IO (ioHasFS)
+import           System.Random (randomIO)
 
 --------------------------------------------------------------------------------
 -- Example
@@ -450,7 +458,14 @@ openSession ::
 openSession dir = do
     let tracer = mempty
     _convertSessionDirErrors dir $ do
-        Session <$> LSMT.openSessionIO tracer dir
+      let mountPoint = MountPoint dir
+      let sessionDirFsPath = mkFsPath []
+      let hasFS = ioHasFS mountPoint
+      sessionSalt <- randomIO
+      let acquireHasBlockIO = ioHasBlockIO hasFS defaultIOCtxParams
+      let releaseHasBlockIO HasBlockIO{close} = close
+      bracketOnError acquireHasBlockIO releaseHasBlockIO $ \hasBlockIO ->
+        Session <$> LSMT.openSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath
 
 {- |
 Close a session.
@@ -471,8 +486,10 @@ All other operations on a closed session will throw an exception.
 closeSession ::
     Session ->
     IO ()
-closeSession (Session session) =
-    LSMT.closeSession session
+closeSession (Session session@(LSMT.Session session')) = do
+    HasBlockIO{close} <- Internal.withKeepSessionOpen session' $
+                          pure . Internal.sessionHasBlockIO
+    LSMT.closeSession session `finally` close
 
 --------------------------------------------------------------------------------
 -- Tables