-
Notifications
You must be signed in to change notification settings - Fork 28
/
server_haskell.hs
31 lines (27 loc) · 840 Bytes
/
server_haskell.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
module Main where
import Control.Concurrent (forkIO)
import Control.Exception (onException)
import qualified Data.ByteString as BS (length)
import Network (withSocketsDo, listenOn, PortID(..))
import Network.Socket (Socket, sClose, accept)
import Network.Socket.ByteString (recv, send)
import Prelude hiding (catch)
main :: IO ()
main = withSocketsDo $ do
let port = 5000
soc <- listenOn $ PortNumber port
putStrLn $ "start server, listening on: " ++ show port
acceptLoop soc `onException` sClose soc
acceptLoop :: Socket -> IO ()
acceptLoop soc = do
(nsoc, _) <- accept soc
forkIO (echoLoop nsoc `onException` sClose nsoc)
acceptLoop soc
echoLoop :: Socket -> IO ()
echoLoop soc = do
bs <- recv soc 4096;
if BS.length bs == 0
then sClose soc
else do
send soc bs
echoLoop soc