-----------------------------------------------------------------------------
-- |
-- Module      :  Halfs.Inode
-- 
-- Maintainer  :  Isaac Jones <ijones@galois.com>
-- Stability   :  alpha
-- Portability :  GHC
--
-- Explanation: Represents inodes in the system.
--
-- The root inode is a file containing all of the inodes in the
-- system.  This file never shrinks.

module Halfs.Inode (Inode(..), InodeBlock, InodeMetadata(..)
                   ,newFSRootInode, newFSBlockMapInode, newFSRootDirInode
                   ,newFSInodeMapInode, dupInode
                   ,rootInodeDiskAddr, firstFreeInodeDiskAddr
                   ,getPointerAt, updatePointers, isRootDirInode
                   ,goodInodeMagic, inodeBumpSize, newInode, inodeAddLink)
    where

import Binary(Binary(..), Bin(..),tellBin,seekBin)
import Halfs.Utils hiding (bytesPerBlock)
import qualified Halfs.Utils (bytesPerBlock)
import Data.Integral
import Data.Array(listArray, (!), (//), elems)
import Control.Exception(assert)

bytesPerBlock :: INLong
bytesPerBlock = intToINLong Halfs.Utils.bytesPerBlock

data Inode
    = Inode
      {
       metaData       :: InodeMetadata
      ,blockPtrs      :: INPointers -- 16 pointers @ 32 bits each
      } deriving (Show, Eq)

-- |Must be length 16
type InodeBlock = [Inode]

updatePointers :: Inode -> [(Int, INInt)] -> Inode
updatePointers inode@Inode{blockPtrs=ptrs} updatedPtrs
    = inode{blockPtrs=ptrs // (assert ((length (filter (\(x,_) ->
                                                            x >= blockPointersPerInode)
                                                       updatedPtrs))
                                              == 0)
                                       updatedPtrs)}

-- |Copy the important bits of this inode, bit not all of them; ,
-- leave the inode number alone, but copy everthing else.
dupInode :: Inode -- ^Source inode
         -> Inode -- ^Copy to here
         -> Inode -- ^Resulting inode
dupInode fromI@Inode{metaData=fromMD} _toI@Inode{metaData=toMD}
    = fromI{metaData=fromMD{magic1   =magic1 toMD
                           ,inode_num=inode_num toMD
                           }
           }

newFSRootInode :: Inode
newFSRootInode = let tempInode1 = newInode rootInodeNum File
                     tempInode  = tempInode1{metaData=(metaData tempInode1)
                                                  {magic1=rootInodeMagicNum}}
            in
             inodeBumpSize (updatePointers tempInode [(0, rootInodeDiskAddr),
                                                      (1, rootInodeDiskAddr + 1)])
                           (bytesPerBlock * 2)

-- See notes about the block map in TheBlockMap.hs.  Block map
-- filesize never changes.
newFSBlockMapInode :: Inode
newFSBlockMapInode = inodeBumpSize (updatePointers (newInode blockMapInodeNum File)
                                [(0,blockMapInodeDiskAddr)])
                              bytesPerBlock

newFSInodeMapInode :: Inode
newFSInodeMapInode = inodeBumpSize (updatePointers (newInode inodeMapInodeNum File)
                               [(0, inodeMapInodeDiskAddr)])
                              bytesPerBlock

newFSRootDirInode :: Inode
newFSRootDirInode = inodeBumpSize (updatePointers (newInode rootDirInodeNum Dir)
                               [(0, rootDirInodeDiskAddr)])
                              bytesPerBlock

goodInodeMagic :: Inode -> Bool
goodInodeMagic Inode{metaData=InodeMetadata{magic1=magicNum
                                           ,inode_num=num}}
    = if num == rootInodeNum
       then magicNum == rootInodeMagicNum
       else magicNum == otherInodeMagicNum

-- |Is this the rootDir inode?
isRootDirInode :: Inode -> Bool
isRootDirInode Inode{metaData=InodeMetadata{inode_num=inodeNum}}
    = inodeNum == rootDirInodeNum

-- |Create a new inode based on this inode number
newInode :: INInt -> FileType -> Inode
newInode num filetype
    =  let inodeMD = InodeMetadata otherInodeMagicNum 0 0 0
                              filetype
                              num -- inode number
                              0 0 0 0 -- so far unused
                              1 -- level
   in Inode inodeMD (listArray (0, blockPointersPerInode - 1)
                       (replicate blockPointersPerInode 0))

-- |Increase the size of this inode, cannot decrease it!
inodeBumpSize :: Inode
              -> INLong -- ^size in bytes
              -> Inode
inodeBumpSize inode@(Inode md _) newSize =
    inode{metaData=md{num_bytes=max (num_bytes md) newSize}}

inodeAddLink :: Inode -> Inode
inodeAddLink i@Inode{metaData=md@InodeMetadata{hard_links=hl}}
    = i{metaData=md{hard_links=hl+1}}

-- |Get the block pointer from this inode array.
getPointerAt :: Inode -> BlockNumber -> INInt
getPointerAt inode blockNumber = 
    (blockPtrs inode) !
         (assert (blockNumber < intToINInt blockPointersPerInode
                     && blockNumber >= 0)
                 (inIntToInt blockNumber))

rootInodeDiskAddr :: INInt
rootInodeDiskAddr = 0

firstFreeInodeDiskAddr :: INInt
firstFreeInodeDiskAddr = rootDirInodeDiskAddr + 1

-- For internal use only; they may change after newfs.

blockMapInodeDiskAddr :: INInt
blockMapInodeDiskAddr = 2

inodeMapInodeDiskAddr :: INInt
inodeMapInodeDiskAddr = 3

rootDirInodeDiskAddr :: INInt
rootDirInodeDiskAddr = 4

-- ------------------------------------------------------------
-- * INodeMetaData
-- ------------------------------------------------------------

data InodeMetadata
    = InodeMetadata
      {
       magic1             :: INInt
      ,num_bytes          :: INLong
      ,uid                :: INInt
      ,gid                :: INInt
      ,mode               :: FileType  -- ^ file or dir
      ,inode_num          :: INInt
      ,flags              :: INInt
      ,hard_links         :: INInt  -- ^persistent references
      ,create_time        :: INLong
      ,last_modified_time :: INLong
      ,level              :: INInt  -- sum to here: 56 bytes
      } deriving Eq

instance Show InodeMetadata where
    show i
	= "\n-----\n"
	  ++ printField x "magic1" magic1
	  ++ printField s' "num_bytes" num_bytes
          ++ printField s "uid" uid
          ++ printField s "gid" gid
          ++ printField show "mode" mode
          ++ printField s "inode_num" inode_num
          ++ printField s "flags" flags
          ++ printField s "hard_links" hard_links
          ++ printField s' "create_time" create_time
          ++ printField s' "last_modified_time" last_modified_time
          ++ printField s "level" level
          ++ "-----\n"
	where
        x = myShowHex
        s = show
        s' = show
	printField :: (Show a) => (a -> String)
                   -> String -- ^label
		   -> (InodeMetadata -> a)
		   -> String
	printField shower lab f
	    = lab ++ ": " ++ (shower $ f i) ++ "\n"


-- ------------------------------------------------------------
-- * Binary representation of the Inodes
-- ------------------------------------------------------------

instance Binary Inode where
  put_ h inode = do
	     (BinPtr start) <- tellBin h
	     put_ h (metaData inode)
	     sequence_ [ put_ h ptr | ptr <- elems $ blockPtrs inode]
	     seekBin h (BinPtr (start + bytesPerInode))
	     return ()
  get h = do
	     (BinPtr start) <- tellBin h
	     meta <- get h
	     ptrs <- sequence [ get h | _ <- take 16 [1..blockPointersPerInode] ]
	     seekBin h (BinPtr (start + bytesPerInode))
	     return $ Inode { metaData = meta
			    , blockPtrs = listArray (0, blockPointersPerInode - 1) $ ptrs 
			    }

instance Binary InodeMetadata where
  put_ h a = do
	     put_ h (magic1        a)
	     put_ h (num_bytes     a)
	     put_ h (uid           a)
	     put_ h (gid           a)
	     put_ h (mode          a)
	     put_ h (inode_num     a)
	     put_ h (flags         a)
	     put_ h (hard_links    a)
	     put_ h (create_time   a)
	     put_ h (last_modified_time a)
	     put_ h (level         a)
	     -- add assert about size
	     return ()
	     
  get h = do magic1'        <- get h
	     num_bytes'     <- get h
	     uid'           <- get h
	     gid'           <- get h
	     mode'          <- get h
	     inode_num'     <- get h
	     flags'         <- get h
	     hard_links'    <- get h
	     create_time'   <- get h
	     last_modified' <- get h
	     level'         <- get h
	     -- add assert about size
	     return $ InodeMetadata magic1' num_bytes' uid'
	                            gid' mode' inode_num' flags'
	                            hard_links' create_time' last_modified' level'