diff options
| author | Andrew Guschin <guschin.drew@gmail.com> | 2023-03-05 13:45:37 +0400 |
|---|---|---|
| committer | Andrew Guschin <guschin.drew@gmail.com> | 2023-03-05 13:47:41 +0400 |
| commit | a0e8e5a91d15ed8c79f4a1b5914d3a6242c0cbd3 (patch) | |
| tree | 76f76788523a16c0db8cb8f3a90b23912acd37d4 /net/Server.hs | |
| parent | dd73de2e563c332c5a90bb21c5c7e6cbebc0ab86 (diff) | |
Migrated project to cabal
Diffstat (limited to 'net/Server.hs')
| -rw-r--r-- | net/Server.hs | 65 |
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) |