module Data.IterIO.Server.TCPServer (
TCPServer(..),
runTCPServer,
defaultServerAcceptor,
minimalTCPServer,
simpleHttpServer,
echoServer
) where
import Control.Concurrent.MonadIO
import Control.Monad
import qualified Data.ByteString.Lazy as L
import qualified Network.Socket as Net
import System.IO
import Data.IterIO
import Data.IterIO.Http
import Data.ListLike.IO
sockListenTCP :: Net.PortNumber -> IO Net.Socket
sockListenTCP pn = do
sock <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol
Net.setSocketOption sock Net.ReuseAddr 1
Net.bindSocket sock (Net.SockAddrInet pn Net.iNADDR_ANY)
Net.listen sock Net.maxListenQueue
return sock
data TCPServer inp m = TCPServer {
serverPort :: Net.PortNumber
, serverHandler :: Inum inp inp m ()
, serverAcceptor :: Net.Socket -> m (Iter inp m (), Onum inp m ())
, serverResultHandler :: m () -> IO ()
}
instance Show (TCPServer inp m) where
show s = "TCPServer { serverPort: " ++ (show $ serverPort s) ++ " }"
minimalTCPServer :: (ListLikeIO inp e, ChunkData inp) => TCPServer inp IO
minimalTCPServer = TCPServer 0 inumNop defaultServerAcceptor id
defaultServerAcceptor :: (ListLikeIO inp e,
ChunkData inp, MonadIO m)
=> Net.Socket -> m (Iter inp m (), Onum inp m a)
defaultServerAcceptor sock = liftIO $ do
h <- Net.socketToHandle sock ReadWriteMode
hSetBuffering h NoBuffering
return (handleI h, enumHandle h)
runTCPServer :: (ListLikeIO inp e,
ChunkData inp, Monad m)
=> TCPServer inp m
-> IO ()
runTCPServer server = do
sock <- sockListenTCP $ serverPort server
let handler = serverResultHandler server
forever $ do
(s, _) <- Net.accept sock
_ <- forkIO $ handler $ do
(iter, enum) <- (serverAcceptor server) s
enum |$ serverHandler server .| iter
return ()
simpleHttpServer :: Net.PortNumber
-> HttpRequestHandler IO ()
-> TCPServer L.ByteString IO
simpleHttpServer port reqHandler = minimalTCPServer { serverPort = port, serverHandler = httpAppHandler }
where httpAppHandler = inumHttpServer $ ioHttpServer reqHandler
echoServer :: Net.PortNumber -> TCPServer String IO
echoServer port = minimalTCPServer { serverPort = port, serverHandler = echoAppHandler }
where echoAppHandler = mkInumM $ forever $ do
input <- safeLineI
case input of
Just output -> irun $ enumPure $ output ++ "\r\n"
Nothing -> irun $ enumPure []