module Network where

import Control.Exception.Extensible as E
import Control.Monad        (forever, unless)
import Control.Monad.Trans  (MonadIO(..), lift)
import Control.Proxy        (Consumer, Producer, Proxy, request, respond, runIdentityP)
import Data.ByteString as B (ByteString, null)
import Network.BSD          (getProtocolNumber)
import Network.Socket       (Family(AF_INET), Socket, SockAddr(..), SocketOption(ReuseAddr), SocketType(Stream), bindSocket, iNADDR_ANY, sClose, maxListenQueue, listen, socket, setSocketOption)
import Network.Socket.ByteString (sendAll, recv)

-- | start TCP listening on a port
listenOn :: Int  -- ^ port number
         -> IO Socket
listenOn portm = do
    proto <- getProtocolNumber "tcp"
    E.bracketOnError
        (socket AF_INET Stream proto)
        (sClose)
        (\sock -> do
            setSocketOption sock ReuseAddr 1
            bindSocket sock (SockAddrInet (fromIntegral portm) iNADDR_ANY)
            listen sock (max 1024 maxListenQueue)
            return sock
        )

-- | Stream data from the socket.
--
-- FIXME: what should happen if 'recv' raises an exception?
socketReader :: (Proxy p, MonadIO m) =>
                Socket -- ^ 'Socket' to read data from
             -> (() -> Producer p ByteString m ())
socketReader sock () = runIdentityP go
  where
    go = do
      bs <- lift (liftIO $ recv sock 4096)
      unless (B.null bs) $
        respond bs >> go

-- | Stream data to the socket.
--
-- FIXME: what should happen if 'sendAll' raises an exception?
socketWriter :: (Proxy p, MonadIO m) =>
                Socket -- ^ 'Socket' to write data to
             -> (() -> Consumer p ByteString m ())
socketWriter sock () =
    runIdentityP $
      forever $
        do bs <- request ()
           lift $ liftIO (sendAll sock bs)