{-# LINE 1 "src/System/IO/Splice/Linux.hsc" #-}
{- | Exposes the GNU\/Linux system call @splice()@.
{-# LINE 2 "src/System/IO/Splice/Linux.hsc" #-}

     /This module is only available (compiled & exposed) on Linux./
-}
--  
-- Module      : Network.Socket.Splice
-- Copyright   : (c) Cetin Sert 2012
-- License     : BSD3
-- Maintainer  : fusion@corsis.eu
-- Stability   : stable
-- Portability : GNU\/Linux-only


{-# LINE 14 "src/System/IO/Splice/Linux.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module System.IO.Splice.Linux (

    c_splice
  , ChunkSize
  , sPLICE_F_MOVE
  , sPLICE_F_MORE
  , sPLICE_F_NONBLOCK

  ) where


import Data.Int
import Data.Word
import Foreign.Ptr
import Foreign.C.Types
import System.Posix.Types


-- | The numeric type used by 'c_splice' for chunk size recommendations when
--   moving data.
type ChunkSize = (Word32)
{-# LINE 38 "src/System/IO/Splice/Linux.hsc" #-}

-- | Moves data between two file descriptors without copying between kernel
--   address space and user address space. It transfers up to 'len' bytes of
--   data from the file descriptor 'fd_in' to the file descriptor 'fd_out',
--   where one of the descriptors must refer to a pipe.
--
--   'c_splice' is /NOT/ a loop and needs to be called repeatedly.
--
--   For an example, see 'Network.Socket.Splice.Internal.splice'.
foreign import ccall "splice"
  c_splice
  :: Fd                  -- ^ @fd_in@.
  -> Ptr (Int64)  -- ^ @off_in@.
{-# LINE 51 "src/System/IO/Splice/Linux.hsc" #-}
  -> Fd                  -- ^ @fd_out@.
  -> Ptr (Int64)  -- ^ @off_out@.
{-# LINE 53 "src/System/IO/Splice/Linux.hsc" #-}
  -> ChunkSize           -- ^ @len@.
  -> Word                -- ^ @flags@.
  -> IO (Int32)  -- ^ number of bytes moved if successful; otherwise -1.
{-# LINE 56 "src/System/IO/Splice/Linux.hsc" #-}


-- | Attempt to move pages instead of copying. This is only a hint to the
--   kernel: pages may stil be copied (/in kernel address space/) if the kernel
--   cannot move the pages from the pipe, or if the pipe buffers don't refer to
--   full pages.
sPLICE_F_MOVE :: Word
sPLICE_F_MOVE = (134517817)
{-# LINE 64 "src/System/IO/Splice/Linux.hsc" #-}


-- | More data will be coming in a subsequent splice. This is a helpful hint
--   when 'fd_out' refers to a socket.
sPLICE_F_MORE :: Word
sPLICE_F_MORE = (134517994)
{-# LINE 70 "src/System/IO/Splice/Linux.hsc" #-}


-- | Do not block on I\/O. This makes the splice pipe operations nonblocking,
--   but splice() may nevertheless block because the file descriptors that are
--   spliced to\/from may block (unless they have the O_NONBLOCK flag set).
sPLICE_F_NONBLOCK :: Word
sPLICE_F_NONBLOCK = (134518291)
{-# LINE 77 "src/System/IO/Splice/Linux.hsc" #-}