module Holumbus.Network.PortRegistry.PortRegistryData
(
PortRegistryData
, newPortRegistryData
, closePortRegistryData
, getPortRegistryRequestPort
, 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"
data PortRegistryData = PortRegistryData {
prd_ServerThreadId :: Thread
, prd_OwnStream :: PortRegistryRequestStream
, prd_SocketMap :: MVar (Map.Map StreamName SocketId)
}
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
closePortRegistryData :: PortRegistryData -> IO ()
closePortRegistryData prd
= do
stopRequestDispatcher (prd_ServerThreadId prd)
closeStream (prd_OwnStream prd)
return ()
getPortRegistryRequestPort :: PortRegistryData -> IO PortRegistryRequestPort
getPortRegistryRequestPort prd = newPortFromStream (prd_OwnStream prd)
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)
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)