Holumbus-Storage-0.1.0: source/Holumbus/FileSystem/FileSystem.hs

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

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

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


-}

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

{-# OPTIONS -fglasgow-exts #-}
module Holumbus.FileSystem.FileSystem
(
-- * Datatypes
  S.FileId
, S.FileContent
, S.getContentLength
, S.FileData(..)
, FileSystem

-- * Configuration
, FSStandaloneConf(..)
, defaultFSStandaloneConfig
, FSControllerConf(..)
, defaultFSControllerConfig
, FSNodeConf(..)
, defaultFSNodeConfig
, FSClientConf(..)
, defaultFSClientConfig

-- * Creation and Destruction
, mkStandaloneFileSystem
, mkFileSystemController
, mkFileSystemNode
, mkFileSystemClient
, closeFileSystem

-- * Operations
, getMySiteId
, getFileSites
, getNearestNodePortWithFile
, getNearestNodePortForFile
, containsFile

, createFile
, createFiles
, appendFile
, deleteFile

, getFileContent
, getMultiFileContent
, getFileData
, isFileLocal

)
where

import           Prelude hiding (appendFile)

import           Control.Concurrent
import           Control.Monad


import qualified Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map
import           System.Log.Logger

import           Holumbus.Common.Debug

import qualified Holumbus.FileSystem.Controller                as C
import qualified Holumbus.FileSystem.Controller.ControllerData as CD
import qualified Holumbus.FileSystem.Controller.ControllerPort as CP

import qualified Holumbus.FileSystem.Node                      as N
import qualified Holumbus.FileSystem.Node.NodeData             as ND
import qualified Holumbus.FileSystem.Node.NodePort             as NP

import qualified Holumbus.FileSystem.Storage                   as S
import qualified Holumbus.FileSystem.Storage.FileStorage       as FST

import           Holumbus.Network.Site
import           Holumbus.Network.Communication

import Holumbus.FileSystem.Messages (ClientPortMap)

localLogger :: String
localLogger = "Holumbus.FileSystem.FileSystem"
 
-- ---------------------------------------------------------------------------
-- Datatypes
-- ---------------------------------------------------------------------------

data FileSystemData = 
   forall c n. (C.ControllerClass c, N.NodeClass n, Debug c, Debug n) =>
   FileSystemData SiteId c (Maybe n)
--    fsd_siteId     :: SiteId
--  , fsd_controller :: MVar c
--  , fsd_nodep      :: forall n. (N.Node n) => MVar (Maybe n)
--}

data FileSystem = FileSystem (MVar FileSystemData)

instance Show FileSystem where
  show _ = "FileSystem"



-- ---------------------------------------------------------------------------
-- Configurations
-- ---------------------------------------------------------------------------


data FSStandaloneConf = FSStandaloneConf {
    fstc_StreamName       :: StreamName
  , fstc_StoragePath      :: FilePath
  , fstc_StorageFile      :: FilePath
  } 
  
defaultFSStandaloneConfig :: FSStandaloneConf
defaultFSStandaloneConfig = FSStandaloneConf "FSController" "storage/" "directory"


data FSControllerConf = FSControllerConf {
    fcoc_StreamName       :: StreamName
  , fcoc_PortNumber       :: Maybe PortNumber
  }
   
defaultFSControllerConfig :: FSControllerConf
defaultFSControllerConfig = FSControllerConf "FSController" Nothing


data FSNodeConf = FSNodeConf {
    fnoc_StreamName       :: StreamName
  , fnoc_SocketId         :: Maybe SocketId
  , fnoc_StoragePath      :: FilePath
  , fnoc_StorageFile      :: FilePath
  }
   
defaultFSNodeConfig :: FSNodeConf
defaultFSNodeConfig = FSNodeConf "FSController" Nothing "storage/" "directory"


data FSClientConf = FSClientConf {
    fclc_StreamName       :: StreamName
  , fclc_SocketId         :: Maybe SocketId
  }
   
defaultFSClientConfig :: FSClientConf
defaultFSClientConfig = FSClientConf "FSController" Nothing




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


mkStandaloneFileSystem
  :: FSStandaloneConf 
  -> IO (FileSystem)
mkStandaloneFileSystem conf
  = do
    controller <- CD.newController (fstc_StreamName conf) Nothing
    let storage = FST.newFileStorage (fstc_StoragePath conf) (fstc_StorageFile conf) 
    node <- ND.newNode (fstc_StreamName conf) Nothing storage
    fs <- newFileSystem controller (Just node)
    return fs


mkFileSystemController
  :: FSControllerConf
  -> IO (FileSystem)
mkFileSystemController conf
  = do
    sid <- getSiteId
    infoM localLogger $ "initialising controller on site " ++ show sid  
    controller <- CD.newController (fcoc_StreamName conf) (fcoc_PortNumber conf)
    newFileSystem controller (Nothing::Maybe NP.NodePort)
  

mkFileSystemNode
  :: FSNodeConf
  -> IO (FileSystem)
mkFileSystemNode conf
  = do
    sid <- getSiteId
    infoM localLogger $ "initialising node on site " ++ show sid  
    cp <- CP.newControllerPort (fnoc_StreamName conf) (fnoc_SocketId conf)
    infoM localLogger "creating filestorage"
    let storage = FST.newFileStorage (fnoc_StoragePath conf) (fnoc_StorageFile conf) 
    node <- ND.newNode (fnoc_StreamName conf) (fnoc_SocketId conf) storage
    newFileSystem cp (Just node)
  

mkFileSystemClient
  :: FSClientConf
  -> IO (FileSystem)
mkFileSystemClient conf
  = do
    sid <- getSiteId
    infoM localLogger $ "initialising client on site " ++ show sid  
    cp <- CP.newControllerPort (fclc_StreamName conf) (fclc_SocketId conf)
    newFileSystem cp (Nothing::Maybe NP.NodePort)


-- | Closes the filesystem.
closeFileSystem :: FileSystem -> IO ()
closeFileSystem (FileSystem fs) 
  = do
    debugM localLogger "beginning to close filesystem"
    withMVar fs $
      \(FileSystemData _ c n) ->
      do
      case n of
        (Just n') -> 
          do
          debugM localLogger "closing Node"
          N.closeNode n'
        (Nothing) -> 
          do
          debugM localLogger "no Node to close"
          return ()
      debugM localLogger "closing Controller"
      C.closeController c
      debugM localLogger "filesystem closed"



-- ---------------------------------------------------------------------------
-- private helper-functions
-- ---------------------------------------------------------------------------


-- | Creates a new FileSystem with a controller and (maybe) a node.
newFileSystem :: (C.ControllerClass c, N.NodeClass n, Debug c, Debug n) => c -> Maybe n -> IO (FileSystem)
newFileSystem c n
  = do
    sid <- getSiteId
    fs <- newMVar (FileSystemData sid c n)
    return (FileSystem fs)


-- | get a NodePort from a NodeRequestPort
createNodePort :: (Maybe ClientPort) -> (Maybe NP.NodePort)
createNodePort Nothing = Nothing
createNodePort (Just p) = Just $ NP.newNodePort p


-- ---------------------------------------------------------------------------
-- public functions
-- ---------------------------------------------------------------------------

getMySiteId :: FileSystem -> IO (SiteId)
getMySiteId (FileSystem fs)
  = do 
    withMVar fs $
      \(FileSystemData s _ _) -> return s

-- | Get a set of all sites the file exists.
getFileSites :: S.FileId -> FileSystem -> IO (Set.Set SiteId)
getFileSites f (FileSystem fs)
  = do
    withMVar fs $
      \(FileSystemData _ c _) -> 
      C.getFileSites f c


-- | gets the nearest NodePort with our fileId
getNearestNodePortWithFile :: S.FileId -> FileSystem -> IO (Maybe NP.NodePort)
getNearestNodePortWithFile f (FileSystem fs)
  = withMVar fs $
      \(FileSystemData sid c _) -> 
      (liftM createNodePort) $ C.getNearestNodePortWithFile f sid c
    
-- | gets the nearest NodePorts with list of fileId
getNearestNodePortWithFiles :: [S.FileId] -> FileSystem -> IO [(NP.NodePort,[S.FileId])]
getNearestNodePortWithFiles l (FileSystem fs)
  = withMVar fs $
      \(FileSystemData sid c _) -> do
        infoM localLogger $ "Searching for nearest ports with files"
        ports <- C.getNearestNodePortWithFiles l sid c
        infoM localLogger $ ">>>>>>>>>>>>>>> " ++ show ports
        let result = createPortList ports
        debugM localLogger $ "Found ports" ++ show ports
        return result


-- | gets the nearest NodePort on which we can create our fileId. we need the
--   content-size to get a node with enough space.
getNearestNodePortForFile :: S.FileId -> Integer -> FileSystem -> IO (Maybe NP.NodePort)
getNearestNodePortForFile f l (FileSystem fs)
  = withMVar fs $
      \(FileSystemData sid c _) ->
      (liftM createNodePort) $ C.getNearestNodePortForFile f l sid c

-- | gets the nearest NodePort on which we can create our files. Iterate through the list and give back a result, where each nodeport is assosiated with the list of files it can handle. If we have an empty Storage system, one pair is returned. If there are existing files in the list, the files are stored on the node, they exists on.
getNearestNodePortForFiles :: [(S.FileId,Integer)] -> FileSystem -> IO [(NP.NodePort,[S.FileId])]
getNearestNodePortForFiles l (FileSystem fs)
  = withMVar fs $
      \(FileSystemData sid c _) -> do
      infoM localLogger $ "Searching for nearest ports"
      ports <- C.getNearestNodePortForFiles l sid c
      let result = createPortList ports
      debugM localLogger $ "Found ports" ++ show ports
      return result

createPortList :: ClientPortMap -> [(NP.NodePort,[S.FileId])]
createPortList [] = []
createPortList ((p,fids):ps) = case createNodePort (Just p) of
                        (Just p') -> ( (p',fids) : (createPortList ps) )
                        Nothing -> createPortList ps


-- | Checks if a file is in the filesystem
containsFile :: S.FileId -> FileSystem -> IO Bool
containsFile f (FileSystem fs)
  = do
    withMVar fs $
      \(FileSystemData _ c _) ->
      C.containsFile f c


-- | Creates a file in the filesystem.
createFile :: S.FileId -> S.FileContent -> FileSystem -> IO ()
createFile f c fs
  = do
    infoM localLogger $ "creating file: " ++ show f
    np <- getNearestNodePortForFile f (S.getContentLength c) fs
    case np of
      (Nothing) -> return ()
      (Just np') -> 
        do 
        N.createFile f c np'
        return ()

-- | Creates a list of files in the filesystem.
createFiles :: [(S.FileId,S.FileContent)] -> FileSystem -> IO ()
createFiles l fs = do
  infoM localLogger $ "creating files: " ++ (show . map fst $ l)
  nps <- getNearestNodePortForFiles (map (\(fid,c) -> (fid,S.getContentLength c)) l) fs
  debugM localLogger $ "Nodes to files map:" ++ show nps
  mapM_ (\(node,fids) -> N.createFiles (filesToStore fids) node) nps
    where
    asMap :: Map.Map S.FileId S.FileContent
    asMap = Map.fromList l

    filesToStore :: [S.FileId] -> [(S.FileId,S.FileContent)]
    filesToStore = L.foldl' addFile [] 

    addFile :: [(S.FileId,S.FileContent)] -> S.FileId -> [(S.FileId,S.FileContent)]
    addFile l' fid = case Map.lookup fid asMap of
                      Nothing -> l'
                      (Just c) -> ((fid,c):l')

-- | Appends a file in the fileSystem.
appendFile :: S.FileId -> S.FileContent -> FileSystem -> IO ()
appendFile f c fs
  = do
    infoM localLogger $ "appending file: " ++ show f
    np <- getNearestNodePortForFile f (S.getContentLength c) fs
    debugM localLogger $ "nearest port: " ++ show np
    case np of
      (Nothing) -> return ()
      (Just np') ->
        do
        N.appendFile f c np'
        return ()


-- | Deletes a file from the filesystem.
deleteFile :: S.FileId -> FileSystem -> IO ()
deleteFile f fs
  = do
    infoM localLogger $ "deleting file: " ++ show f
    np <- getNearestNodePortWithFile f fs
    case np of
      (Nothing) -> return ()
      (Just np') ->
        do
        -- start a delete cascade... (True)
        N.deleteFile f True np'
        return ()


-- | Gets the file content from the nearest site whitch holds the file
getFileContent :: S.FileId -> FileSystem -> IO (Maybe S.FileContent)
getFileContent f fs
  = do
    infoM localLogger $ "getting file: " ++ show f
    np <- getNearestNodePortWithFile f fs
    case np of
      (Nothing) -> return Nothing
      (Just np') ->
        do
        N.getFileContent f np' 

-- | Gets the file content from the nearest site whitch holds the file
getMultiFileContent :: [S.FileId] -> FileSystem -> IO [(S.FileId,S.FileContent)]
getMultiFileContent l fs
  = do
    infoM localLogger $ "getting files: " ++ (show l)
    portmap <- getNearestNodePortWithFiles l fs
    infoM localLogger $ "ports with files: " ++ show portmap
    res <- mapM f portmap
    return . concat $ res
    where
    f :: (NP.NodePort,[S.FileId]) -> IO [(S.FileId,S.FileContent)]
    f (np,files) = N.getMultiFileContent files np

-- | Gets the file data from the nearest site whitch holds the file
getFileData :: S.FileId -> FileSystem -> IO (Maybe S.FileData)
getFileData f fs 
  = do
    np <- getNearestNodePortWithFile f fs
    case np of
      (Nothing) -> return Nothing
      (Just np') ->
        do
        N.getFileData f np' 


-- | Tests, if the local storage (if one exists) holds the file
isFileLocal :: S.FileId -> FileSystem -> IO Bool
isFileLocal f (FileSystem fs)
  = do
    withMVar fs $
      \(FileSystemData _ _ n) ->
      maybe (return False) (\n' -> N.containsFile f n') n


instance Debug FileSystem where  
  printDebug (FileSystem fs)
    = do
      withMVar fs $
        \(FileSystemData s c n) ->
        do
        putStrLn "--------------------------------------------------------"
        putStrLn "FileSystem - internal data\n"
        putStrLn "--------------------------------------------------------"
        putStrLn "SiteId:"
        putStrLn $ show s
        putStrLn "--------------------------------------------------------"
        putStrLn "Controller:"
        printDebug c
        putStrLn "--------------------------------------------------------"
        putStrLn "Node:"
        maybe (putStrLn "NOTHING") (\n' -> printDebug n') n
        putStrLn "--------------------------------------------------------"
  getDebug (FileSystem fs)
    = do
      tmp <- withMVar fs $
        \(FileSystemData s c n) ->
        do
        tmp <-  getDebug c
        tmp2 <- maybe (return "NOTHING") (\n' -> getDebug n') n
        let line = "--------------------------------------------------------"
        return (line
          ++"\n"++ "FileSystem - internal data\n"
          ++"\n"++ line
          ++"\n"++ "SiteId:"
          ++"\n"++ show s
          ++"\n"++ line
          ++"\n"++ "Controller:"
          ++"\n"++ tmp
          ++"\n"++ line
          ++"\n"++ "Node:"
          ++"\n"++ tmp2
          ++"\n"++ line ++"\n")
      return tmp