diff options
Diffstat (limited to 'net')
| -rw-r--r-- | net/Client.hs | 30 | ||||
| -rw-r--r-- | net/Server.hs | 65 | ||||
| -rw-r--r-- | net/client.hs | 30 | ||||
| -rw-r--r-- | net/server.hs | 42 |
4 files changed, 0 insertions, 167 deletions
diff --git a/net/Client.hs b/net/Client.hs deleted file mode 100644 index 863df6e..0000000 --- a/net/Client.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- Echo client program -module Main (main) where - -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as C -import Network.Socket -import Network.Socket.ByteString (recv, sendAll) - -main :: IO () -main = runTCPClient "127.0.0.1" "3000" $ \s -> do - sendAll s "Hello, world!" - msg <- recv s 1024 - putStr "Received: " - C.putStrLn msg - --- from the "network-run" package. -runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a -runTCPClient host port client = withSocketsDo $ do - addr <- resolve - E.bracket (open addr) close client - where - resolve = do - let hints = defaultHints { addrSocketType = Stream } - head <$> getAddrInfo (Just hints) (Just host) (Just port) - open addr = do - sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) - connect sock $ addrAddress addr - return sock - 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) diff --git a/net/client.hs b/net/client.hs deleted file mode 100644 index 863df6e..0000000 --- a/net/client.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- Echo client program -module Main (main) where - -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as C -import Network.Socket -import Network.Socket.ByteString (recv, sendAll) - -main :: IO () -main = runTCPClient "127.0.0.1" "3000" $ \s -> do - sendAll s "Hello, world!" - msg <- recv s 1024 - putStr "Received: " - C.putStrLn msg - --- from the "network-run" package. -runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a -runTCPClient host port client = withSocketsDo $ do - addr <- resolve - E.bracket (open addr) close client - where - resolve = do - let hints = defaultHints { addrSocketType = Stream } - head <$> getAddrInfo (Just hints) (Just host) (Just port) - open addr = do - sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) - connect sock $ addrAddress addr - return sock - diff --git a/net/server.hs b/net/server.hs deleted file mode 100644 index a9bec82..0000000 --- a/net/server.hs +++ /dev/null @@ -1,42 +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 Network.Socket -import Network.Socket.ByteString (recv, sendAll) - -main :: IO () -main = 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) - |