module Data.IterIO.Server.TCPServer (
TCPServer,
runTCPServer,
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 out = TCPServer {
serverPort :: Net.PortNumber
, serverHandler :: Inum inp out m ()
}
instance Show (TCPServer inp m out) where
show s = "TCPServer { serverPort: " ++ (show $ serverPort s) ++ " }"
runTCPServer :: (ListLikeIO inp e, ListLikeIO out e,
ChunkData inp, ChunkData out, HasFork m)
=> TCPServer inp m out
-> m ()
runTCPServer server = do
sock <- liftIO $ sockListenTCP $ serverPort server
forever $ do
(iter, enum) <- liftIO $ do
(s, _) <- Net.accept sock
h <- Net.socketToHandle s ReadWriteMode
hSetBuffering h NoBuffering
return (handleI h, enumHandle h)
_ <- fork $ do
enum |$ serverHandler server .| iter
return ()
simpleHttpServer :: (HasFork m)
=> Net.PortNumber
-> HttpRequestHandler m ()
-> TCPServer L.ByteString m L.ByteString
simpleHttpServer port reqHandler = TCPServer port httpAppHandler
where httpAppHandler = mkInumM $ do
req <- httpReqI
resp <- liftI $ reqHandler req
irun $ enumHttpResp resp Nothing
echoServer :: (HasFork m) => Net.PortNumber -> TCPServer String m String
echoServer port = TCPServer port echoAppHandler
where echoAppHandler = mkInumM $ forever $ do
input <- safeLineI
case input of
Just output -> irun $ enumPure $ output ++ "\r\n"
Nothing -> irun $ enumPure []