halfs-0.2: Halfs/FSRoot.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  FSRoot
-- 
-- Maintainer  :  Isaac Jones <ijones@galois.com>
-- Stability   :  alpha
-- Portability :  GHC
--
-- Explanation: Represents the root of a filesystem and encapsulates
-- the caches.

module Halfs.FSRoot (FSRoot(..), FileSystemStats(..),
               addToInodeCache,
               allocateInode, getFromInodeCache, emptyInodeCache,
               fsRootUpdateInodeCache,
               fsRootInode, fsRootAllInodeNums, fsStats,
               fsRootBmInode, fsRootRootDirInode, fsRootImInode,
               fsRootUpdateDirectoryCache, fsRootRmFromDirectoryCache,
               Directory, -- from Halfs.Directory
               FSStatus(..), InodeCacheAddStyle(..),
               BufferBlockCache, InodeNum, InodeCache)
where

import Halfs.TheBlockMap(TheBlockMap(..))
import Halfs.BufferBlockCache (BufferBlockCache)
import Data.Integral ( INInt )
import Halfs.Utils (bytesPerBlock,
                    rootInodeNum, blockMapInodeNum, rootDirInodeNum,
                    inodeMapInodeNum, FileType(File))
import System.RawDevice(RawDevice)
import Halfs.Inode (Inode(..), InodeMetadata (..), newInode,
                    newFSRootInode, newFSBlockMapInode,
                    newFSRootDirInode, newFSInodeMapInode)
import Halfs.TheInodeMap(TheInodeMap(..))
import Halfs.Directory(Directory(..), DirectoryCache, addDirectoryToCache,
                       rmDirectoryFromCache)

-- base
import Control.Exception(assert)
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Queue (queueLength)
import Data.Set(Set)
import qualified Data.Set as Set

type InodeNum = INInt

-- |Maps the inode number to the inode.
type InodeCache    = (Map InodeNum Inode, Bool)

data FSRoot = FSRoot {device         :: RawDevice
                     -- ^The "raw" interface for reading & writing blocks.
                     ,bbCache        :: BufferBlockCache
                     -- ^Maps the disk address to a cache of the blocks.
                     ,blockMap       :: TheBlockMap
                     -- ^A queue of free blocks.
                     ,inodeCache     :: InodeCache
                     -- ^Maps the inode number to the inode.
                     ,inodeMap       :: TheInodeMap
                     -- ^Keeps track of freed inodes so we can reuse their space.
                     ,directoryCache :: DirectoryCache
                     -- ^Maps from inode numbers to directories.
                     ,fsStatus       :: FSStatus
                     -- ^mounted or unmounted?
                     }

data FSStatus = FsUnmounted | FsReadOnly | FsReadWrite deriving (Eq, Show)

data FileSystemStats = FileSystemStats
    { blockSize :: Integer
      -- ^ Optimal transfer block size in bytes.
    , blockCount :: Integer
      -- ^ Total data blocks in file system.
    , blocksFree :: Integer
      -- ^ Free blocks in file system.
    , blocksAvailable :: Integer
      -- ^ Free blocks available to non-superusers.
    , fileCount :: Integer
      -- ^ Total file nodes in file system.
    , filesFree :: Integer
      -- ^ Free file nodes in file system.
    , maxNameLength :: Integer
      -- ^ Maximum length of filenames. FUSE default is 255.
    }

-- |Behavior if it's already in the cache
data InodeCacheAddStyle
    = InodeCacheOverwrite -- ^if so, overwrite it.  If not, add it.
    | InodeCacheKeep      -- ^if so, keep the cache version
    | InodeCacheError     -- ^if so, that's an error! throw assertion.
      deriving Eq
-- Compare by disk number
instance Eq FSRoot where
  (==) FSRoot{device=one} FSRoot{device=two}
      = one == two

-- Compare by disk number
instance Ord FSRoot where
  compare FSRoot{device=one} FSRoot{device=two}
      = compare one two

-- |Type is a little funny because it's useful for a fold!
addToInodeCache :: InodeCacheAddStyle -- ^add it even if it's already there?
                -> (InodeCache, InodeNum) -- ^old cache, old biggest inode
                -> Inode -- ^inode to add
                -> (InodeCache, InodeNum) -- new cache, next inode num
addToInodeCache style p@(c@(iCache, _), num) i =
  case style of
    InodeCacheOverwrite -> adder p i
    _ -> case Map.lookup num iCache of
           Nothing -> adder p i
           Just _  -> ( c
                      , assert (style /= InodeCacheError)  (num+1)) -- throw it away.
    where
     adder :: (InodeCache, InodeNum) -> Inode -> (InodeCache, InodeNum)
     adder ((inCache, _), inodeNum) inode@Inode{metaData=md}
         = ((Map.insert inodeNum inode{metaData=md{inode_num=inodeNum}} inCache, True)
           ,inodeNum + 1)

-- |Not a new element, just update the old entry in the cache, so
-- doesn't increase number of inodes.
fsRootUpdateInodeCache :: FSRoot -> Inode -> FSRoot
fsRootUpdateInodeCache fsroot@FSRoot{inodeCache=(ic, _)}
                       inode@Inode{metaData=InodeMetadata{inode_num=inodeNum}}
    = fsroot{inodeCache=(Map.insert inodeNum inode ic, True)}

getFromInodeCache :: InodeCache -> InodeNum -> Maybe Inode
getFromInodeCache (cache, _) n = Map.lookup n cache

emptyInodeCache :: InodeCache
emptyInodeCache = (Map.empty, True)

fsRootInode :: FSRoot -> Inode
fsRootInode FSRoot{inodeCache=c}
    = case getFromInodeCache c rootInodeNum of
       Nothing -> assert False newFSRootInode -- shouldn't happen.
       Just a  -> a

fsRootBmInode :: FSRoot -> Inode
fsRootBmInode FSRoot{inodeCache=c}
    = case getFromInodeCache c blockMapInodeNum of
       Nothing -> assert False newFSBlockMapInode -- shouldn't happen.
       Just a  -> a

fsRootRootDirInode :: FSRoot -> Inode
fsRootRootDirInode FSRoot{inodeCache=c}
    = case getFromInodeCache c rootDirInodeNum of
       Nothing -> assert False newFSRootDirInode -- shouldn't happen.
       Just a  -> a

fsRootImInode :: FSRoot -> Inode
fsRootImInode FSRoot{inodeCache=c}
    = case getFromInodeCache c inodeMapInodeNum of
       Nothing -> assert False newFSInodeMapInode -- shouldn't happen.
       Just a  -> a

-- |Creates a new inode out of thin air and puts it into the inode
-- cache, and returns its number.
allocateInode :: FSRoot
              -> (INInt, FSRoot)
allocateInode fsRoot@FSRoot{inodeMap=inMap@TheInodeMap{freeInodes=[]
                                                      ,imMaxNum=numInodes},
                            inodeCache=inCache
                           } =
  let (newCache, newNumInodes)
          = addToInodeCache InodeCacheOverwrite (inCache, numInodes) (newInode numInodes File)
      in (numInodes, fsRoot{inodeCache=newCache
                            ,inodeMap=inMap{imDirty=True,
                                            imMaxNum=newNumInodes}})
-- initialize h in case it's right from the disk?
allocateInode fs@FSRoot{inodeMap=im@TheInodeMap{freeInodes=(h:t)}}
    = (h, fs{inodeMap=im{freeInodes=t, imDirty=True}})

fsRootUpdateDirectoryCache :: Directory -> FSRoot -> FSRoot
fsRootUpdateDirectoryCache dir fsroot@FSRoot{directoryCache=c}
    = fsroot{directoryCache=addDirectoryToCache c dir}

fsRootRmFromDirectoryCache :: INInt -- The inode number of the directory to remove
                           -> FSRoot
                           -> FSRoot
fsRootRmFromDirectoryCache dirInodeNum fsroot@FSRoot{directoryCache=c}
    = fsroot{directoryCache=rmDirectoryFromCache c dirInodeNum}

fsRootAllInodeNums :: FSRoot -> Set INInt
fsRootAllInodeNums FSRoot{inodeMap=theInMap}
    = let maxInode = (imMaxNum theInMap) - 1
        in (Set.fromList (0:[blockMapInodeNum .. maxInode]))
                          `Set.difference` (Set.fromList $ freeInodes theInMap)

fsStats :: FSRoot -> IO FileSystemStats
fsStats fsroot = do
  let availBlocks = toInteger $ queueLength $ freeBlocks $ blockMap $ fsroot
  return FileSystemStats{blockSize=toInteger bytesPerBlock
                        ,blockCount=toInteger $ bmTotalSize $ blockMap fsroot
                        ,blocksFree=availBlocks
                        ,blocksAvailable=availBlocks
                        ,fileCount=toInteger
                                     $ Set.size $ fsRootAllInodeNums fsroot
                        ,filesFree=0
                        ,maxNameLength=255
                        }