module Main where import Data.DateTime (DateTime, getCurrentTime) import Data.Maybe import Data.IORef import qualified Data.Map as M import qualified Data.ByteString.Char8 as B import Foreign.C.Error import System.Posix.Types import System.Posix.Files import System.Posix.IO import System.Fuse hiding (RegularFile, Directory) import qualified System.Fuse as Fuse import System.CloudyFS.Expiring import System.CloudyFS.FileSystem import System.CloudyFS.Path import System.CloudyFS.Weather type FileType = Weather type HT = FileType type State = IORef (FileSystem FileType) mkFileSystem :: IO State mkFileSystem = newIORef emptyFS main :: IO () main = do fs <- mkFileSystem fuseMain (cloudyFSOps fs) defaultExceptionHandler cloudyFSOps :: State -> FuseOperations HT cloudyFSOps fs = defaultFuseOps { fuseGetFileStat = cloudyGetFileStat fs , fuseOpen = cloudyOpen fs , fuseRead = cloudyRead , fuseOpenDirectory = cloudyOpenDirectory fs , fuseReadDirectory = cloudyReadDirectory fs , fuseGetFileSystemStats = cloudyGetFileSystemStats } dirStat :: FuseContext -> FileStat dirStat ctx = FileStat { statEntryType = Fuse.Directory , statFileMode = foldr1 unionFileModes [ ownerReadMode , ownerExecuteMode , groupReadMode , groupExecuteMode , otherReadMode , otherExecuteMode ] , statLinkCount = 2 , statFileOwner = fuseCtxUserID ctx , statFileGroup = fuseCtxGroupID ctx , statSpecialDeviceID = 0 , statFileSize = 4096 , statBlocks = 1 , statAccessTime = 0 , statModificationTime = 0 , statStatusChangeTime = 0 } fileStat :: Weather -> FuseContext -> FileStat fileStat w ctx = FileStat { statEntryType = Fuse.RegularFile , statFileMode = foldr1 unionFileModes [ ownerReadMode , groupReadMode , otherReadMode ] , statLinkCount = 1 , statFileOwner = fuseCtxUserID ctx , statFileGroup = fuseCtxGroupID ctx , statSpecialDeviceID = 0 , statFileSize = fromIntegral $ B.length $ asByteString w , statBlocks = 1 , statAccessTime = 0 , statModificationTime = epochTime w , statStatusChangeTime = 0 } stat :: FuseContext -> FileSystem FileType -> FileStat stat c (SystemDirectory _) = dirStat c stat c (SystemFile w) = fileStat w c cloudyGetFileStat :: State -> FilePath -> IO (Either Errno FileStat) cloudyGetFileStat stateRef p = do t <- getCurrentTime ctx <- getFuseContext state <- readIORef stateRef case getFile t state path of Just fs -> return $ Right $ stat ctx fs Nothing -> case mapMaybe (\ x -> x p) fileSpecifications of (_, RegularFile action):[] -> do result <- action path case result of Nothing -> return err Just r -> case mkfile state path r of Just f -> do writeIORef stateRef f cloudyGetFileStat stateRef p Nothing -> return err (_, DirectoryFile):[] -> do case mkdir state path of Just f -> do writeIORef stateRef f cloudyGetFileStat stateRef p Nothing -> return err _ -> return err where path = normalisePath p err = Left eNFILE getDirContents :: DateTime -> FileSystem FileType -> [FilePart] -> FuseContext -> [(FilePath, FileStat)] getDirContents t fs path ctx = case lsdir fs path of Nothing -> [] Just m -> M.foldWithKey accumulator [] m where accumulator k f l = if isValid t f then (k, stat ctx f):l else l cloudyOpenDirectory :: State -> FilePath -> IO Errno cloudyOpenDirectory stateRef path = do case mapMaybe (\ x -> x path) fileSpecifications of (fp, DirectoryFile):[] -> do st <- readIORef stateRef case mkdir st fp of Just f -> do writeIORef stateRef f return $ eOK Nothing -> return $ eOK _ -> return $ eEXIST cloudyReadDirectory :: State -> FilePath -> IO (Either Errno [(FilePath, FileStat)]) cloudyReadDirectory stateRef path = do t <- getCurrentTime ctx <- getFuseContext case mapMaybe (\ x -> x path) fileSpecifications of (fp, DirectoryFile):_ -> do state <- readIORef stateRef return $ Right $ [(".", dirStat ctx) ,("..", dirStat ctx) ] ++ (getDirContents t state fp ctx) _ -> return $ Left eEXIST cloudyOpen :: State -> FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno HT) cloudyOpen stateRef path ReadOnly flags = do t <- getCurrentTime state <- readIORef stateRef case getFile t state (normalisePath path) of Nothing -> fetchAndPut state Just (SystemFile a) -> if isValid t a then return $ Right a else fetchAndPut state _ -> return $ Left eNFILE where fetchAndPut state = case mapMaybe (\ x -> x path) fileSpecifications of (fp, RegularFile act):[] -> do w <- act fp case w of Nothing -> return $ Left eNFILE Just r -> case mkfile state fp r of Nothing -> return $ Left eACCES Just f -> do writeIORef stateRef f cloudyOpen stateRef path ReadOnly flags _ -> return $ Left eNFILE cloudyOpen _ _ _ _ = return $ Left eACCES cloudyRead :: FilePath -> HT -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString) cloudyRead _ ht byteCount offset = return $ Right $ B.take (fromIntegral byteCount) $ B.drop (fromIntegral offset) $ asByteString ht cloudyGetFileSystemStats :: String -> IO (Either Errno FileSystemStats) cloudyGetFileSystemStats _ = return $ Right $ FileSystemStats { fsStatBlockSize = 512 , fsStatBlockCount = 1 , fsStatBlocksFree = 1 , fsStatBlocksAvailable = 1 , fsStatFileCount = 5 , fsStatFilesFree = 10 , fsStatMaxNameLength = 255 }