PortRegistryData.hs

-- ----------------------------------------------------------------------------
{- |
  Module     : Holumbus.Network.PortRegistry.PortRegistryData
  Copyright  : Copyright (C) 2008 Stefan Schmidt
  License    : MIT

  Maintainer : Stefan Schmidt (stefanschmidt@web.de)
  Stability  : experimental
  Portability: portable
  Version    : 0.1


  This module contains the main datatype for the PortRegistry.
  
-}
-- ----------------------------------------------------------------------------

module Holumbus.Network.PortRegistry.PortRegistryData
(
-- * Datatypes
  PortRegistryData

-- * Creation and Destruction
, newPortRegistryData
, closePortRegistryData

, getPortRegistryRequestPort

-- * reexport
, setPortRegistry 
)
where


import           Control.Concurrent
import qualified Data.Map as Map
import           Network
import           System.Log.Logger

import           Holumbus.Common.Threading
import           Holumbus.Network.Port
import           Holumbus.Network.Messages
import           Holumbus.Network.PortRegistry
import           Holumbus.Network.PortRegistry.Messages


localLogger :: String
localLogger = "Holumbus.Network.PortRegistry.PortRegistryData"



-- ----------------------------------------------------------------------------
-- Datatypes
-- ----------------------------------------------------------------------------

-- | The data needed by the PortRegistry
data PortRegistryData = PortRegistryData {
    prd_ServerThreadId :: Thread                             -- ^ The thread-data of the message-dispatcher thread.
  , prd_OwnStream      :: PortRegistryRequestStream          -- ^ The Stream for all incomming messages.
  , prd_SocketMap      :: MVar (Map.Map StreamName SocketId) -- ^ The map storing the port-data (the real registry).
  }


-- ----------------------------------------------------------------------------
-- Creation and Destruction
-- ----------------------------------------------------------------------------


-- | Creates a new PortRegistry.
newPortRegistryData :: StreamName -> Maybe PortNumber -> IO PortRegistryData
newPortRegistryData sn pn
  = do
    st      <- (newStream STLocal (Just sn) pn)::IO PortRegistryRequestStream
    mMVar   <- newMVar Map.empty
    sMVar   <- newThread            
    let prd = PortRegistryData sMVar st mMVar
    startRequestDispatcher sMVar st (dispatch prd)
    return prd


-- | Closes the PortRegistry with its streams and threads.
closePortRegistryData :: PortRegistryData -> IO ()
closePortRegistryData prd
  = do
    stopRequestDispatcher (prd_ServerThreadId prd)
    closeStream (prd_OwnStream prd)
    return ()


-- | Get the RequestPort of the PortRegistry.
--   It can be used to give access to the PortRegistry, eg. you can serialize
--   this information and transfer it over the network to grant access to the
--   clients.
getPortRegistryRequestPort :: PortRegistryData -> IO PortRegistryRequestPort
getPortRegistryRequestPort prd = newPortFromStream (prd_OwnStream prd)


-- | The main dispatch-function. It handles the incomming messages and reacts.
dispatch 
  :: PortRegistryData 
  -> PortRegistryRequestMessage 
  -> PortRegistryResponsePort
  -> IO ()
dispatch prd msg replyPort
  = do
    case msg of
      (PRReqRegister sn soid) ->
        do
        handleRequest replyPort (registerPort sn soid prd) (\_ -> PRRspSuccess)
        return ()
      (PRReqUnregister sn) ->      
        do
        handleRequest replyPort (unregisterPort sn prd) (\_ -> PRRspSuccess)
        return ()
      (PRReqLookup sn) ->
        do
        handleRequest replyPort (lookupPort sn prd) (\soid -> PRRspLookup soid)
        return ()
      (PRReqGetPorts) ->
        do
        handleRequest replyPort (getPorts prd) (\ls -> PRRspGetPorts ls)
        return ()
      _ -> 
        do
        infoM localLogger $ "dispatch: unknown request " ++ show msg
        handleRequest replyPort (return ()) (\_ -> PRRspUnknown)



-- ----------------------------------------------------------------------------
-- Typeclass instanciation (PortRegistry)
-- ----------------------------------------------------------------------------


-- The PortRegistry-typeclass instanciation for the PortRegistryData.
instance PortRegistry PortRegistryData where
  
  registerPort sn soid prd
    = do
      infoM localLogger $ "register: " ++ sn ++ " - at: " ++ show soid 
      modifyMVar (prd_SocketMap prd) $
        \sm -> return (Map.insert sn soid sm, ())

  unregisterPort sn prd
    = do
      infoM localLogger $ "unregister: " ++ sn
      modifyMVar (prd_SocketMap prd) $
        \sm -> return (Map.delete sn sm, ())
  
  lookupPort sn prd
    = do
      infoM localLogger $ "looking up: " ++ sn
      soid <- withMVar (prd_SocketMap prd) $
        \sm -> return (Map.lookup sn sm)
      infoM localLogger $ "result for: " ++ sn ++ " -> " ++ show soid
      return soid
  
  getPorts prd
    = do
      infoM localLogger $ "getting all ports"
      withMVar (prd_SocketMap prd) $
        \sm -> return (Map.toList sm)