cow (empty) → 0.1.0.0

raw patch · 5 files changed

+292/−0 lines, 5 filesdep +Win32dep +basedep +cow

Dependencies added: Win32, base, cow, directory, tasty, tasty-hunit, unix

Files

CHANGELOG.md +5/−0
LICENSE +20/−0
cow.cabal +41/−0
src/System/IO/Copy.hs +168/−0
test/Main.hs +58/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for cow++## 0.1.0.0 -- 2026-04-30++* Linux, Windows, and Darwin support.

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2026 AgentM++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ cow.cabal view

@@ -0,0 +1,41 @@+cabal-version:      3.0+name:               cow+version:            0.1.0.0+synopsis:           Cross-platform file copy-on-write+-- description:+homepage:           https://github.com/agentm/cow+license:            MIT+license-file:       LICENSE+author:             AgentM+maintainer:         agentm@themactionfaction.com+category:           System+build-type:         Simple+extra-doc-files:    CHANGELOG.md++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  System.IO.Copy+    build-depends:    base ^>=4.18.3.0+    if os(linux)+       Build-Depends: unix+    if os(windows)+      Build-Depends: Win32 >= 2.12+    hs-source-dirs:   src+    default-language: Haskell2010++test-suite cow-test+    import:           warnings+    default-language: Haskell2010+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base ^>=4.18.3.0,+        cow,+        tasty,+        tasty-hunit,+        directory+

+ src/System/IO/Copy.hs view

@@ -0,0 +1,168 @@+{-# LANGUAGE CPP #-}+-- Cross-platform copy-on-write file semantics.+module System.IO.Copy +  (copyFile+#if linux_HOST_OS || darwin_HOST_OS+   ,copyFileOnlyIfCopyOnWrite+   ,CopyError(..)+#endif+  ) where+import Foreign.C.Error (Errno(..))+#if defined(mingw32_HOST_OS)+-- WINDOWS+import qualified System.Win32.File as Win32+# if defined(i386_HOST_ARCH)+#  define WINDOWS_CCONV stdcall+# elif defined(x86_64_HOST_ARCH)+#  define WINDOWS_CCONV ccall+# endif+#else+-- LINUX+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.C.Types+import System.IO (Handle, IOMode(..), openFile)+import Control.Exception (throwIO)+import System.Posix.Types (Fd(..))+import System.Posix.IO (handleToFd, closeFd)+import Foreign.C.Error (getErrno, eBADF, eFAULT, eNOTTY, eTXTBSY, eISDIR, eXDEV, eOPNOTSUPP, ePERM, eINVAL, errnoToIOError)+#endif++#if linux_HOST_OS+-- | True if the function should fallback on non-copy-on-write semantics if copy-on-write is not possible.+type CopyFallback = Bool++-- | Copy data from one handle to the other hopefully using copy-on-write semantics, but fallback to generic copy if copy-on-write fails.+copyHandle :: CopyFallback -> Handle -> Handle -> IO (Either CopyError ())+copyHandle fallback source dest = do+  sourceFd <- handleToFd source+  destFd <- handleToFd dest+  ret <- ficlone destFd sourceFd+  errno <- getErrno+  let convertError errno'+        | errno' `elem` [eBADF, ePERM, eTXTBSY] =+          InvalidFileDescriptorError errno'+      convertError errno'+        | errno' `elem` [eXDEV] =+          CrossFSWriteError errno'+      convertError errno'+        | errno' `elem` [eINVAL, eISDIR, eOPNOTSUPP] =+          NotSupportedError errno'+      convertError errno' =+        InvalidFileDescriptorError errno'+      cleanup = do+        closeFd sourceFd+        closeFd destFd+  if ret /= 0 then do+    if fallback then do+      if errno `elem` [eBADF, eFAULT, eNOTTY, eTXTBSY, eISDIR, ePERM] then do+        cleanup+        pure (Left (convertError errno))+      else do --EINVAL or EOPNOTSUPP or EXDEV, so perform fallback+        result <- copy_file_range sourceFd destFd+        if result < 0 then do+          err <- getErrno+          cleanup+          pure (Left (FallbackCopyError err))+        else do+          cleanup+          pure (Right ())+    else do+      cleanup+      pure (Left (convertError errno))+  else do+    cleanup+    pure (Right ())+#elif darwin_HOST_OS+  res <- clonefile source dest+  if res < 0 then do+    -- on darwin, there is no fallback- we just assume APFS as the filesystem+    pure (Left (FallbackCopyError (Errno 0)))+  else+    pure (Right ())+#elif mingw32_HOST_OS+#endif++copyFile :: FilePath -> FilePath -> IO ()+copyFile sourcePath destPath = do+  -- call copyHandle on Linux and Darwin+#if linux_HOST_OS || darwin_HOST_OS+  sourceHandle <- openFile sourcePath ReadMode +  destHandle <- openFile destPath WriteMode +  res <- copyHandle True sourceHandle destHandle+  case res of+    Left err -> throwIO $ errnoToIOError "copyFile (CoW)" (errnoFromCopyError err) Nothing Nothing+    Right () -> pure ()+#else +  -- on Windows, copyFile will use CoW where available which is only on ReFS+  Win32.copyFile sourcePath destPath False+#endif+  +data CopyError =+  CrossFSWriteError Errno |+  InvalidFileDescriptorError Errno |+  NotSupportedError Errno |+  FallbackCopyError Errno+  deriving (Eq)++instance Show CopyError where+  show e =+    case e of+      CrossFSWriteError (Errno errno) -> "CrossFSWriteError " <> show errno+      InvalidFileDescriptorError (Errno errno) -> "InvalidFileDescriptorError " <> show errno+      NotSupportedError (Errno errno) -> "NotSupportedError " <> show errno+      FallbackCopyError (Errno errno) -> "FallbackCopyError " <> show errno++#if linux_HOST_OS || darwin_HOST_OS+errnoFromCopyError :: CopyError -> Errno+errnoFromCopyError e =+  case e of+    CrossFSWriteError e' -> e'+    InvalidFileDescriptorError e' -> e'+    NotSupportedError e' -> e'+    FallbackCopyError e' -> e'++copyFileOnlyIfCopyOnWrite :: FilePath -> FilePath -> IO (Either CopyError ())+copyFileOnlyIfCopyOnWrite sourcePath destPath = do+  sourceHandle <- openFile sourcePath ReadMode +  destHandle <- openFile destPath WriteMode +  copyHandle False sourceHandle destHandle+#endif++#ifdef linux_HOST_OS+-- LINUX ONLY+-- FICLONE ioctl number. Common value for x86_64 Linux (from linux/fs.h):+-- #define FICLONE        _IOW(0x94, 9, int)+-- Encoded here as 0x40049409 (unsigned long)+-- If this doesn't work on your architecture, check <linux/fs.h>.+ficlone_ioctl :: CULong+ficlone_ioctl = 0x40049409++foreign import ccall unsafe "ioctl"+  c_ioctl :: CInt -> CULong -> CInt -> IO CInt++-- wrapper: perform ioctl with fdDst, FICLONE, fdSrc+ficlone :: Fd -> Fd -> IO CInt+ficlone (Fd fdDst) (Fd fdSrc) = do+  -- third arg should be the source fd cast to unsigned long / int as expected by kernel+  let arg = fromIntegral fdSrc :: CInt+  --throwErrnoIfMinus1_ "ioctl(FICLONE)" $+  c_ioctl (fromIntegral fdDst) ficlone_ioctl arg++foreign import ccall unsafe "copy_file_range"+  c_copy_file_range :: CInt -> Ptr CULong -> CInt -> Ptr CULong -> CULong -> CUInt -> IO CLong++copy_file_range :: Fd -> Fd -> IO CLong+copy_file_range (Fd fdSource) (Fd fdDest) =+  c_copy_file_range (fromIntegral fdSource) nullPtr (fromIntegral fdDest) nullPtr maxBound 0++#elif darwin_HOST_OS+foreign import ccall unsafe "clonefile"+  c_clonefile :: CString -> CString -> IO CInt++clonefile :: FilePath -> FilePath -> IO CInt+clonefile sourcePath destPath =+  withCString sourcePath $ \cSourcePath ->+    withCString destPath $ \cDestPath ->+      c_clonefile cSourcePath cDestPath++#endif

+ test/Main.hs view

@@ -0,0 +1,58 @@+{-# LANGUAGE CPP #-}+import Test.Tasty+import Test.Tasty.HUnit+import System.IO.Copy+#if linux_HOST_OS || darwin_HOST_OS+import Foreign.C.Error (Errno(..))+#endif+import System.Directory (removeFile)++main :: IO ()+main = defaultMain tests++tests :: TestTree+#if linux_HOST_OS || darwin_HOST_OS+tests = testGroup "CoW" [+  testCase "mandatory CoW" testMandatoryCoW,+  testCase "optional CoW" testOptionalCoW+  ]+#else+tests = testGroup "CoW" [+  testCase "optional CoW" testOptionalCoW+  ]+#endif++#if linux_HOST_OS || darwin_HOST_OS+testMandatoryCoW :: Assertion+testMandatoryCoW = do+  -- btrfs/xfs+  let source1 = "test/cow_source.txt"+      dest1 = "test/cow_dest.txt"+      cow_data = "COW DATA"+  writeFile source1 cow_data+  result1 <- copyFileOnlyIfCopyOnWrite source1 dest1+  assertEqual "copyFileOnlyIfCopyOnWrite" (Right ()) result1+  dest1Data <- readFile dest1+  assertEqual "mandatory cow data" cow_data dest1Data+  removeFile source1+  removeFile dest1++  -- ext4+  let source2 = "/tmp/cow_source.txt"+      dest2 = "/tmp/cow_dest.txt"+  writeFile source2 "COW DATA"+  result2 <- copyFileOnlyIfCopyOnWrite source2 dest2+  assertEqual "copyFileOnlyIfCopyOnWrite expected failure" (Left (NotSupportedError (Errno 95))) result2  +#endif++testOptionalCoW :: Assertion+testOptionalCoW = do+  let source1 = "cow_source_opt.txt"+      dest1 = "cow_dest_opt.txt"+      cow_data = "COW_DATA"+  writeFile source1 cow_data+  copyFile source1 dest1+  dest1Data <- readFile dest1+  assertEqual "optional cow data" cow_data dest1Data+  removeFile source1+  removeFile dest1