ControllerData.hs

-- ----------------------------------------------------------------------------

{- |
  Module     : Holumbus.FileSystem.Controller.ControllerData
  Copyright  : Copyright (C) 2008 Stefan Schmidt
  License    : MIT

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


-}

-- ----------------------------------------------------------------------------

module Holumbus.FileSystem.Controller.ControllerData
(
-- * datatypes
  ControllerData
  
-- * creation and destruction
, 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
    -- initialise the server
    c <- newEmptyMVar
    server <- newServer sn pn (dispatch c) (Just $ registerNode c) (Just $ unregisterNode c)
    -- initialize values
    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"
    
    
-- ----------------------------------------------------------------------------
--
-- ----------------------------------------------------------------------------


{-

nodes2sites :: ControllerMaps -> [M.NodeId] ->  [SiteId]
nodes2sites (ControllerMaps _ nsm _ _ _) nids = lookupList nsm nids 
 
sites2ports :: ControllerMaps -> [SiteId] ->  [NP.NodePort]
sites2ports (ControllerMaps _ _ spm _ _) sids = lookupList spm sids 


-- | gets all nodessites
getNodesList :: ControllerMaps -> [M.NodeId]
getNodesList (ControllerMaps _ nsm _ _ _) = Map.keys nsm


-- TODO
getNodesWithSpace :: S.FileId -> Integer -> ControllerMaps -> [SiteId]
getNodesWithSpace _ _ cm = getSiteList cm


getOtherFileNodes :: S.FileId -> M.NodeId -> ControllerMaps -> [M.NodeId]
getOtherFileNodes f nid (ControllerMaps fnm _ _ _ _)
  = Set.toList $ Set.delete nid allNids
  where
    allNids = Map.findWithDefault (Set.empty) f fnm   

-- | the minimal occurrence of a file on the nodes
copyingLimit :: Int
copyingLimit = 2


-- | Get a list of all fileIds that should be copied.
--   That means that the file has not enough copies
-- TODO we only compare the nodeid... we should look for sites or hosts
getFilesForCopying :: FileControllerData -> [S.FileId]
getFilesForCopying cm = (fst . unzip) filteredList 
  where
    fnm = cm_FileToNodeMap cm
    filteredList = filter setSelector (Map.toList fnm)
    setSelector (_,s) = Set.size s < copyingLimit
-}


-- | Adds the files of a node to the global directory.
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


-- | Deletes the files of a node from the global directory.
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
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


-- | gets the List of all sites the file is located on...
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

-- | gets the List of all sites the files are located on...
{-
trude :: SiteId -> [S.FileId] -> Server -> FileControllerData -> IO (Maybe SiteId)
trude currentSite files s cm
  = do
    let file2node       = cm_FileToNodeMap cm;
        nodeIdsWithFiles = concatMap (\file -> Set.toList $ maybe Set.empty id (Map.lookup file file2node)) files
    sitesIdsWithFiles <- foldM f ([],[],[]) nodeIdsWithFiles
    nearestId' sitesIdsWithFiles
    where

    nearestId' :: ([SiteId],[SiteId],[SiteId]) -> IO (Maybe SiteId)
    nearestId' ([],  [],  [])  = return Nothing                      -- no site id found
    nearestId' ([],  [],  xs)  = do 
      xs' <- shuffle xs
      return . Just . head $ xs' -- only others ids, shuffle and return the first
    nearestId' ([],  x:_, _)   = return $ Just x                     -- return the hosts stie
    nearestId' (x:_, _,   _)   = return $ Just x                     -- return the procs site

    f :: ([SiteId],[SiteId],[SiteId]) -> M.NodeId -> IO ([SiteId],[SiteId],[SiteId])
    f (procs,hosts,others) i = do
      cli <- getClientInfo i s
      case cli of
        Nothing -> return (procs,hosts,others)
        (Just clientInfo) -> insert (procs,hosts,others) (ci_Site clientInfo)
    
    insert :: ([SiteId],[SiteId],[SiteId]) -> SiteId -> IO ([SiteId],[SiteId],[SiteId])
    insert (procs,hosts,others) thisSite = if isSameProcess thisSite currentSite
                       then return (thisSite:procs,hosts,others)
                       else if isSameHost thisSite currentSite
                              then return (procs,thisSite:hosts,others)
                              else return (procs,hosts,thisSite:others)
-}

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

-- lookupNearestPortWithFileAndSpace :: S.FileId -> Integer -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)
-- lookupNearestPortWithFileAndSpace f _size sid s cm
--   = lookupNearestPortWithFile f sid s cm
{-    dats <- getFileClientInfoList f s cm
    -- TODO add Capacity
    let sids  = map (\ci -> ci_Site ci) $ filter (...) dats
        mbns  = nearestId sid sids
        mbdat = maybe Nothing (\ns -> List.find (\(s,_,_) -> s == ns) dats) mbns
        mbnp  = maybe Nothing (\(_,np,_) -> Just np) mbdat
    return mbnp 
-}

-- TODO add capacity
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
    -- get all sites with the files
    fileCis <- getFileClientInfoList f s cm
    -- get all sites
    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
  -- if file exists, get nearest node, else the closest with space
  = do
--    nodeWithFile    <- lookupNearestPortWithFileAndSpace f size sid s cm
    nodeWithoutFile <- lookupNearestPortWithSpace size sid s cm   
    let mbnp = maybe Nothing (\np -> Just np) nodeWithoutFile
{-  debugM localLogger $ "lookupNearestPortForFile: file:            " ++ show f    
    debugM localLogger $ "lookupNearestPortForFile: size:            " ++ show size
    debugM localLogger $ "lookupNearestPortForFile: site:            " ++ show sid    
    debugM localLogger $ "lookupNearestPortForFile: nodeWithFile:    " ++ show nodeWithFile
    debugM localLogger $ "lookupNearestPortForFile: nodeWithoutFile: " ++ show nodeWithoutFile
    debugM localLogger $ "lookupNearestPortForFile: result:          " ++ show mbnp
-}  return mbnp
    

{-  = do
    dats <- getAllClientInfos s :: [ClientInfo]
    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-}

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)]
--  infoM localLogger $  "Getting nearest ports for: " ++ show l  
--  res <- foldM f [] l
--  infoM localLogger $  "Clientportmap is: " ++ show res
--  return res
--  where
--
--  f :: M.ClientPortMap -> (S.FileId,Integer) -> IO M.ClientPortMap
--  f theMap (fid,len) = do
--    infoM localLogger $  "Getting nearest ports for: " ++ fid
--    mp <- lookupNearestPortForFile fid len sid s cm
--    debugM localLogger $  "Nearest ports: " ++ show mp
--    cpm <- case mp of
--      (Just port) -> return (ins port fid theMap)
--      Nothing -> return theMap
--    return cpm

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
    -- get all nodes which hold the file without the given node
    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 
          -- send a delete-request to the node 
          -- but don't inform the controller again (False)
          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 :: S.FileId -> Controller -> IO (Set.Set SiteId) 
  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 :: S.FileId -> Controller -> IO Bool
  containsFile f cd
    = withMVar (cd_FileController cd) $
        \fc -> return $ Map.member f (cm_FileToNodeMap fc)
  
      
  -- getNearestNodePortWithFile :: S.FileId -> SiteId -> c -> IO (Maybe M.NodeRequestPort)
  getNearestNodePortWithFile f sid cd
    = withMVar (cd_FileController cd) $
        \fc -> lookupNearestPortWithFile f sid (cd_Server cd) fc 

  -- getNearestNodePortWithFiles :: [S.FileId] -> SiteId -> c -> IO (Maybe M.NodeRequestPort)
  getNearestNodePortWithFiles l sid cd
    = withMVar (cd_FileController cd) $
        \fc -> lookupNearestPortWithFiles l sid (cd_Server cd) fc 

  -- getNearestNodePortForFile :: S.FileId -> Integer -> SiteId -> c -> IO (Maybe M.NodeRequestPort)
  getNearestNodePortForFile f c sid cd
    = withMVar (cd_FileController cd) $
        \fc -> lookupNearestPortForFile f c sid (cd_Server cd) fc

  -- getNearestNodePortForFiles :: [(S.FileId,Integer)] -> SiteId -> c -> IO (ClientPortMap)
  getNearestNodePortForFiles l sid cd
    = withMVar (cd_FileController cd) $
        \fc -> lookupNearestPortForFiles l sid (cd_Server cd) fc
-- ----------------------------------------------------------------------------
-- used by the nodes
-- ----------------------------------------------------------------------------


--createFile :: S.FileId -> M.NodeId -> ControllerData -> IO ControllerData
  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
            -- copy file to one other node
            mpCp <- lookupPortWithoutFile f (cd_Server cd) fc
            case mpCp of
              (Just _) -> 
                do 
                return ()
                -- let np = NP.newNodePort cp
                -- N.copyFile f (ci_Port ci) np
              (Nothing) -> return ()                  
            return (fc', ())
          (Nothing) -> return (fc,())

--createFiles :: [(S.FileId,M.NodeId)] -> ControllerData -> IO ControllerData
  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
            -- copy file to one other node
--            mpCp <- lookupPortWithoutFile f (cd_Server cd) fc
--            case mpCp of
--              (Just _) ->
--                do
--                return ()
                -- let np = NP.newNodePort cp
                -- N.copyFile f (ci_Port ci) np
--              (Nothing) -> return ()
              return fc'
            (Nothing) -> return filecontroller


--appendFile :: S.FileId -> M.NodeId -> ControllerData -> IO ControllerData
  appendFile f nid cd
    = modifyMVar (cd_FileController cd) $
        \fc ->
        do
        mbCi <- getClientInfo nid (cd_Server cd)
        case mbCi of
          (Just ci) ->
            do
            -- renew file entry
            let fc' = addFileToController f nid fc
            -- get other nodes with this file
            cps <- getOtherFilePorts f nid (cd_Server cd) fc
            let nps = map (\i -> NP.newNodePort (ci_Port i)) cps
            -- order them to copy the file from the first node
            _ <- mapM (N.copyFile f (ci_Port ci)) nps
            return (fc', ())
          (Nothing) -> return (fc,())


--deleteFile :: S.FileId -> M.NodeId -> ControllerData -> IO ControllerData
  deleteFile f nid cd
    = modifyMVar (cd_FileController cd) $
        \fc ->
        do
        -- inform all other nodes to delete node
        cps <- getOtherFilePorts f nid (cd_Server cd) fc
        let nps = map (\ci -> NP.newNodePort (ci_Port ci)) cps
        deleteFileFromNodes f nps
        -- delete file from Controller
        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")