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
import Control.Monad (foldM)
import System.Random
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.CReqGetNearestNodePortWithFiles l sid) ->
do
portmap <- C.getNearestNodePortWithFiles l sid cd
return $ Just $ M.CRspGetNearestNodePortWithFiles portmap
(M.CReqGetNearestNodePortForFile f l sid) ->
do
p <- C.getNearestNodePortForFile f l sid cd
return $ Just $ M.CRspGetNearestNodePortForFile p
(M.CReqGetNearestNodePortForFiles l sid) ->
do
p <- C.getNearestNodePortForFiles l sid cd
return $ Just $ M.CRspGetNearestNodePortForFiles p
(M.CReqCreate f n) ->
do
C.createFile f n cd
return $ Just $ M.CRspSuccess
(M.CReqCreateS l) ->
do
C.createFiles l 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 = cm { cm_FileToNodeMap = fnm' }
where
fnm = cm_FileToNodeMap cm
fnm' = Map.insert fid nid' fnm
nid' = Set.singleton nid
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
shuffle :: [a] -> IO [a]
shuffle l' = shuffle' l' []
where
shuffle' [] acc = return acc
shuffle' l acc = do
k <- randomRIO (0, length l 1)
let (lead, x:xs) = splitAt k l
shuffle' (lead ++ xs) (x:acc)
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
sids <- shuffle sids'
let 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
lookupNearestPortWithFiles :: [S.FileId] -> SiteId -> Server -> FileControllerData -> IO M.ClientPortMap
lookupNearestPortWithFiles l sid s cm = do
infoM localLogger $ "Getting nearest ports with: " ++ show l
res <- foldM f [] l
infoM localLogger $ "Clientportmap is: " ++ show res
return res
where
f :: M.ClientPortMap -> S.FileId -> IO M.ClientPortMap
f theMap fid = do
infoM localLogger $ "Getting nearest ports with: " ++ fid
maybeport <- lookupNearestPortWithFile fid sid s cm
debugM localLogger $ "Nearest ports: " ++ show maybeport
case maybeport of
(Just port) -> return (ins port fid theMap)
Nothing -> return theMap
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
sids <- shuffle sids'
let 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 _ size sid s cm
= do
nodeWithoutFile <- lookupNearestPortWithSpace size sid s cm
let mbnp = maybe Nothing (\np -> Just np) nodeWithoutFile
return mbnp
lookupNearestPortForFiles :: [(S.FileId,Integer)] -> SiteId -> Server -> FileControllerData -> IO M.ClientPortMap
lookupNearestPortForFiles l sid s cm = do
nearestPortWithSpace <- lookupNearestPortWithSpace 0 sid s cm
case nearestPortWithSpace of
Nothing -> return []
(Just p) -> return [(p,map fst l)]
ins :: ClientPort -> S.FileId -> M.ClientPortMap -> M.ClientPortMap
ins port fid [] = [(port,[fid])]
ins port fid ((p,fids):[]) = if (p==port)
then [(p,(fid:fids))]
else [(port,[fid]),(p,fids)]
ins port fid ((p,fids):ps) = if (p==port)
then ((p,fid:fids):ps)
else (p,fids):(ins port fid ps)
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
getNearestNodePortWithFiles l sid cd
= withMVar (cd_FileController cd) $
\fc -> lookupNearestPortWithFiles l sid (cd_Server cd) fc
getNearestNodePortForFile f c sid cd
= withMVar (cd_FileController cd) $
\fc -> lookupNearestPortForFile f c sid (cd_Server cd) fc
getNearestNodePortForFiles l sid cd
= withMVar (cd_FileController cd) $
\fc -> lookupNearestPortForFiles l 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 _) ->
do
let fc' = addFileToController f nid fc
mpCp <- lookupPortWithoutFile f (cd_Server cd) fc
case mpCp of
(Just _) ->
do
return ()
(Nothing) -> return ()
return (fc', ())
(Nothing) -> return (fc,())
createFiles l cd
= modifyMVar (cd_FileController cd) $
\fc ->
do
fc'' <- foldM f fc l
return (fc'',())
where
f :: FileControllerData -> (S.FileId,M.NodeId) -> IO FileControllerData
f filecontroller (fid,nid) = do
mbCi <- getClientInfo nid (cd_Server cd)
case mbCi of
(Just _) ->
do
let fc' = addFileToController fid nid filecontroller
return fc'
(Nothing) -> return filecontroller
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)
getDebug cd
= do
let line = "--------------------------------------------------------"
tmp <- getDebug (cd_Server cd)
tmp2 <- withMVar (cd_FileController cd) $
\fc -> do
return $ show (cm_FileToNodeMap $ fc)
return ( "Controller-Object (full)"
++"\n"++ line
++"\n"++ "Server"
++"\n"++ tmp
++"\n"++ line
++"\n"++ "FileToNodeMap:"
++"\n"++tmp2++"\n")