WIP: Adding in fsync-like capabilities to HasBlockIO abstractions

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

@@ -35,15 +35,16 @@
   -> HasFS IO HandleIO
   -> API.IOCtxParams
   -> IO (API.HasBlockIO IO HandleIO)
-asyncHasBlockIO hSetNoCache hAdvise hAllocate tryLockFile hasFS ctxParams = do
+asyncHasBlockIO hSetNoCache hAdvise hAllocate hSynchronize tryLockFile hasFS ctxParams = do
   ctx <- I.initIOCtx (ctxParamsConv ctxParams)
   pure $ API.HasBlockIO {
       API.close = I.closeIOCtx ctx
     , API.submitIO = submitIO hasFS ctx
     , API.hSetNoCache
     , API.hAdvise
     , API.hAllocate
+    , API.hSynchronize
     , API.tryLockFile
     }
 
 ctxParamsConv :: API.IOCtxParams -> I.IOCtxParams
@@ -110,7 +111,7 @@
 --
 -- TODO: if the handle were to have a reader/writer lock, then we could take the
 -- reader lock in 'submitIO'. However, the current implementation of 'Handle'
--- only allows mutally exclusive access to the underlying file descriptor, so it
+-- only allows mutually exclusive access to the underlying file descriptor, so it
 -- would require a change in @fs-api@. See [fs-sim#49].
 handleFd :: Handle HandleIO -> IO Fd
 handleFd h = withOpenHandle "submitIO" (handleRaw h) pure

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

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module System.FS.BlockIO.Internal (
     ioHasBlockIO
   ) where
@@ -10,6 +12,7 @@ import qualified System.FS.BlockIO.Serial as Serial
 import           System.FS.IO (HandleIO)
 import qualified System.FS.IO.Handle as FS
 import qualified System.Posix.Fcntl.NoCache as Unix
+import qualified System.Posix.Unistd as Unix
 
 -- | For now we use the portable serial implementation of HasBlockIO. If you
 -- want to provide a proper async I/O implementation for OSX, then this is where
@@ -20,12 +23,22 @@ ioHasBlockIO ::
      HasFS IO HandleIO
   -> IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
-ioHasBlockIO hfs _params = Serial.serialHasBlockIO hSetNoCache hAdvise hAllocate (FS.tryLockFileIO hfs) hfs
+ioHasBlockIO hfs _params = Serial.serialHasBlockIO hSetNoCache hAdvise hAllocate hSynchronize (FS.tryLockFileIO hfs) hfs
 
 hSetNoCache :: Handle HandleIO -> Bool -> IO ()
 hSetNoCache h b =
   FS.withOpenHandle "hSetNoCache" (handleRaw h) (flip Unix.writeFcntlNoCache b)
 
+-- | Prefer @fdatasync@ over @fsync@ when available for greater throughput.
+hSynchronize :: Handle HandleIO -> IO ()
+hSynchronize h =
+  FS.withOpenHandle "hSynchronize" (handleRaw h)
+#if HAVE_FDATASYNC
+    Unix.fileSynchroniseDataOnly
+#else
+    Unix.fileSynchronise
+#endif
+
 -- TODO: it is unclear if MacOS supports @posix_fadvise(2)@, and it's hard to
 -- check because there are no manual pages online. For now, it's just hardcoded
 -- to be a no-op.

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

@@ -8,6 +8,7 @@
                      IOCtxParams)
 import qualified System.FS.BlockIO.Serial as Serial
 import           System.FS.IO (HandleIO)
+import qualified System.Win32.File as Win32
 
 -- | For now we use the portable serial implementation of HasBlockIO. If you
 -- want to provide a proper async I/O implementation for Windows, then this is
@@ -18,7 +19,7 @@
      HasFS IO HandleIO
   -> IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
-ioHasBlockIO hfs _params = Serial.serialHasBlockIO hSetNoCache hAdvise hAllocate (FS.tryLockFileIO hfs) hfs
+ioHasBlockIO hfs _params = Serial.serialHasBlockIO hSetNoCache hAdvise hAllocate hSynchronize (FS.tryLockFileIO hfs) hfs
 
 hSetNoCache :: Handle HandleIO -> Bool -> IO ()
 hSetNoCache _h _b = pure ()
@@ -28,3 +29,9 @@
 
 hAllocate :: Handle HandleIO -> FileOffset -> FileOffset -> IO ()
 hAllocate _h _off _len = pure ()
+
+-- | Make a best-effort attempt to utilize the @Win32@ package API to implement
+-- file buffering.
+hSynchronize :: Handle HandleIO -> IO ()
+hSynchronize h =
+  FS.withOpenHandle "hSynchronize" (handleRaw h) Win32.flushFileBuffers

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

@@ -94,6 +94,15 @@ data HasBlockIO m h = HasBlockIO {
     -- * [MacOS]: no-op.
     -- * [Windows]: no-op.
   , hAllocate :: Handle h -> FileOffset -> FileOffset -> m ()
+    -- | Synchronize file contents with storage device.
+    --
+    -- Ensure that all change to the file handle's contents which exist only in
+    -- memory (as buffered system cache pages) are transfered/flushed to disk.
+    -- This will also (partially) update the file handle's associated metadate.
+    -- On POSIX systems (including MacOS) this will likely involve call to either
+    -- @fsync(2)@ or @datasync(2)@. On Windows this will likely involve a call to
+    -- @flushFileBuffers@.
+  , hSynchronize :: Handle h -> m ()
     -- | Try to acquire a file lock without blocking.
     --
     -- This uses different locking methods on different distributions.
@@ -128,9 +137,9 @@ data HasBlockIO m h = HasBlockIO {
   }
 
 instance NFData (HasBlockIO m h) where
-  rnf (HasBlockIO a b c d e f) =
+  rnf (HasBlockIO a b c d e f g) =
       rwhnf a `seq` rwhnf b `seq` rnf c `seq`
-      rwhnf d `seq` rwhnf e `seq` rwhnf f
+      rwhnf d `seq` rwhnf e `seq` rwhnf f `seq` rwhnf g
 
 -- | Concurrency parameters for initialising a 'HasBlockIO. Can be ignored by
 -- serial implementations.

blockio-api/src/System/FS/BlockIO/Serial.hs

@@ -23,17 +23,19 @@ serialHasBlockIO ::
   => (Handle h -> Bool -> m ())
   -> (Handle h -> API.FileOffset -> API.FileOffset -> API.Advice -> m ())
   -> (Handle h -> API.FileOffset -> API.FileOffset -> m ())
+  -> (Handle h -> m ())
   -> (FsPath -> LockMode -> m (Maybe (API.LockFileHandle m)))
   -> HasFS m h
   -> m (API.HasBlockIO m h)
-serialHasBlockIO hSetNoCache hAdvise hAllocate tryLockFile hfs = do
+serialHasBlockIO hSetNoCache hAdvise hAllocate hSynchronize tryLockFile hfs = do
   ctx <- initIOCtx (SomeHasFS hfs)
   pure $ API.HasBlockIO {
       API.close = close ctx
     , API.submitIO = submitIO hfs ctx
     , API.hSetNoCache
     , API.hAdvise
     , API.hAllocate
+    , API.hSynchronize
     , API.tryLockFile
     }
 

blockio-sim/src/System/FS/BlockIO/Sim.hs

@@ -27,7 +27,7 @@ fromHasFS ::
   => HasFS m HandleMock
   -> m (HasBlockIO m HandleMock)
 fromHasFS hfs =
-    serialHasBlockIO hSetNoCache hAdvise hAllocate (simTryLockFile hfs) hfs
+    serialHasBlockIO hSetNoCache hAdvise hAllocate hSynchronize (simTryLockFile hfs) hfs
   where
     -- TODO: It should be possible for the implementations and simulation to
     -- throw an FsError when doing file I/O with misaligned byte arrays after
@@ -36,6 +36,7 @@ fromHasFS hfs =
     hSetNoCache _h _b = pure ()
     hAdvise _ _ _ _ = pure ()
     hAllocate _ _ _ = pure ()
+    hSynchronize _ = pure ()
 
 -- | Lock files are reader\/writer locks.
 --

lsm-tree.cabal

@@ -761,11 +761,15 @@ library blockio-api
 
   elif os(osx)
     hs-source-dirs: blockio-api/src-macos
-    build-depends:  lsm-tree:fcntl-nocache
+    build-depends:
+      , lsm-tree:fcntl-nocache
+      , unix                    ^>=2.8
+
     other-modules:  System.FS.BlockIO.Internal
 
   elif os(windows)
     hs-source-dirs: blockio-api/src-windows
+    build-depends:  Win32 >=2.13 && <3.0
     other-modules:  System.FS.BlockIO.Internal
 
   if flag(serialblockio)