{-# LINE 1 "src/Network/Socket/Splice.hsc" #-}
{- |
{-# LINE 2 "src/Network/Socket/Splice.hsc" #-}
  This library implements efficient socket to socket
  data transfer loops for proxy servers.
               
   On Linux, it uses the zero-copy splice() system call:
   <http://kerneltrap.org/node/6505>.

   On all other operating systems, it currently falls back
   to a portable Haskell implementation that allocates a
   constant-sized memory buffer before it enters an inner
   loop which then uses hGetBufSome and hPutBuf; this avoids
   lots of tiny allocations as would otherwise be caused by
   recv and sendAll functions from Network.Socket.ByteString.
-}
--  
-- Module      : Network.Socket.Splice
-- Copyright   : (c) Cetin Sert 2012
-- License     : BSD-style
-- Maintainer  : fusion@corsis.eu
-- Stability   : stable
-- Portability : GHC-only, works on all OSes


{-# LINE 24 "src/Network/Socket/Splice.hsc" #-}

{-# LINE 25 "src/Network/Socket/Splice.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}

{-# LINE 28 "src/Network/Socket/Splice.hsc" #-}

module Network.Socket.Splice (

  -- * Cross-platform API for Socket to Socket Data Transfer Loops
  {- | 'splice' is the cross-platform API for continous, uni-directional
       data transfer between two network sockets.

       It is an /infinite loop/ that is intended to be used with
       'Control.Concurrent.forkIO':

       > void . forkIO . try_ $ splice 1024 sourceSocket targetSocket
       > void . forkIO . try_ $ splice 1024 targetSocket sourceSocket
  -}

    splice
  , ChunkSize
  , zeroCopy

  -- * Combinators for Exception Handling
  , try_


  -- * Linux splice() Components
  {- | These are available only on Linux and
       will be moved to a different namespace
       in later releases. Their names will stay
       the same.
  -}


{-# LINE 58 "src/Network/Socket/Splice.hsc" #-}
  , c_splice
  , sPLICE_F_MOVE
  , sPLICE_F_MORE
  , sPLICE_F_NONBLOCK

{-# LINE 63 "src/Network/Socket/Splice.hsc" #-}

  ) where

import Data.Word
import Foreign.Ptr

import Network.Socket
import Control.Monad
import Control.Exception
import System.IO
import System.Posix.Types
import System.Posix.Internals
import GHC.IO.Handle.FD


{-# LINE 78 "src/Network/Socket/Splice.hsc" #-}
import Data.Int
import Data.Bits
import Unsafe.Coerce
import Foreign.C.Types
import Foreign.C.Error
import System.Posix.IO

{-# LINE 87 "src/Network/Socket/Splice.hsc" #-}


-- | Indicates whether 'splice' uses zero-copy system calls
--   or the portable user mode Haskell substitue implementation.
zeroCopy :: Bool -- ^ True: uses zero-copy system calls; otherwise: portable.
zeroCopy =

{-# LINE 94 "src/Network/Socket/Splice.hsc" #-}
  True

{-# LINE 98 "src/Network/Socket/Splice.hsc" #-}


--------------------------------------------------------------------------------

-- | The numeric type used to recommend chunk sizes for moving
--   data between sockets used by both the Linux 'splice' and
--   the portable implementation of 'splice'.
type ChunkSize =

{-# LINE 107 "src/Network/Socket/Splice.hsc" #-}
  (Word32)
{-# LINE 108 "src/Network/Socket/Splice.hsc" #-}

{-# LINE 111 "src/Network/Socket/Splice.hsc" #-}


-- | Pipes data from one socket to another in an
--   **infinite loop**.
--
--   On Linux this happens in kernel space with
--   zero copying between kernel and user spaces.
--
--   On other operating systems, a portable
--   implementation utilizes a user space buffer
--   and works on handles instead of file descriptors.
splice
  :: ChunkSize -- ^ Chunk size.
  -> Socket    -- ^ Source socket.
  -> Socket    -- ^ Target socket.
  -> IO ()     -- ^ Infinite loop.
splice len sIn sOut = do

  let throwRecv0 = error "Network.Socket.Splice.splice ended"

  let fdIn  = fdSocket sIn
  let fdOut = fdSocket sOut 


{-# LINE 135 "src/Network/Socket/Splice.hsc" #-}

  print "LINUX-SPLICE"

  (r,w) <- createPipe     -- r: read  end of pipe
  print ('+',r,w)         -- w: write end of pipe
  let s = Fd fdIn         -- s: source socket
  let t = Fd fdOut        -- t: target socket
  let n = nullPtr  
  let u = unsafeCoerce :: (Int32) -> (Word32)
{-# LINE 144 "src/Network/Socket/Splice.hsc" #-}
  let check = throwErrnoIfMinus1 "Network.Socket.Splice.splice"
  let flags = sPLICE_F_MOVE .|. sPLICE_F_MORE
  let setNonBlockingMode v = do setNonBlockingFD fdIn  v
                                setNonBlockingFD fdOut v

  setNonBlockingMode False
  finally
    (forever $ do 
       bytes <- check $ c_splice s n w n    len    flags
       if bytes > 0
         then           c_splice r n t n (u bytes) flags
         else           throwRecv0)
    (do closeFd r
        closeFd w
        try_ $ setNonBlockingMode True
        print ('-',r,w))


{-# LINE 182 "src/Network/Socket/Splice.hsc" #-}


-- | Similar to 'Control.Exception.Base.try' but used when an
--   obvious exception is expected whose type can be safely
--   ignored.
try_
  :: IO () -- ^ The action to run which can throw any exception.
  -> IO () -- ^ The new action where exceptions are silenced.
try_ a = (try a :: IO (Either SomeException ())) >> return ()


--------------------------------------------------------------------------------



{-# LINE 197 "src/Network/Socket/Splice.hsc" #-}
-- SPLICE

-- fcntl.h
-- ssize_t splice(
--   int          fd_in,
--   loff_t*      off_in,
--   int          fd_out,
--   loff_t*      off_out,
--   size_t       len,
--   unsigned int flags
-- );

-- | 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
--   file descriptor 'fd_out', where one of the
--   descriptors must refer to a pipe.
--
--   'c_splice' is NOT a loop and needs to called repeatedly.
--   For an example, see the source code of 'splice'.
foreign import ccall "splice"
  c_splice
  :: Fd                  -- ^ fd_in
  -> Ptr (Int64)  -- ^ off_in
{-# LINE 222 "src/Network/Socket/Splice.hsc" #-}
  -> Fd                  -- ^ fd_out
  -> Ptr (Int64)  -- ^ off_out
{-# LINE 224 "src/Network/Socket/Splice.hsc" #-}
  -> (Word32)      -- ^ len
{-# LINE 225 "src/Network/Socket/Splice.hsc" #-}
  -> Word                -- ^ flags
  -> IO (Int32)  -- ^ number of bytes moved or -1 on error
{-# LINE 227 "src/Network/Socket/Splice.hsc" #-}


-- | Attempt to move pages instead of copying. This is
--   only a hint to the kernel: pages may stil be copied
--   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 = (134522833)
{-# LINE 235 "src/Network/Socket/Splice.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 = (134523015)
{-# LINE 242 "src/Network/Socket/Splice.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 = (134523323)
{-# LINE 251 "src/Network/Socket/Splice.hsc" #-}


{-# LINE 253 "src/Network/Socket/Splice.hsc" #-}