content: -- ----------------------------------------------------------------------------
  
  {- |
    Module     : Holumbus
    Copyright  : Copyright (C) 2009 Stefan Schmidt
    License    : MIT
  
    Maintainer : Stefan Schmidt (stefanschmidt@web.de)
    Stability  : experimental
    Portability: portable
    Version    : 0.1
    
  -}
  
  -- ----------------------------------------------------------------------------
  
  module Main(main) where
  
  import           Control.Concurrent
  import qualified Data.Map as Map
  import           Data.Maybe
  import qualified Data.Set as Set
  
  import           Holumbus.Distribution.DNode
  import           Holumbus.Distribution.DChan
  import           Holumbus.Common.Logging
  
  import           MessagesDChan
  
  
  
  data ServerData = ServerData {
      sd_clients   :: Map.Map ClientToken (String, (DChan ChatResponse))
    , sd_names     :: Set.Set String
    , sd_number    :: Integer
    }
  
  
  main :: IO ()
  main
    = do
      initializeLogging []
      initDNode $ (defaultDNodeConfig "ServerDChan")
        { dnc_MinPort = (fromInteger 7999), dnc_MaxPort = (fromInteger 7999) }
      let serverdata = mkNewServer
      channel <- newDChan "server"
      forkIO $ dispatcher serverdata channel
      repeatTillReturn
      closeDChan channel
      deinitDNode
  
      
  
  mkNewServer :: ServerData
  mkNewServer = ServerData Map.empty Set.empty 1
  
  
  mkNextClientToken :: ServerData -> IO (ServerData, ClientToken)
  mkNextClientToken s
    = do
      let i  = sd_number s
          s' = s { sd_number = (i+1)}
      t <- genClientToken i
      return (s', t)
  
      
  addClient :: ServerData -> ClientToken -> String -> DChan ChatResponse -> ServerData
  addClient s ct cn cc = s { sd_clients = c' , sd_names = n' }
    where
    c' = Map.insert ct (cn,cc) (sd_clients s)
    n' = Set.insert cn (sd_names s)
  
  
  deleteClient :: ServerData -> ClientToken -> ServerData
  deleteClient s ct = s { sd_clients = c' , sd_names = n' }
    where
    c' = Map.delete ct (sd_clients s)
    n' = case (Map.lookup ct (sd_clients s)) of
            (Just (cn,_)) -> Set.delete cn (sd_names s)
            (Nothing)     -> (sd_names s)
  
  isTokenValid :: ServerData -> ClientToken -> Bool
  isTokenValid s ct = Map.member ct (sd_clients s) 
  
      
  isNameValid :: ServerData -> String -> Bool
  isNameValid _ "" = False
  isNameValid s cn = (not $ Set.member cn (sd_names s))
  
  
  sendMessage :: ServerData -> ClientToken -> String -> IO ()
  sendMessage s ct text
    = do
      if (isTokenValid s ct)
        then do
          let (cn, _) = fromJust $ Map.lookup ct (sd_clients s)
              ccs = map (snd) $ Map.elems $ Map.delete ct (sd_clients s)
          mapM (\cc -> writeDChan cc (RspMessage cn text)) ccs
          return () 
        else return ()
        
  
  repeatTillReturn :: IO ()
  repeatTillReturn
    = do
      hnd <- getDNodeData
      putStrLn $ show hnd
      l <- getLine
      case l of
        "exit" -> 
          return ()
        "debug" ->
          do
          nd <- getDNodeData
          putStrLn $ show nd
        _  ->
          repeatTillReturn
  
              
  dispatcher :: ServerData -> DChan ChatRequest -> IO ()
  dispatcher s c
    = do
      msg <- readDChan c
      s' <- case msg of
        (ReqRegister cn cc) ->
          do
          if (isNameValid s cn)
            then do
              (s', ct) <- mkNextClientToken s 
              writeDChan cc (RspRegister ct)
              return $ addClient s' ct cn cc
            else do
              writeDChan cc (RspError "name already used")
              return s
        (ReqUnregister ct) -> 
          do
          return $ deleteClient s ct 
        (ReqMessage ct text) ->
          do
          sendMessage s ct text
          return s
      dispatcher s' c    
        
  