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
|
module Main where
|
||||||
|
|
||||||
|
import Control.Concurrent (threadDelay)
|
||||||
|
|
||||||
|
import Options.Applicative
|
||||||
|
|
||||||
|
import System.IO
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Client.Communication
|
||||||
|
import Client.Types
|
||||||
|
|
||||||
main :: IO ()
|
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.Types
|
||||||
import Server.Util
|
import Server.Util
|
||||||
import Data.Maybe (isNothing)
|
|
||||||
|
|
||||||
-- | Function which determines whether the given filePath is a supported socket path and
|
-- | Function which determines whether the given filePath is a supported socket path and
|
||||||
-- subsequently creates a socket in said location.
|
-- subsequently creates a socket in said location.
|
||||||
|
@ -107,6 +106,6 @@ processMessages = do
|
||||||
listenTo clientSocket = do
|
listenTo clientSocket = do
|
||||||
connectionHandle <- socketToHandle clientSocket ReadMode
|
connectionHandle <- socketToHandle clientSocket ReadMode
|
||||||
hSetBuffering connectionHandle LineBuffering
|
hSetBuffering connectionHandle LineBuffering
|
||||||
message <- hGetContents' connectionHandle
|
message <- hGetContents connectionHandle
|
||||||
putStr message
|
putStr message
|
||||||
hClose connectionHandle
|
hClose connectionHandle
|
||||||
|
|
|
@ -30,12 +30,14 @@ library
|
||||||
executable wizard-wipeout-client
|
executable wizard-wipeout-client
|
||||||
import: warnings
|
import: warnings
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
-- other-modules:
|
other-modules: Client.Communication
|
||||||
|
Client.Types
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: base ^>=4.17.2.1
|
build-depends: base ^>=4.17.2.1
|
||||||
, monad-loops
|
, monad-loops
|
||||||
, mtl
|
, mtl
|
||||||
, network
|
, network
|
||||||
|
, optparse-applicative
|
||||||
, vty
|
, vty
|
||||||
, wizard-wipeout
|
, wizard-wipeout
|
||||||
hs-source-dirs: src-client
|
hs-source-dirs: src-client
|
||||||
|
|
Loading…
Reference in a new issue