{-# LINE 1 "Network/Socket/ByteString.cpphs" #-}
# 1 "Network/Socket/ByteString.cpphs"
# 1 "<built-in>"
# 1 "<command-line>"
# 13 "<command-line>"
# 1 "./dist/build/autogen/cabal_macros.h" 1


























# 13 "<command-line>" 2
# 1 "Network/Socket/ByteString.cpphs"
{-# OPTIONS_GHC -cpp #-}

-- |
-- Module      : Network.Socket.ByteString
-- Copyright   : (c) Johan Tibell 2007
-- License     : BSD-style
--
-- Maintainer  : johan.tibell@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- | A module for efficiently transmitting data over sockets. For
-- detailed documentation consult your favorite POSIX socket
-- reference. All functions communicate failures by converting the
-- error number to an 'System.IO.IOError'.
--
-- This module is intended to be imported together with 'Network.Socket' like so:
--
-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)
-- > import Network.Socket.ByteString
--
module Network.Socket.ByteString
    (
     -- * Send a message on a socket
     -- | Functions used to transmit a message to another socket.
     send,
     sendTo,

     -- * Receive a message from a socket
     -- | Functions used to receive messages from a socket, and may be
     -- used to receive data on a socket whether or not it is
     -- connection-oriented.
     recv,
     recvFrom
    ) where

import Control.Monad (liftM)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Internal (create)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Foreign.C.Error
import Foreign.C.Types (CChar, CInt, CSize)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr, castPtr)
import Network.Socket (SockAddr, Socket(..), sendBufTo, recvBufFrom)


import GHC.Conc (threadWaitRead, threadWaitWrite)
import GHC.IOBase (IOErrorType(..), IOException(..))














foreign import ccall unsafe "send"
  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "recv"
  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt

-- -----------------------------------------------------------------------------
-- Sending

-- | Transmit a message to another socket. The socket must be in a
-- connected state so that the intended recipient is known.
send :: Socket      -- ^ Bound\/Connected socket.
     -> ByteString  -- ^ Data to send.
     -> IO Int      -- ^ Number of bytes sent.
send (MkSocket s _family _stype _protocol status) xs = do
  unsafeUseAsCStringLen xs $ \(str, len) -> do
    liftM fromIntegral $





     throwErrnoIfMinus1Retry_repeatOnBlock "send"
        (threadWaitWrite (fromIntegral s)) $

        c_send s str (fromIntegral len) 0{-flags-}


-- | Transmit a message to another socket. The recipient can be
-- specified explicitly so the socket must not (but can be) in a
-- connected state.
sendTo :: Socket      -- ^ (Possibly) bound\/connected socket.
       -> ByteString  -- ^ Data to send.
       -> SockAddr    -- ^ Recipient address.
       -> IO Int      -- ^ Number of bytes sent.
sendTo sock xs addr = unsafeUseAsCStringLen xs $
                      \(str, len) -> sendBufTo sock str len addr

-- -----------------------------------------------------------------------------
-- Receiving

-- | Receive a message from another socket. The socket must be in a
-- connected state so that the intended recipient is known. Note that
-- the length of the received data can be smaller than specified
-- maximum length. If the message is longer than the specified length
-- it may be discarded depending on the type of socket. May block
-- until a message arrives.
recv :: Socket          -- ^ Bound\/connected socket.
     -> Int             -- Maximum number of bytes to receive.
     -> IO ByteString   -- Data received.
recv sock@(MkSocket s _ _ _ _) nbytes
    | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")
    | otherwise   = do
      create nbytes $ \ptr -> do
        len <-





             throwErrnoIfMinus1Retry_repeatOnBlock "recv"
                    (threadWaitRead (fromIntegral s)) $

                            c_recv s (castPtr ptr) (fromIntegral nbytes) 0{-flags-}

        if fromIntegral len == 0
            then ioError (mkEOFError "Network.Socket.ByteString.recv")
            else return ()

-- | Similar to 'recv' but can be used to receive data on a socket
-- that is not connection-oriented.
recvFrom :: Socket                     -- ^ (Possibly) bound\/connected socket.
         -> Int                        -- ^ Maximum number of bytes to receive.
         -> IO (ByteString, SockAddr)  -- ^ Data received and sender address.
recvFrom sock nbytes =
    allocaBytes nbytes $ \ptr -> do
      (len, sockaddr) <- recvBufFrom sock ptr nbytes
      str <- B.packCStringLen (ptr, len)
      return (str, sockaddr)

mkInvalidRecvArgError :: String -> IOError
mkInvalidRecvArgError loc = IOError Nothing

                                    InvalidArgument



                                    loc "non-positive length" Nothing

mkEOFError :: String -> IOError
mkEOFError loc = IOError Nothing EOF loc "end of file" Nothing

-----------------------------------------------------------------------------
-- Support for thread-safe blocking operations in GHC.


{-# SPECIALISE
    throwErrnoIfMinus1Retry_mayBlock
         :: String -> IO CInt -> IO CInt -> IO CInt #-}
throwErrnoIfMinus1Retry_mayBlock :: Num a => String -> IO a -> IO a -> IO a
throwErrnoIfMinus1Retry_mayBlock name on_block act = do
    res <- act
    if res == -1
        then do
            err <- getErrno
            if err == eINTR
                then throwErrnoIfMinus1Retry_mayBlock name on_block act
                else if err == eWOULDBLOCK || err == eAGAIN
                        then on_block
                        else throwErrno name
        else return res

throwErrnoIfMinus1Retry_repeatOnBlock :: Num a => String -> IO b -> IO a -> IO a
throwErrnoIfMinus1Retry_repeatOnBlock name on_block act = do
  throwErrnoIfMinus1Retry_mayBlock name (on_block >> repeat) act
  where repeat = throwErrnoIfMinus1Retry_repeatOnBlock name on_block act