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 MessagesDChan
  (
      ChatRequest(..)
    , ChatResponse(..)
    
    , ClientToken
    , genClientToken
  )
  where
  
  import           Data.Binary
  --import           Holumbus.Common.MRBinary
  import           System.Random
  import           Holumbus.Distribution.DChan
  
  
  data ChatRequest
    = ReqRegister String (DChan ChatResponse)
    | ReqUnregister ClientToken
    | ReqMessage ClientToken String
  
  instance Binary ChatRequest where
    put(ReqRegister cn ch)  = putWord8 1 >> put cn >> put ch
    put(ReqUnregister ct)   = putWord8 2 >> put ct
    put(ReqMessage ct text) = putWord8 3 >> put ct >> put text
    get
      = do
        t <- getWord8
        case t of
          1 -> get >>= \cn -> get >>= \ch -> return (ReqRegister cn ch)
          2 -> get >>= \ct -> return (ReqUnregister ct)
          3 -> get >>= \ct -> get >>= \text -> return (ReqMessage ct text)
          _ -> error "ChatRequest: wrong encoding"
  
  data ChatResponse
    = RspRegister ClientToken
    | RspMessage String String
    | RspError String
    
  instance Binary ChatResponse where
    put(RspRegister ct)     = putWord8 1 >> put ct
    put(RspMessage cn text) = putWord8 2 >> put cn >> put text
    put(RspError e)         = putWord8 3 >> put e
    get
      = do
        t <- getWord8
        case t of
          1 -> get >>= \ct -> return (RspRegister ct)
          2 -> get >>= \cn -> get >>= \text -> return (RspMessage cn text)
          3 -> get >>= \e -> return (RspError e)
          _ -> error "ChatResponse: wrong encoding"
  
  
  data ClientToken = ClientToken Integer Integer
    deriving (Show, Eq, Ord)
  
  instance Binary ClientToken where
    put(ClientToken i rnd) = put i >> put rnd
    get = get >>= \i -> get >>= \rnd -> return (ClientToken i rnd)
  
  genClientToken :: Integer -> IO ClientToken
  genClientToken i
    = do
      rnd <- getStdRandom (randomR (1,1000000000))
      return $ ClientToken i rnd
    
  