{-# LINE 1 "src/Network/Socket/Splice/Internal.hsc" #-}
-- | Implementation.
{-# LINE 2 "src/Network/Socket/Splice/Internal.hsc" #-}
--
-- Module      : Network.Socket.Splice.Internal
-- Copyright   : (c) Cetin Sert 2012
-- License     : BSD3
-- Maintainer  : fusion@corsis.eu
-- Stability   : stable
-- Portability : works on all operating systems



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


module Network.Socket.Splice.Internal (

  -- * 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.

       'splice' and its implementation primitives 'hSplice' and 'fdSplice' are
       /infinite/ loops that are intended to be used with
       'Control.Concurrent.forkIO' and exception handlers. 'splice' is a
       terminal operation; it cannot be interleaved by other IO operations on
       its sockets or handles.

       [Initiate bi-directional continuous data transfer between two sockets:]
    
       > void . forkIO . tryWith handler $! splice void 1024 (sourceSocket, _) (targetSocket, _)
       > void . forkIO . tryWith handler $! splice void 1024 (targetSocket, _) (sourceSocket, _)

       where @handler@ is an IO operation that would do the necessary clean up –
       such as ensuring the sockets are closed and any resources that may be
       associated with the sockets are properly disposed of.

       [Notes]

         * 'System.IO.Splice.Linux.c_splice', the Linux-only system call, is not
           a terminal infinite loop and can be safely interleaved by other IO
           operations on sockets or socket handles.
  -}

    splice
  , ChunkSize
  , zeroCopy

  -- * Combinators for Exception Handling
  , tryWith
  , try_

  -- * Implementation Primitives
  {- | Infinite loops used in the cross-platform implementation of 'splice'. -}

  , hSplice

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

  ) where


import Data.Word
import Foreign.Ptr

import System.IO
import Network.Socket
import Control.Monad
import Control.Exception
import Foreign.Marshal.Alloc


{-# LINE 84 "src/Network/Socket/Splice/Internal.hsc" #-}
import Data.Maybe

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


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


-- | Indicates whether 'splice' uses zero-copy system calls or the portable user
--   space Haskell implementation.
zeroCopy :: Bool -- ^ @True@ if 'splice' uses zero-copy system calls; otherwise, false.
zeroCopy =

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

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


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

{-# LINE 108 "src/Network/Socket/Splice/Internal.hsc" #-}
  Int

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


----------------------------------------------------------------------------------------------SPLICE


-- | Pipes data from one socket to another in an /infinite loop/.
--
--   'splice' currently has two implementations:
--
--   [on GNU\/Linux using 'fdSplice' ≅]
--
--   > splice len (sIn, _       ) (sOut, _        ) = ... fdSplice ...
--
--   [on all other operating systems using 'hSplice' ≅]
--
--   > splice len (_  , Just hIn) (_   , Just hOut) = ... hSplice  ...
--
--   [Notes]
--
--     * 'fdSplice' and 'fdSplice' implementation of 'splice' are only available
--        on GNU\/Linux.
--
--     * 'hSplice' is always available and the 'hSplice' implementation of
--       'splice' can be forced on GNU\/Linux by defining the @portable@ flag at
--       compile time.
--
--     * 'hSplice' implementation requires handles in 'NoBuffering' mode.
--
--     * 'splice' is a terminal loop on two sockets and once entered its sockets
--        and handles cannot be interleaved by other IO operations.
--
splice
  :: ChunkSize               -- ^ maximal chunk size.
  -> (Socket, Maybe Handle)  -- ^ source socket and possibly its opened handle.
  -> (Socket, Maybe Handle)  -- ^ target socket and possibly its opened handle.
  -> IO ()                   -- ^ infinite loop.

{-# LINE 149 "src/Network/Socket/Splice/Internal.hsc" #-}
splice len (_  , hIn) (_   , hOut) = do

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

{-# LINE 156 "src/Network/Socket/Splice/Internal.hsc" #-}
  let s = fromJust hIn
  let t = fromJust hOut
  hSplice (fromIntegral len) s t

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


--------------------------------------------------------------------------------------------FDSPLICE



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


---------------------------------------------------------------------------------------------HSPLICE


{- | The portable Haskell loop.

       1. allocates a /single/ memory buffer in user address space

       2. uses it until the loop terminates by exception

       3. frees the buffer and returns

   [Notes]

     * the socket handles are required to be in 'NoBuffering' mode.
-} 
hSplice :: Int -> Handle -> Handle -> IO ()
hSplice len s t = do

  a <- mallocBytes len :: IO (Ptr Word8)

  finally
    (forever $! do
       bytes   <- hGetBufSome s a len
       if bytes > 0
         then     hPutBuf     t a bytes
         else     throwRecv0)
    (free a)


------------------------------------------------------------------------------------------EXCEPTIONS


-- | Similar to 'Control.Exception.Base.try' but used when an obvious exception
--   is expected and can be handled easily. Unlike 'finally' exceptions are
--   /NOT/ rethrown once handled.
tryWith
  :: (SomeException -> IO a) -- ^ exception handler.
  -> IO a                    -- ^ action to run which can throw /any/ exception.
  -> IO a                    -- ^ new action where all exceptions are handled by the single handler.
tryWith h a = try a >>= \r -> case r of Left x -> h x; Right y -> return y


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


throwRecv0 :: a
throwRecv0 = error "Network.Socket.Splice.splice ended"