Example how to copy a file very fast in Haskell using the sendfile() Linux system call. Requires Linux >= 2.6.33

sendfile.hsc

-- Tested on Stackage nightly-2017-01-25.

{-# LANGUAGE ForeignFunctionInterface #-}

module Main (main) where

import Control.Exception (bracket)
import Control.Monad (when)
import Foreign
import Foreign.C.Error
import Foreign.C.Types
import System.Posix.Files
import System.Posix.IO
import System.Posix.Types

#define _LARGEFILE64_SOURCE 1
#include <sys/types.h>
#include <stdio.h>
#include <sys/sendfile.h>


-- sendfile64 gives LFS support
foreign import ccall unsafe "sendfile64" c_sendfile64
    :: Fd -> Fd -> Ptr (#type off64_t) -> (#type size_t) -> IO (#type ssize_t)

-- | See `openFd`.
withFileAsFd :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> (Fd -> IO r) -> IO r
withFileAsFd name mode createMode flags =
  bracket (openFd name mode createMode flags) closeFd

-- | Copies a file using the `sendfile()` system call.
--
-- Consequently, it resolves symlinks.
--
-- Preserves the mode (permissions) of the source file (if the target file
-- doesn't exist and is created), but doesn't preserve ownership.
copyFileSendfile :: FilePath -> FilePath -> FileMode -> IO ()
copyFileSendfile fromFilePath toFilePath toFileCreateMode =  do
  -- Note: We don't use `Handle`s here, because we need FDs, and `handleToFd`
  -- leaks the FD unless we close it manually (which doesn't go well with
  -- exception safety, so we have `withFileAsFd` instead).
  withFileAsFd fromFilePath ReadOnly Nothing defaultFileFlags $ \in_fd -> do
    fileSizeBytes <- fromIntegral . fileSize <$> getFileStatus fromFilePath
    withFileAsFd toFilePath WriteOnly (Just toFileCreateMode) defaultFileFlags{ trunc = True } $ \out_fd -> do
      let loop :: Int -> IO ()
          loop bytesWritten = do
            copied <- throwErrnoIfMinus1Retry "sendfile64" $ c_sendfile64 out_fd in_fd nullPtr (fromIntegral fileSizeBytes)
            let bytesWrittenNew = bytesWritten + fromIntegral copied
            when (bytesWrittenNew < fileSizeBytes) $
              loop bytesWrittenNew
      loop 0

-- | Like `copyFileSendfile`, but creates the file with the user's umask.
copyFileSendfileCopyCreateMode :: FilePath -> FilePath -> IO ()
copyFileSendfileCopyCreateMode fromFilePath toFilePath = do
  toFileCreateMode <- fileMode <$> getFileStatus fromFilePath
  copyFileSendfile fromFilePath toFilePath toFileCreateMode

-- | Like `copyFileSendfile`, but creates the file with the user's umask.
--
-- Note the default umask is often 002 which makes the create file be created
-- with execute permissions by default, which is often not desired.
copyFileSendfileUmask :: FilePath -> FilePath -> IO ()
copyFileSendfileUmask fromFilePath toFilePath = do
  -- Note: `accessModes` is `chmod 777`, but this get's `&`ed with the user's
  -- `umask`, so this is simply the user's umask.
  copyFileSendfile fromFilePath toFilePath accessModes

main :: IO ()
main = do
  -- Create `testfile` with e.g.
  --   dd if=/dev/zero of=testfile bs=1M count=1000
  copyFileSendfileCopyCreateMode "testfile" "testfile2"