Initial commit

1 files changed, 50 insertions, 0 deletions

diff --git a/src/Tcp.hs b/src/Tcp.hs
new file mode 100644
index 0000000..d0ee6c9
--- /dev/null
+++ b/src/Tcp.hs
@@ -0,0 +1,50 @@
+module Tcp (runServer) where
+
+import Control.Concurrent (forkFinally)
+import qualified Control.Exception as E
+import Control.Monad (forever, void)
+import Intro
+import Network.Socket
+  ( AddrInfoFlag (AI_PASSIVE)
+  , HostName
+  , ServiceName
+  , Socket
+  , SocketOption (ReuseAddr)
+  , SocketType (Stream)
+  , accept
+  , addrAddress
+  , addrFlags
+  , addrSocketType
+  , bind
+  , close
+  , defaultHints
+  , getAddrInfo
+  , gracefulClose
+  , listen
+  , openSocket
+  , setCloseOnExecIfNeeded
+  , setSocketOption
+  , withFdSocket
+  , withSocketsDo
+  )
+
+runServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
+runServer host port server = withSocketsDo $ do
+  addr <- resolve
+  E.bracket (open addr) close go
+ where
+  resolve = do
+    let hints = defaultHints{addrFlags = [AI_PASSIVE], addrSocketType = Stream}
+    head <$> getAddrInfo (Just hints) host (Just port)
+  open addr = E.bracketOnError (openSocket addr) close $ \sock -> do
+    setSocketOption sock ReuseAddr 1
+    withFdSocket sock setCloseOnExecIfNeeded
+    bind sock $ addrAddress addr
+    listen sock 1024
+    pure sock
+  go :: Socket -> IO a
+  go sock = forever
+    $ E.bracketOnError (accept sock) (close . fst)
+    $ \(conn, _peer) ->
+      void
+        $ forkFinally (server conn) (const $ gracefulClose conn 5000)