Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
{-# LANGUAGE OverloadedStrings #-}
-- Echo server program
module Main (main) where
import Control.Concurrent
import Control.Concurrent.MVar
import qualified Control.Exception as E
import Control.Monad (unless, forever, void)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import Network.Socket
import Network.Socket.ByteString (recv, sendAll)
resp = "HTTP/1.0 200 OK\n\n"
main :: IO ()
main = do
forkIO $ runTCPServer Nothing "3000" (talk)
forever $ threadDelay 10000000
talk s = do
msg <- recv s 1024
sendAll s resp
-- from the "network-run" package.
runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
runTCPServer mhost port server = withSocketsDo $ do
addr <- resolve
E.bracket (open addr) close loop
resolve = do
let hints = defaultHints {
addrFlags = [AI_PASSIVE]
, addrSocketType = Stream
head <$> getAddrInfo (Just hints) mhost (Just port)
open addr = do
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
setSocketOption sock ReuseAddr 1
withFdSocket sock setCloseOnExecIfNeeded
bind sock $ addrAddress addr
listen sock 1024
return sock
loop sock = forever $ do
(conn, _peer) <- accept sock
void $ forkFinally (server conn) (const $ gracefulClose conn 5000)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment