Skip to content

Instantly share code, notes, and snippets.

@agentultra
Created July 19, 2020 17:31
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save agentultra/3991bf5f0b8845f065ce7bfa97fdd664 to your computer and use it in GitHub Desktop.
Save agentultra/3991bf5f0b8845f065ce7bfa97fdd664 to your computer and use it in GitHub Desktop.
This works differently on Windows
-- This is basically the same program taken from https://hackage.haskell.org/package/network-3.1.1.1/docs/Network-Socket.html#g:9
-- on 2020-07-19
-- It works as expected on Unix-like OSs: each line is buffered in and echoed back out
-- On Windows each character is read and echoed back out
module Lib where
import Control.Concurrent (forkFinally)
import qualified Control.Exception as E
import Control.Monad (unless, forever, void)
import qualified Data.ByteString as S
import Network.Socket
import Network.Socket.ByteString (recv, sendAll)
start :: IO ()
start = runTCPServer Nothing "3000" talk
where
talk s = do
msg <- recv s 1024
unless (S.null msg) $ do
sendAll s msg
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment