{-# LINE 1 "src/System/Socket/Unsafe.hsc" #-}
module System.Socket.Unsafe (
{-# LINE 2 "src/System/Socket/Unsafe.hsc" #-}
  -- * tryWaitAndRetry
    tryWaitAndRetry
  -- * unsafeSend
  , unsafeSend
  -- * unsafeSendTo
  , unsafeSendTo
  -- * unsafeReceive
  , unsafeReceive
  -- * unsafeReceiveFrom
  , unsafeReceiveFrom
  ) where

import Data.Function
import Data.Monoid

import Control.Monad
import Control.Exception
import Control.Concurrent.MVar

import Foreign.C.Types
import Foreign.Ptr

import System.Socket.Internal.Socket
import System.Socket.Internal.Platform
import System.Socket.Internal.Exception
import System.Socket.Internal.Message
import System.Socket.Family

import System.Posix.Types (Fd)


{-# LINE 33 "src/System/Socket/Unsafe.hsc" #-}

unsafeSend :: Socket a t p -> Ptr a -> CSize -> MessageFlags -> IO CInt
unsafeSend s bufPtr bufSize flags = do
  tryWaitAndRetry s socketWaitWrite' (\fd-> c_send fd bufPtr bufSize (flags `mappend` msgNoSignal) )

unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> CInt -> IO CInt
unsafeSendTo s bufPtr bufSize flags addrPtr addrSize = do
  tryWaitAndRetry s socketWaitWrite' (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNoSignal) addrPtr addrSize)

unsafeReceive :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt
unsafeReceive s bufPtr bufSize flags =
  tryWaitAndRetry s socketWaitRead' (\fd-> c_recv fd bufPtr bufSize flags)

unsafeReceiveFrom :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> Ptr CInt -> IO CInt
unsafeReceiveFrom s bufPtr bufSize flags addrPtr addrSizePtr = do
  tryWaitAndRetry s socketWaitRead' (\fd-> c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr)

tryWaitAndRetry :: Socket f t p -> (Fd -> Int-> IO (IO ())) -> (Fd -> IO CInt) -> IO CInt
tryWaitAndRetry (Socket mfd) getWaitAction action = loop 0
  where
    loop iteration = do
      ewr <- withMVar mfd $ \fd-> do
          when (fd < 0) $ do
            throwIO eBadFileDescriptor
          fix $ \retry-> do
            i <- action fd
            if (i < 0) then do
              e <- c_get_last_socket_error
              if e == eWouldBlock || e == eAgain then do
                getWaitAction fd iteration >>= return . Left
              else if e == eInterrupted
                then retry
                else throwIO e
            else do
              -- The following is quite interesting for debugging:
              -- when (iteration /= 0) (print iteration)
              return (Right i)
      case ewr of
        Left  wait   -> do
          wait
          loop $! iteration + 1
        Right result -> do
          return result