{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}

module Network.Wai.Handler.Warp.Recv (
    receive
  ) where

import Control.Applicative ((<$>))
import Control.Monad (void)
import qualified Data.ByteString as BS (empty)
import Data.ByteString.Internal (ByteString(..), mallocByteString)
import Data.Word (Word8)
import Foreign.C.Error (eAGAIN, getErrno, throwErrno)
import Foreign.C.Types
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (Ptr, castPtr)
import GHC.Conc (threadWaitRead)
import Network.Socket (Socket, fdSocket)
import System.Posix.Types (Fd(..))
import Network.Wai.Handler.Warp.Buffer

#ifdef mingw32_HOST_OS
import GHC.IO.FD (FD(..), readRawBufferPtr)
#endif

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

receive :: Socket -> Buffer -> Int -> IO ByteString
receive sock buf size = do
    bytes <- fromIntegral <$> receiveloop sock' buf' size'
    if bytes == 0 then
        return BS.empty
      else do
        fptr <- mallocByteString bytes
        void $ withForeignPtr fptr $ \ptr ->
            c_memcpy ptr buf (fromIntegral bytes)
        return $! PS fptr 0 bytes
  where
    sock' = fdSocket sock
    buf' = castPtr buf
    size' = fromIntegral size

#ifdef mingw32_HOST_OS
receiveloop :: CInt -> Ptr Word8 -> CSize -> IO CInt
#else
receiveloop :: CInt -> Ptr CChar -> CSize -> IO CInt
#endif
receiveloop sock buf size = do
#ifdef mingw32_HOST_OS
    bytes <- fmap fromIntegral $ readRawBufferPtr "recv" (FD sock 1) buf 0 size
#else
    bytes <- c_recv sock buf size 0
#endif
    if bytes == -1 then do
        errno <- getErrno
        if errno == eAGAIN then do
            threadWaitRead (Fd sock)
            receiveloop sock buf size
          else
            throwErrno "receiveloop"
       else
        return bytes

-- fixme: the type of the return value
foreign import ccall unsafe "recv"
    c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt

foreign import ccall unsafe "string.h memcpy"
    c_memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)