Advertisement
Guest User

Untitled

a guest
Oct 16th, 2020
48
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.41 KB | None | 0 0
  1. module Lib
  2. ( runMDR
  3. ) where
  4.  
  5. import Control.Concurrent (forkFinally)
  6. import qualified Control.Exception as E
  7. import Control.Monad (unless, forever, void)
  8. import qualified Data.ByteString as S
  9. import Data.ByteString.UTF8
  10. import Network.Socket
  11. import Network.Socket.ByteString (recv, sendAll)
  12.  
  13. runMDR :: IO ()
  14. runMDR = runTCPServer Nothing "3000" talk
  15. where
  16. talk s = do
  17. msg <- recv s 1024
  18. unless (S.null msg) $ do
  19. putStrLn ("message received !!!!")
  20. sendAll s (fromString "Je t'ai entendu")
  21. talk s
  22.  
  23. -- from the "network-run" package.
  24. runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
  25. runTCPServer mhost port server = withSocketsDo $ do
  26. addr <- resolve
  27. E.bracket (open addr) close loop
  28. where
  29. resolve = do
  30. let hints = defaultHints {
  31. addrFlags = [AI_PASSIVE]
  32. , addrSocketType = Stream
  33. }
  34. head <$> getAddrInfo (Just hints) mhost (Just port)
  35. open addr = do
  36. sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
  37. setSocketOption sock ReuseAddr 1
  38. withFdSocket sock $ setCloseOnExecIfNeeded
  39. bind sock $ addrAddress addr
  40. listen sock 1024
  41. return sock
  42. loop sock = forever $ do
  43. (conn, _peer) <- accept sock
  44. void $ forkFinally (server conn) (const $ gracefulClose conn 5000)
  45.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement