From deec89f125aeb63f98ad4b71b967826dab5ad3de Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 10 Dec 2023 12:44:23 +0100 Subject: [PATCH] established first (mock) communication from client to server --- src-client/Client/Communication.hs | 16 ++++++++++++++++ src-client/Client/Types.hs | 14 ++++++++++++++ src-client/Main.hs | 28 +++++++++++++++++++++++++++- src-server/Server/Communication.hs | 3 +-- wizard-wipeout.cabal | 4 +++- 5 files changed, 61 insertions(+), 4 deletions(-) create mode 100644 src-client/Client/Communication.hs create mode 100644 src-client/Client/Types.hs diff --git a/src-client/Client/Communication.hs b/src-client/Client/Communication.hs new file mode 100644 index 0000000..4de9710 --- /dev/null +++ b/src-client/Client/Communication.hs @@ -0,0 +1,16 @@ +module Client.Communication where + +import Network.Socket + +import System.IO + +connectSocket + :: FilePath + -> IO Handle +connectSocket path = do + sock <- socket AF_UNIX Stream defaultProtocol + setSocketOption sock KeepAlive 1 + connect sock (SockAddrUnix path) + handle <- socketToHandle sock ReadWriteMode + hSetBuffering handle (BlockBuffering Nothing) + pure handle diff --git a/src-client/Client/Types.hs b/src-client/Client/Types.hs new file mode 100644 index 0000000..3fa9792 --- /dev/null +++ b/src-client/Client/Types.hs @@ -0,0 +1,14 @@ +module Client.Types where + +import Options.Applicative as O + +newtype Options = Options + { optSockLoc :: FilePath + } + +options :: O.Parser Options +options = Options + <$> argument str + ( metavar "FILEPATH" + <> help "Location of the server's socket" + ) diff --git a/src-client/Main.hs b/src-client/Main.hs index 65ae4a0..09a815c 100644 --- a/src-client/Main.hs +++ b/src-client/Main.hs @@ -1,4 +1,30 @@ module Main where +import Control.Concurrent (threadDelay) + +import Options.Applicative + +import System.IO + +-- internal imports + +import Client.Communication +import Client.Types + main :: IO () -main = putStrLn "Hello, Haskell!" +main = do + putStrLn "Hello, Arena!" + (Options socketLocation) <- execParser opts + putStrLn $ "connecting to Socket " <> socketLocation + handle <- connectSocket socketLocation + hPutStrLn handle "meow!" + hFlush handle + threadDelay $ 5 * 10 ^ 6 + hPutStrLn handle "Goodbye!" + hFlush handle + where + opts = info (options <**> helper) + ( fullDesc + <> progDesc "Run the \"wizard-wipeout\" Server." + <> header "wizard-wipeout - Last Mage standing" + ) diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index 4fb20e9..af143f4 100644 --- a/src-server/Server/Communication.hs +++ b/src-server/Server/Communication.hs @@ -25,7 +25,6 @@ import System.Posix.Signals import Server.Types import Server.Util -import Data.Maybe (isNothing) -- | Function which determines whether the given filePath is a supported socket path and -- subsequently creates a socket in said location. @@ -107,6 +106,6 @@ processMessages = do listenTo clientSocket = do connectionHandle <- socketToHandle clientSocket ReadMode hSetBuffering connectionHandle LineBuffering - message <- hGetContents' connectionHandle + message <- hGetContents connectionHandle putStr message hClose connectionHandle diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index 54324fb..c87f8d3 100644 --- a/wizard-wipeout.cabal +++ b/wizard-wipeout.cabal @@ -30,12 +30,14 @@ library executable wizard-wipeout-client import: warnings main-is: Main.hs - -- other-modules: + other-modules: Client.Communication + Client.Types -- other-extensions: build-depends: base ^>=4.17.2.1 , monad-loops , mtl , network + , optparse-applicative , vty , wizard-wipeout hs-source-dirs: src-client