module Holumbus.FileSystem.Controller.ControllerData
(
ControllerData
, newController
)
where
import Prelude hiding (appendFile)
import Control.Concurrent
import Data.Maybe
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.Log.Logger
import Holumbus.Common.Debug
import Holumbus.Common.Utils ( handleAll )
import qualified Holumbus.FileSystem.Controller as C
import qualified Holumbus.FileSystem.Node as N
import qualified Holumbus.FileSystem.Node.NodePort as NP
import qualified Holumbus.FileSystem.Messages as M
import qualified Holumbus.FileSystem.Storage as S
import Holumbus.Network.Site
import Holumbus.Network.Communication
localLogger :: String
localLogger = "Holumbus.FileSystem.Controller"
type FileToNodeMap = Map.Map S.FileId (Set.Set M.NodeId)
data FileControllerData = FileControllerData {
cm_FileToNodeMap :: ! FileToNodeMap
}
type FileController = MVar FileControllerData
data ControllerData = ControllerData {
cd_Server :: Server
, cd_FileController :: FileController
}
newFileController :: IO FileController
newFileController
= do
let fc = FileControllerData Map.empty
newMVar fc
newController :: StreamName -> Maybe PortNumber -> IO ControllerData
newController sn pn
= do
c <- newEmptyMVar
server <- newServer sn pn (dispatch c) (Just $ registerNode c) (Just $ unregisterNode c)
fc <- newFileController
let con = ControllerData server fc
putMVar c con
return con
dispatch
:: MVar ControllerData
-> M.ControllerRequestMessage
-> IO (Maybe M.ControllerResponseMessage)
dispatch c msg
= do
cd <-readMVar c
case msg of
(M.CReqGetFileSites f) ->
do
s <- C.getFileSites f cd
return $ Just $ M.CRspGetFileSites s
(M.CReqContains f) ->
do
b <- C.containsFile f cd
return $ Just $ M.CRspContains b
(M.CReqGetNearestNodePortWithFile f sid) ->
do
p <- C.getNearestNodePortWithFile f sid cd
return $ Just $ M.CRspGetNearestNodePortWithFile p
(M.CReqGetNearestNodePortForFile f l sid) ->
do
p <- C.getNearestNodePortForFile f l sid cd
return $ Just $ M.CRspGetNearestNodePortForFile p
(M.CReqCreate f n) ->
do
C.createFile f n cd
return $ Just $ M.CRspSuccess
(M.CReqAppend f n) ->
do
C.appendFile f n cd
return $ Just $ M.CRspSuccess
(M.CReqDelete f n) ->
do
C.deleteFile f n cd
return $ Just $ M.CRspSuccess
_ -> return Nothing
registerNode :: MVar ControllerData -> IdType -> ClientPort -> IO ()
registerNode c i cp
= do
let np = NP.newNodePort cp
fids <- N.getFileIds np
cd <- readMVar c
modifyMVar (cd_FileController cd) $
\fc ->
do
let fc' = addFilesToController fids i fc
return (fc', ())
unregisterNode :: MVar ControllerData -> IdType -> ClientPort -> IO ()
unregisterNode c i _
= do
debugM localLogger "unregisterNode: start"
cd <- readMVar c
modifyMVar (cd_FileController cd) $
\fc ->
do
let fc' = deleteFilesFromController i fc
return (fc', ())
debugM localLogger "unregisterNode: end"
addFilesToController :: [S.FileId] -> M.NodeId -> FileControllerData -> FileControllerData
addFilesToController fids nid cm
= cm { cm_FileToNodeMap = fnm' }
where
fnm = cm_FileToNodeMap cm
fnm' = Map.unionWith combine fnm newMap
newMap = Map.fromList $ zip fids (repeat $ Set.singleton nid)
combine s1 s2 = Set.union s1 s2
deleteFilesFromController :: M.NodeId -> FileControllerData -> FileControllerData
deleteFilesFromController nid cm
= cm { cm_FileToNodeMap = fnm' }
where
fnm = cm_FileToNodeMap cm
fnm' = Map.fromList filteredList
filteredList = filter (\(_,s) -> s /= Set.empty) list
list = map (\(k,s) -> (k, Set.delete nid s)) (Map.toList fnm)
addFileToController :: S.FileId -> M.NodeId -> FileControllerData -> FileControllerData
addFileToController fid nid cm = addFilesToController [fid] nid cm
deleteFileFromController :: S.FileId -> FileControllerData -> FileControllerData
deleteFileFromController fid cm
= cm { cm_FileToNodeMap = fnm' }
where
fnm = cm_FileToNodeMap cm
fnm' = Map.delete fid fnm
getFileClientInfoList :: S.FileId -> Server -> FileControllerData -> IO [ClientInfo]
getFileClientInfoList f s cm
= do
let fnm = cm_FileToNodeMap cm
let is = Set.toList $ maybe Set.empty id (Map.lookup f fnm)
mbDats <- mapM (\i -> getClientInfo i s) is
return $ catMaybes mbDats
lookupNearestPortWithFile :: S.FileId -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)
lookupNearestPortWithFile f sid s cm
= do
dats <- getFileClientInfoList f s cm
let sids = map (\ci -> ci_Site ci) dats
mbns = nearestId sid sids
mbdat = maybe Nothing (\ns -> List.find (\ci -> (ci_Site ci) == ns) dats) mbns
mbnp = maybe Nothing (\ci -> Just $ ci_Port ci) mbdat
return mbnp
lookupNearestPortWithFileAndSpace :: S.FileId -> Integer -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)
lookupNearestPortWithFileAndSpace f _size sid s cm
= lookupNearestPortWithFile f sid s cm
lookupNearestPortWithSpace :: Integer -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)
lookupNearestPortWithSpace _size sid s _cm
= do
dats <- getAllClientInfos s
let sids = map (\ci -> ci_Site ci) dats
mbns = nearestId sid sids
mbdat = maybe Nothing (\ns -> List.find (\ci -> (ci_Site ci) == ns) dats) mbns
mbnp = maybe Nothing (\ci -> Just $ ci_Port ci) mbdat
return mbnp
lookupPortWithoutFile :: S.FileId -> Server -> FileControllerData -> IO (Maybe ClientPort)
lookupPortWithoutFile f s cm
= do
fileCis <- getFileClientInfoList f s cm
allCis <- getAllClientInfos s
let fileNids = map ci_Id fileCis
allNids = map ci_Id allCis
nonNids = Set.toList $ Set.difference (Set.fromList allNids) (Set.fromList fileNids)
if (null nonNids)
then return Nothing
else do
let i = head nonNids
mbCi <- getClientInfo i s
case mbCi of
(Just ci) -> return $ Just $ ci_Port ci
(Nothing) -> return Nothing
lookupNearestPortForFile :: S.FileId -> Integer -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)
lookupNearestPortForFile f size sid s cm
= do
nodeWithFile <- lookupNearestPortWithFileAndSpace f size sid s cm
nodeWithoutFile <- lookupNearestPortWithSpace size sid s cm
let mbnp = maybe nodeWithoutFile (\np -> Just np) nodeWithFile
return mbnp
getOtherFilePorts :: S.FileId -> IdType -> Server -> FileControllerData -> IO [ClientInfo]
getOtherFilePorts f nid s cm
= do
let fnm = cm_FileToNodeMap cm
let otherids = Set.toList $ Set.delete nid $ maybe Set.empty id (Map.lookup f fnm)
mbDats <- mapM (\i -> getClientInfo i s) otherids
return $ catMaybes mbDats
deleteFileFromNodes :: S.FileId -> [NP.NodePort] -> IO ()
deleteFileFromNodes fid nps = sequence_ $ map deleteFileFromNode nps
where
deleteFileFromNode np
= do
handleAll (\e -> putStrLn $ show e) $
do
N.deleteFile fid False np
return ()
instance C.ControllerClass ControllerData where
closeController cd
= do
debugM localLogger "closing Server"
closeServer (cd_Server cd)
debugM localLogger "server closed"
getFileSites f cd
= withMVar (cd_FileController cd) $
\fc ->
do
dats <- getFileClientInfoList f (cd_Server cd) fc
let sids = map (\ci -> ci_Site ci) dats
return (Set.fromList sids)
containsFile f cd
= withMVar (cd_FileController cd) $
\fc -> return $ Map.member f (cm_FileToNodeMap fc)
getNearestNodePortWithFile f sid cd
= withMVar (cd_FileController cd) $
\fc -> lookupNearestPortWithFile f sid (cd_Server cd) fc
getNearestNodePortForFile f c sid cd
= withMVar (cd_FileController cd) $
\fc -> lookupNearestPortForFile f c sid (cd_Server cd) fc
createFile f nid cd
= modifyMVar (cd_FileController cd) $
\fc ->
do
mbCi <- getClientInfo nid (cd_Server cd)
case mbCi of
(Just ci) ->
do
let fc' = addFileToController f nid fc
mpCp <- lookupPortWithoutFile f (cd_Server cd) fc
case mpCp of
(Just cp) ->
do
return ()
(Nothing) -> return ()
return (fc', ())
(Nothing) -> return (fc,())
appendFile f nid cd
= modifyMVar (cd_FileController cd) $
\fc ->
do
mbCi <- getClientInfo nid (cd_Server cd)
case mbCi of
(Just ci) ->
do
let fc' = addFileToController f nid fc
cps <- getOtherFilePorts f nid (cd_Server cd) fc
let nps = map (\i -> NP.newNodePort (ci_Port i)) cps
mapM (N.copyFile f (ci_Port ci)) nps
return (fc', ())
(Nothing) -> return (fc,())
deleteFile f nid cd
= modifyMVar (cd_FileController cd) $
\fc ->
do
cps <- getOtherFilePorts f nid (cd_Server cd) fc
let nps = map (\ci -> NP.newNodePort (ci_Port ci)) cps
deleteFileFromNodes f nps
let fc' = deleteFileFromController f fc
return (fc', ())
instance Debug ControllerData where
printDebug cd
= do
putStrLn "Controller-Object (full)"
putStrLn "--------------------------------------------------------"
putStrLn "Server"
printDebug (cd_Server cd)
putStrLn "--------------------------------------------------------"
putStrLn "FileToNodeMap:"
withMVar (cd_FileController cd) $
\fc -> do
putStrLn $ show (cm_FileToNodeMap $ fc)