Make the default IOCtxParams explicit

bench/micro/Bench/Database/LSMTree/Internal/Lookup.hs

@@ -22,6 +22,7 @@ import           Data.Bifunctor (Bifunctor (..))
 import qualified Data.List as List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import           Data.Maybe (fromMaybe)
 import qualified Data.Vector as V
 import           Database.LSMTree.Extras.Orphans ()
 import           Database.LSMTree.Extras.Random (sampleUniformWithReplacement,
@@ -127,7 +128,7 @@ lookupsInBatchesEnv Config {..} = do
     benchTmpDir <- createTempDirectory sysTmpDir "lookupsInBatchesEnv"
     (storedKeys, lookupKeys) <- lookupsEnv (mkStdGen 17) nentries npos nneg
     let hasFS = FS.ioHasFS (FS.MountPoint benchTmpDir)
-    hasBlockIO <- FS.ioHasBlockIO hasFS ioctxps
+    hasBlockIO <- FS.ioHasBlockIO hasFS (fromMaybe FS.defaultIOCtxParams ioctxps)
     let wb = WB.WB storedKeys
         fsps = RunFsPaths 0
     r <- Run.fromWriteBuffer hasFS fsps wb

fs-api-blockio/src-linux/System/FS/BlockIO/Async.hs

@@ -26,9 +26,9 @@ import           System.IO.Error (ioeSetErrorString, isResourceVanishedError)
 import           System.Posix.Types
 
 -- | IO instantiation of 'HasBlockIO', using @blockio-uring@.
-asyncHasBlockIO :: HasFS IO HandleIO -> Maybe API.IOCtxParams -> IO (API.HasBlockIO IO HandleIO)
+asyncHasBlockIO :: HasFS IO HandleIO -> API.IOCtxParams -> IO (API.HasBlockIO IO HandleIO)
 asyncHasBlockIO hasFS ctxParams = do
-  ctx <- I.initIOCtx (maybe I.defaultIOCtxParams ctxParamsConv ctxParams)
+  ctx <- I.initIOCtx (ctxParamsConv ctxParams)
   pure $ API.HasBlockIO {
       API.close = I.closeIOCtx ctx
     , API.submitIO = submitIO hasFS ctx

fs-api-blockio/src-linux/System/FS/BlockIO/Internal.hs

@@ -15,7 +15,7 @@ import           System.FS.IO (HandleIO)
 
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> Maybe IOCtxParams
+  -> IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 #if SERIALBLOCKIO
 ioHasBlockIO hasFS _ = Serial.serialHasBlockIO hasFS

fs-api-blockio/src-macos/System/FS/BlockIO/Internal.hs

@@ -14,6 +14,6 @@ import           System.FS.IO (HandleIO)
 -- The recommended choice would be to use the POSIX AIO API.
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> Maybe IOCtxParams
+  -> IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 ioHasBlockIO hasFS _ = Serial.serialHasBlockIO hasFS

fs-api-blockio/src-windows/System/FS/BlockIO/Internal.hs

@@ -14,6 +14,6 @@ import           System.FS.IO (HandleIO)
 -- The recommended choice would be to use the Win32 IOCP API.
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> Maybe IOCtxParams
+  -> IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 ioHasBlockIO hasFS _ = Serial.serialHasBlockIO hasFS

fs-api-blockio/src/System/FS/BlockIO/API.hs

@@ -9,6 +9,7 @@
 module System.FS.BlockIO.API (
     HasBlockIO (..)
   , IOCtxParams (..)
+  , defaultIOCtxParams
   , mkClosedError
   , IOOp (..)
   , ioopHandle
@@ -64,6 +65,12 @@ data IOCtxParams = IOCtxParams {
                      ioctxConcurrencyLimit :: !Int
                    }
 
+defaultIOCtxParams :: IOCtxParams
+defaultIOCtxParams = IOCtxParams {
+      ioctxBatchSizeLimit   = 64,
+      ioctxConcurrencyLimit = 64 * 3
+    }
+
 mkClosedError :: HasCallStack => SomeHasFS m -> String -> FsError
 mkClosedError (SomeHasFS hasFS) loc = ioToFsError (mkFsErrorPath hasFS (mkFsPath [])) ioerr
   where ioerr =

fs-api-blockio/src/System/FS/BlockIO/IO.hs

@@ -10,6 +10,6 @@ import           System.FS.IO (HandleIO)
 -- | Platform-dependent IO instantiation of 'HasBlockIO'.
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> Maybe IOCtxParams
+  -> IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 ioHasBlockIO = I.ioHasBlockIO

fs-api-blockio/test/Main.hs

@@ -21,6 +21,7 @@ import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as VU
 import qualified System.FS.API as FS
 import           System.FS.API.Strict (hPutAllStrict)
+import qualified System.FS.BlockIO.API as FS
 import           System.FS.BlockIO.API
 import qualified System.FS.BlockIO.IO as IO
 import qualified System.FS.IO as IO
@@ -59,14 +60,14 @@ example_initClose :: Assertion
 example_initClose = withSystemTempDirectory "example_initClose" $ \dirPath -> do
     let mount = FS.MountPoint dirPath
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs Nothing
+    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
     close hbio
 
 example_closeIsIdempotent :: Assertion
 example_closeIsIdempotent = withSystemTempDirectory "example_closeIsIdempotent" $ \dirPath -> do
     let mount = FS.MountPoint dirPath
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs Nothing
+    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
     close hbio
     eith <- try @SomeException (close hbio)
     case eith of
@@ -79,7 +80,7 @@ prop_readWrite :: ByteString -> Property
 prop_readWrite bs = ioProperty $ withSystemTempDirectory "prop_readWrite" $ \dirPath -> do
     let mount = FS.MountPoint dirPath
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs Nothing
+    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
     prop <- FS.withFile hfs (FS.mkFsPath ["temp"]) (FS.WriteMode FS.MustBeNew) $ \h -> do
       let n = BS.length bs
       writeBuf <- fromByteStringPinned bs
@@ -98,7 +99,7 @@ prop_submitToClosedCtx :: ByteString -> Property
 prop_submitToClosedCtx bs = ioProperty $ withSystemTempDirectory "prop_a" $ \dir -> do
     let mount = FS.MountPoint dir
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs Nothing
+    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
 
     props <- FS.withFile hfs (FS.mkFsPath ["temp"]) (FS.WriteMode FS.MustBeNew) $ \h -> do
       void $ hPutAllStrict hfs h bs

test/Test/Database/LSMTree/Internal/Lookup.hs

@@ -282,7 +282,7 @@ prop_roundtripFromWriteBufferLookupIO ::
 prop_roundtripFromWriteBufferLookupIO dats =
     ioProperty $ withSystemTempDirectory "prop" $ \dir -> do
     let hasFS = FS.ioHasFS (MountPoint dir)
-    hasBlockIO <- FS.ioHasBlockIO hasFS Nothing
+    hasBlockIO <- FS.ioHasBlockIO hasFS FS.defaultIOCtxParams
     (runs, wbs) <- mkRuns hasFS
     let wbAll = WB.WB (Map.unionsWith (combine resolveV) (fmap WB.unWB wbs))
     real <- lookupsInBatches