Haskell Client für Gruppe 1 Software-Architektur

gistfile1.hs

module Main where

import Control.Concurrent
import Control.Monad
import Data.List
import Network.Socket
import System.Environment

-- a username is a string
type Username = String

-- encapsulate everything the handler needs in a ChatArgs datatype
data ChatArgs = ChatArgs
    { incomingSocket :: Socket
    , outgoingSocket :: Socket
    , outgoingSockAddr :: SockAddr
    , username  :: Username
    }

main :: IO ()
main = withSocketsDo $ do
    -- username and broadcast address as command line args
    (user:broadcastAddr:_) <- getArgs

    -- Incoming Socket
    addrinfosIn <- getAddrInfo
                    (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
                    Nothing (Just "4711")
    let serveraddrIn = head addrinfosIn
    sockIn <- socket (addrFamily serveraddrIn) Datagram defaultProtocol
    setSocketOption sockIn ReuseAddr 1
    bind sockIn $ addrAddress serveraddrIn

    -- Outgoing Socket
    addrinfosOut <- getAddrInfo Nothing (Just broadcastAddr) (Just "4711")
    let serveraddrOut = head addrinfosOut
    sockOut <- socket (addrFamily serveraddrOut) Datagram defaultProtocol
    setSocketOption sockOut Broadcast 1

    let chatArgs = ChatArgs sockIn sockOut (addrAddress serveraddrOut) user

    mvar <- newEmptyMVar

    -- fork a thread for the keyboard input handler
    _ <- forkIO $ handleInput chatArgs mvar

    -- handle incoming messages in another thread
    tid <- forkIO $ procMessages chatArgs

    -- wait for the handleInput handler
    _ <- takeMVar mvar
    killThread tid
    -- close the sockets
    sClose sockOut
    sClose sockIn


procMessages :: ChatArgs -> IO ()
procMessages chatArgs  =
  do
     (msg, _, sockAddr) <- recvFrom (incomingSocket chatArgs) 1024
     if "userlist" `isInfixOf` msg
       then case sockAddr of
            SockAddrInet _ host -> do
                let sockOut = outgoingSocket chatArgs
                hostAddr <- inet_ntoa host
                addrinfosOut <- getAddrInfo Nothing (Just hostAddr) (Just "4711")
                let outAddr = head addrinfosOut
                setSocketOption sockOut Broadcast 0
                void $ sendTo sockOut
                              (username         chatArgs)
                              (addrAddress outAddr)
                setSocketOption sockOut Broadcast 1
            _ -> return () -- ignore
       else putStrLn msg
     procMessages chatArgs

handleInput :: ChatArgs -> MVar Bool -> IO ()
handleInput chatArgs mvar = do
    _ <- sendMsg $ username chatArgs ++ " joined the chat"
    loop
  where
    sendMsg str = sendTo (outgoingSocket chatArgs)
                         str
                         (outgoingSockAddr chatArgs)
    loop = do
        input <- getLine
        case input of
            "quit" -> do
                _ <- sendMsg $ username chatArgs ++ " quit the chat"
                putMVar mvar True
            _ -> do
                _ <- sendMsg $ username chatArgs ++ ": " ++ input
                loop