summaryrefslogtreecommitdiff
path: root/net/Server.hs
diff options
context:
space:
mode:
authorAndrew Guschin <guschin.drew@gmail.com>2023-03-05 13:45:37 +0400
committerAndrew Guschin <guschin.drew@gmail.com>2023-03-05 13:47:41 +0400
commita0e8e5a91d15ed8c79f4a1b5914d3a6242c0cbd3 (patch)
tree76f76788523a16c0db8cb8f3a90b23912acd37d4 /net/Server.hs
parentdd73de2e563c332c5a90bb21c5c7e6cbebc0ab86 (diff)
Migrated project to cabal
Diffstat (limited to 'net/Server.hs')
-rw-r--r--net/Server.hs65
1 files changed, 0 insertions, 65 deletions
diff --git a/net/Server.hs b/net/Server.hs
deleted file mode 100644
index 0e53330..0000000
--- a/net/Server.hs
+++ /dev/null
@@ -1,65 +0,0 @@
--- Echo server program
-module Main (main) where
-
-import Control.Concurrent (forkFinally)
-import qualified Control.Exception as E
-import Control.Monad (unless, forever, void)
-
-import qualified Data.ByteString as S
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
-
-import Network.Socket
-import Network.Socket.ByteString (recv, sendAll)
-
-join :: String -> [String] -> String
-join delim [] = ""
-join delim (s : []) = s
-join delim (s : rest) =
- s ++ delim ++ join delim rest
-
-packStr :: String -> S.ByteString
-packStr = encodeUtf8 . T.pack
-
-(+++) = S.append
-
-response = join "\n"
- [ "HTTP/1.1 200 OK"
- , "Content-Type: text/html; charset=utf-8"
- , "Connection: keep-alive"
- , ""
- , "<i>PRIVET</i>"
- ]
-
-main :: IO ()
-main = runTCPServer Nothing "3000" talk
- where
- talk s = do
- msg <- recv s 1024
- print msg
- unless (S.null msg) $ do
- sendAll s (packStr response)
- 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)