established first (mock) communication from client to server
This commit is contained in:
parent
b9d28aa946
commit
deec89f125
5 changed files with 61 additions and 4 deletions
16
src-client/Client/Communication.hs
Normal file
16
src-client/Client/Communication.hs
Normal file
|
@ -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
|
14
src-client/Client/Types.hs
Normal file
14
src-client/Client/Types.hs
Normal file
|
@ -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"
|
||||
)
|
|
@ -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"
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue