Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- module Lib
- ( runMDR
- ) where
- import Control.Concurrent (forkFinally)
- import qualified Control.Exception as E
- import Control.Monad (unless, forever, void)
- import qualified Data.ByteString as S
- import Data.ByteString.UTF8
- import Network.Socket
- import Network.Socket.ByteString (recv, sendAll)
- runMDR :: IO ()
- runMDR = runTCPServer Nothing "3000" talk
- where
- talk s = do
- msg <- recv s 1024
- unless (S.null msg) $ do
- putStrLn ("message received !!!!")
- sendAll s (fromString "Je t'ai entendu")
- talk s
- -- 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
- where
- 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)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement