{-# LANGUAGE CPP #-}
{- arch-tag: HVFS Combinators
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}
{- |
   Module     : System.IO.HVFS.Combinators
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Support for combining different HVFS modules together

Copyright (c) 2004-2005 John Goerzen, jgoerzen\@complete.org

-}

module System.IO.HVFS.Combinators ( -- * Restrictions
                                    HVFSReadOnly(..),
                                    HVFSChroot, newHVFSChroot)
    where

import System.IO ( IOMode(ReadMode) )
import System.IO.Error
    ( doesNotExistErrorType, permissionErrorType )
import System.IO.HVFS
    ( HVFSOpenable(vOpen),
      HVFS(vRemoveFile, vCreateLink, vCreateSymbolicLink, vRenameFile,
           vRenameDirectory, vRemoveDirectory, vCreateDirectory,
           vGetCurrentDirectory, vGetDirectoryContents, vDoesFileExist,
           vGetFileStatus, vGetSymbolicLinkStatus, vGetModificationTime,
           vReadSymbolicLink, vRaiseError, vDoesDirectoryExist,
           vSetCurrentDirectory) )
import           System.IO.HVFS.InstanceHelpers (getFullPath)
import           System.FilePath                (isPathSeparator, pathSeparator,
                                                 (</>))
import           System.Path                    (secureAbsNormPath)
import           System.Path.NameManip          (normalise_path)

----------------------------------------------------------------------
-- Providing read-only access
----------------------------------------------------------------------
{- | Restrict access to the underlying filesystem to be strictly
read-only.  Any write-type operations will cause an error.

No constructor is required; just say @HVFSReadOnly fs@ to make a
new read-only wrapper around the 'HVFS' instance @fs@.
-}
data HVFS a => HVFSReadOnly a = HVFSReadOnly a
                              deriving (HVFSReadOnly a -> HVFSReadOnly a -> Bool
(HVFSReadOnly a -> HVFSReadOnly a -> Bool)
-> (HVFSReadOnly a -> HVFSReadOnly a -> Bool)
-> Eq (HVFSReadOnly a)
forall a.
(HVFS a, Eq a) =>
HVFSReadOnly a -> HVFSReadOnly a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HVFSReadOnly a -> HVFSReadOnly a -> Bool
$c/= :: forall a.
(HVFS a, Eq a) =>
HVFSReadOnly a -> HVFSReadOnly a -> Bool
== :: HVFSReadOnly a -> HVFSReadOnly a -> Bool
$c== :: forall a.
(HVFS a, Eq a) =>
HVFSReadOnly a -> HVFSReadOnly a -> Bool
Eq, Int -> HVFSReadOnly a -> ShowS
[HVFSReadOnly a] -> ShowS
HVFSReadOnly a -> String
(Int -> HVFSReadOnly a -> ShowS)
-> (HVFSReadOnly a -> String)
-> ([HVFSReadOnly a] -> ShowS)
-> Show (HVFSReadOnly a)
forall a. HVFS a => Int -> HVFSReadOnly a -> ShowS
forall a. HVFS a => [HVFSReadOnly a] -> ShowS
forall a. HVFS a => HVFSReadOnly a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HVFSReadOnly a] -> ShowS
$cshowList :: forall a. HVFS a => [HVFSReadOnly a] -> ShowS
show :: HVFSReadOnly a -> String
$cshow :: forall a. HVFS a => HVFSReadOnly a -> String
showsPrec :: Int -> HVFSReadOnly a -> ShowS
$cshowsPrec :: forall a. HVFS a => Int -> HVFSReadOnly a -> ShowS
Show)
withro :: HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro :: (a -> b) -> HVFSReadOnly a -> b
withro a -> b
f (HVFSReadOnly a
x) = a -> b
f a
x

roerror :: (HVFS a) => HVFSReadOnly a -> IO c
roerror :: HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
h =
    let err :: a -> IO c
err a
x = a -> IOErrorType -> String -> Maybe String -> IO c
forall a c.
HVFS a =>
a -> IOErrorType -> String -> Maybe String -> IO c
vRaiseError a
x IOErrorType
permissionErrorType String
"Read-only virtual filesystem"
                  Maybe String
forall a. Maybe a
Nothing
        in (a -> IO c) -> HVFSReadOnly a -> IO c
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> IO c
forall a c. HVFS a => a -> IO c
err HVFSReadOnly a
h

instance HVFS a => HVFS (HVFSReadOnly a) where
    vGetCurrentDirectory :: HVFSReadOnly a -> IO String
vGetCurrentDirectory = (a -> IO String) -> HVFSReadOnly a -> IO String
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> IO String
forall a. HVFS a => a -> IO String
vGetCurrentDirectory
    vSetCurrentDirectory :: HVFSReadOnly a -> String -> IO ()
vSetCurrentDirectory = (a -> String -> IO ()) -> HVFSReadOnly a -> String -> IO ()
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO ()
forall a. HVFS a => a -> String -> IO ()
vSetCurrentDirectory
    vGetDirectoryContents :: HVFSReadOnly a -> String -> IO [String]
vGetDirectoryContents = (a -> String -> IO [String])
-> HVFSReadOnly a -> String -> IO [String]
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO [String]
forall a. HVFS a => a -> String -> IO [String]
vGetDirectoryContents
    vDoesFileExist :: HVFSReadOnly a -> String -> IO Bool
vDoesFileExist = (a -> String -> IO Bool) -> HVFSReadOnly a -> String -> IO Bool
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesFileExist
    vDoesDirectoryExist :: HVFSReadOnly a -> String -> IO Bool
vDoesDirectoryExist = (a -> String -> IO Bool) -> HVFSReadOnly a -> String -> IO Bool
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesDirectoryExist
    vCreateDirectory :: HVFSReadOnly a -> String -> IO ()
vCreateDirectory HVFSReadOnly a
h String
_ = HVFSReadOnly a -> IO ()
forall a c. HVFS a => HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
h
    vRemoveDirectory :: HVFSReadOnly a -> String -> IO ()
vRemoveDirectory HVFSReadOnly a
h String
_ = HVFSReadOnly a -> IO ()
forall a c. HVFS a => HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
h
    vRenameDirectory :: HVFSReadOnly a -> String -> String -> IO ()
vRenameDirectory HVFSReadOnly a
h String
_ String
_ = HVFSReadOnly a -> IO ()
forall a c. HVFS a => HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
h
    vRenameFile :: HVFSReadOnly a -> String -> String -> IO ()
vRenameFile HVFSReadOnly a
h String
_ String
_ = HVFSReadOnly a -> IO ()
forall a c. HVFS a => HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
h
    vGetFileStatus :: HVFSReadOnly a -> String -> IO HVFSStatEncap
vGetFileStatus = (a -> String -> IO HVFSStatEncap)
-> HVFSReadOnly a -> String -> IO HVFSStatEncap
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO HVFSStatEncap
forall a. HVFS a => a -> String -> IO HVFSStatEncap
vGetFileStatus
    vGetSymbolicLinkStatus :: HVFSReadOnly a -> String -> IO HVFSStatEncap
vGetSymbolicLinkStatus = (a -> String -> IO HVFSStatEncap)
-> HVFSReadOnly a -> String -> IO HVFSStatEncap
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO HVFSStatEncap
forall a. HVFS a => a -> String -> IO HVFSStatEncap
vGetSymbolicLinkStatus
    vGetModificationTime :: HVFSReadOnly a -> String -> IO ClockTime
vGetModificationTime = (a -> String -> IO ClockTime)
-> HVFSReadOnly a -> String -> IO ClockTime
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO ClockTime
forall a. HVFS a => a -> String -> IO ClockTime
vGetModificationTime
    vRaiseError :: HVFSReadOnly a -> IOErrorType -> String -> Maybe String -> IO c
vRaiseError = (a -> IOErrorType -> String -> Maybe String -> IO c)
-> HVFSReadOnly a -> IOErrorType -> String -> Maybe String -> IO c
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> IOErrorType -> String -> Maybe String -> IO c
forall a c.
HVFS a =>
a -> IOErrorType -> String -> Maybe String -> IO c
vRaiseError
    vCreateSymbolicLink :: HVFSReadOnly a -> String -> String -> IO ()
vCreateSymbolicLink HVFSReadOnly a
h String
_ String
_ = HVFSReadOnly a -> IO ()
forall a c. HVFS a => HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
h
    vReadSymbolicLink :: HVFSReadOnly a -> String -> IO String
vReadSymbolicLink = (a -> String -> IO String) -> HVFSReadOnly a -> String -> IO String
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro a -> String -> IO String
forall a. HVFS a => a -> String -> IO String
vReadSymbolicLink
    vCreateLink :: HVFSReadOnly a -> String -> String -> IO ()
vCreateLink HVFSReadOnly a
h String
_ String
_ = HVFSReadOnly a -> IO ()
forall a c. HVFS a => HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
h

instance HVFSOpenable a => HVFSOpenable (HVFSReadOnly a) where
    vOpen :: HVFSReadOnly a -> String -> IOMode -> IO HVFSOpenEncap
vOpen HVFSReadOnly a
fh String
fp IOMode
mode =
        case IOMode
mode of IOMode
ReadMode -> (a -> IO HVFSOpenEncap) -> HVFSReadOnly a -> IO HVFSOpenEncap
forall a b. HVFS a => (a -> b) -> HVFSReadOnly a -> b
withro (\a
h -> a -> String -> IOMode -> IO HVFSOpenEncap
forall a.
HVFSOpenable a =>
a -> String -> IOMode -> IO HVFSOpenEncap
vOpen a
h String
fp IOMode
mode) HVFSReadOnly a
fh
                     IOMode
_        -> HVFSReadOnly a -> IO HVFSOpenEncap
forall a c. HVFS a => HVFSReadOnly a -> IO c
roerror HVFSReadOnly a
fh

----------------------------------------------------------------------
-- Restricting to a subdirectory
----------------------------------------------------------------------
{- | Access a subdirectory of a real filesystem as if it was the root
of that filesystem. -}
data HVFS a => HVFSChroot a = HVFSChroot String a
                            deriving (HVFSChroot a -> HVFSChroot a -> Bool
(HVFSChroot a -> HVFSChroot a -> Bool)
-> (HVFSChroot a -> HVFSChroot a -> Bool) -> Eq (HVFSChroot a)
forall a. (HVFS a, Eq a) => HVFSChroot a -> HVFSChroot a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HVFSChroot a -> HVFSChroot a -> Bool
$c/= :: forall a. (HVFS a, Eq a) => HVFSChroot a -> HVFSChroot a -> Bool
== :: HVFSChroot a -> HVFSChroot a -> Bool
$c== :: forall a. (HVFS a, Eq a) => HVFSChroot a -> HVFSChroot a -> Bool
Eq, Int -> HVFSChroot a -> ShowS
[HVFSChroot a] -> ShowS
HVFSChroot a -> String
(Int -> HVFSChroot a -> ShowS)
-> (HVFSChroot a -> String)
-> ([HVFSChroot a] -> ShowS)
-> Show (HVFSChroot a)
forall a. HVFS a => Int -> HVFSChroot a -> ShowS
forall a. HVFS a => [HVFSChroot a] -> ShowS
forall a. HVFS a => HVFSChroot a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HVFSChroot a] -> ShowS
$cshowList :: forall a. HVFS a => [HVFSChroot a] -> ShowS
show :: HVFSChroot a -> String
$cshow :: forall a. HVFS a => HVFSChroot a -> String
showsPrec :: Int -> HVFSChroot a -> ShowS
$cshowsPrec :: forall a. HVFS a => Int -> HVFSChroot a -> ShowS
Show)

{- | Create a new 'HVFSChroot' object. -}
newHVFSChroot :: HVFS a => a            -- ^ The object to pass requests on to
              -> FilePath               -- ^ The path of the directory to make root
              -> IO (HVFSChroot a)      -- ^ The resulting new object
newHVFSChroot :: a -> String -> IO (HVFSChroot a)
newHVFSChroot a
fh String
fp =
    do String
full <- a -> String -> IO String
forall a. HVFS a => a -> String -> IO String
getFullPath a
fh String
fp
       Bool
isdir <- a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesDirectoryExist a
fh String
full
       if Bool
isdir
          then do let newobj :: HVFSChroot a
newobj = (String -> a -> HVFSChroot a
forall a. String -> a -> HVFSChroot a
HVFSChroot String
full a
fh)
                  HVFSChroot a -> String -> IO ()
forall a. HVFS a => a -> String -> IO ()
vSetCurrentDirectory HVFSChroot a
newobj [Char
pathSeparator]
                  HVFSChroot a -> IO (HVFSChroot a)
forall (m :: * -> *) a. Monad m => a -> m a
return HVFSChroot a
newobj
          else a -> IOErrorType -> String -> Maybe String -> IO (HVFSChroot a)
forall a c.
HVFS a =>
a -> IOErrorType -> String -> Maybe String -> IO c
vRaiseError a
fh IOErrorType
doesNotExistErrorType
                 (String
"Attempt to instantiate HVFSChroot over non-directory " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
full)
                 (String -> Maybe String
forall a. a -> Maybe a
Just String
full)

{- | Get the embedded object -}
dch :: (HVFS t) => HVFSChroot t -> t
dch :: HVFSChroot t -> t
dch (HVFSChroot String
_ t
a) = t
a

{- | Convert a local (chroot) path to a full path. -}
dch2fp, fp2dch :: (HVFS t) => HVFSChroot t -> String -> IO String
dch2fp :: HVFSChroot t -> String -> IO String
dch2fp mainh :: HVFSChroot t
mainh@(HVFSChroot String
fp t
h) String
locfp =
    do String
full <- (String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` if Char -> Bool
isPathSeparator (String -> Char
forall a. [a] -> a
head String
locfp)
                                then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
locfp
                                else HVFSChroot t -> String -> IO String
forall a. HVFS a => a -> String -> IO String
getFullPath HVFSChroot t
mainh String
locfp
       case String -> String -> Maybe String
secureAbsNormPath String
fp String
full of
           Maybe String
Nothing -> t -> IOErrorType -> String -> Maybe String -> IO String
forall a c.
HVFS a =>
a -> IOErrorType -> String -> Maybe String -> IO c
vRaiseError t
h IOErrorType
doesNotExistErrorType
                        (String
"Trouble normalizing path in chroot")
                        (String -> Maybe String
forall a. a -> Maybe a
Just (String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
full))
           Just String
x -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

{- | Convert a full path to a local (chroot) path. -}
fp2dch :: HVFSChroot t -> String -> IO String
fp2dch (HVFSChroot String
fp t
h) String
locfp =
    do String
newpath <- case String -> String -> Maybe String
secureAbsNormPath String
fp String
locfp of
                     Maybe String
Nothing -> t -> IOErrorType -> String -> Maybe String -> IO String
forall a c.
HVFS a =>
a -> IOErrorType -> String -> Maybe String -> IO c
vRaiseError t
h IOErrorType
doesNotExistErrorType
                                  (String
"Unable to securely normalize path")
                                  (String -> Maybe String
forall a. a -> Maybe a
Just (String
fp String -> ShowS
</> String
locfp))
                     Just String
x -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
       if (Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fp) String
newpath String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
fp)
               then t -> IOErrorType -> String -> Maybe String -> IO String
forall a c.
HVFS a =>
a -> IOErrorType -> String -> Maybe String -> IO c
vRaiseError t
h IOErrorType
doesNotExistErrorType
                        (String
"Local path is not subdirectory of parent path")
                        (String -> Maybe String
forall a. a -> Maybe a
Just String
newpath)
               else let newpath2 :: String
newpath2 = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fp) String
newpath
                        in String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ShowS
normalise_path ([Char
pathSeparator] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newpath2)

dch2fph :: (HVFS t) => (t -> String -> IO t1) -> HVFSChroot t -> [Char] -> IO t1
dch2fph :: (t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph t -> String -> IO t1
func fh :: HVFSChroot t
fh@(HVFSChroot String
_ t
h) String
locfp =
    do String
newfp <- HVFSChroot t -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot t
fh String
locfp
       t -> String -> IO t1
func t
h String
newfp

instance HVFS a => HVFS (HVFSChroot a) where
    vGetCurrentDirectory :: HVFSChroot a -> IO String
vGetCurrentDirectory HVFSChroot a
x = do String
fp <- a -> IO String
forall a. HVFS a => a -> IO String
vGetCurrentDirectory (HVFSChroot a -> a
forall t. HVFS t => HVFSChroot t -> t
dch HVFSChroot a
x)
                                HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
fp2dch HVFSChroot a
x String
fp
    vSetCurrentDirectory :: HVFSChroot a -> String -> IO ()
vSetCurrentDirectory = (a -> String -> IO ()) -> HVFSChroot a -> String -> IO ()
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO ()
forall a. HVFS a => a -> String -> IO ()
vSetCurrentDirectory
    vGetDirectoryContents :: HVFSChroot a -> String -> IO [String]
vGetDirectoryContents = (a -> String -> IO [String])
-> HVFSChroot a -> String -> IO [String]
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO [String]
forall a. HVFS a => a -> String -> IO [String]
vGetDirectoryContents
    vDoesFileExist :: HVFSChroot a -> String -> IO Bool
vDoesFileExist = (a -> String -> IO Bool) -> HVFSChroot a -> String -> IO Bool
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesFileExist
    vDoesDirectoryExist :: HVFSChroot a -> String -> IO Bool
vDoesDirectoryExist = (a -> String -> IO Bool) -> HVFSChroot a -> String -> IO Bool
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesDirectoryExist
    vCreateDirectory :: HVFSChroot a -> String -> IO ()
vCreateDirectory = (a -> String -> IO ()) -> HVFSChroot a -> String -> IO ()
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO ()
forall a. HVFS a => a -> String -> IO ()
vCreateDirectory
    vRemoveDirectory :: HVFSChroot a -> String -> IO ()
vRemoveDirectory = (a -> String -> IO ()) -> HVFSChroot a -> String -> IO ()
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO ()
forall a. HVFS a => a -> String -> IO ()
vRemoveDirectory
    vRenameDirectory :: HVFSChroot a -> String -> String -> IO ()
vRenameDirectory HVFSChroot a
fh String
old String
new = do String
old' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
old
                                     String
new' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
new
                                     a -> String -> String -> IO ()
forall a. HVFS a => a -> String -> String -> IO ()
vRenameDirectory (HVFSChroot a -> a
forall t. HVFS t => HVFSChroot t -> t
dch HVFSChroot a
fh) String
old' String
new'
    vRemoveFile :: HVFSChroot a -> String -> IO ()
vRemoveFile = (a -> String -> IO ()) -> HVFSChroot a -> String -> IO ()
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO ()
forall a. HVFS a => a -> String -> IO ()
vRemoveFile
    vRenameFile :: HVFSChroot a -> String -> String -> IO ()
vRenameFile HVFSChroot a
fh String
old String
new = do String
old' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
old
                                String
new' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
new
                                a -> String -> String -> IO ()
forall a. HVFS a => a -> String -> String -> IO ()
vRenameFile (HVFSChroot a -> a
forall t. HVFS t => HVFSChroot t -> t
dch HVFSChroot a
fh) String
old' String
new'
    vGetFileStatus :: HVFSChroot a -> String -> IO HVFSStatEncap
vGetFileStatus = (a -> String -> IO HVFSStatEncap)
-> HVFSChroot a -> String -> IO HVFSStatEncap
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO HVFSStatEncap
forall a. HVFS a => a -> String -> IO HVFSStatEncap
vGetFileStatus
    vGetSymbolicLinkStatus :: HVFSChroot a -> String -> IO HVFSStatEncap
vGetSymbolicLinkStatus = (a -> String -> IO HVFSStatEncap)
-> HVFSChroot a -> String -> IO HVFSStatEncap
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO HVFSStatEncap
forall a. HVFS a => a -> String -> IO HVFSStatEncap
vGetSymbolicLinkStatus
    vGetModificationTime :: HVFSChroot a -> String -> IO ClockTime
vGetModificationTime = (a -> String -> IO ClockTime)
-> HVFSChroot a -> String -> IO ClockTime
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO ClockTime
forall a. HVFS a => a -> String -> IO ClockTime
vGetModificationTime
    -- vRaiseError
    vCreateSymbolicLink :: HVFSChroot a -> String -> String -> IO ()
vCreateSymbolicLink HVFSChroot a
fh String
old String
new = do String
old' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
old
                                        String
new' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
new
                                        a -> String -> String -> IO ()
forall a. HVFS a => a -> String -> String -> IO ()
vCreateSymbolicLink (HVFSChroot a -> a
forall t. HVFS t => HVFSChroot t -> t
dch HVFSChroot a
fh) String
old' String
new'
    vReadSymbolicLink :: HVFSChroot a -> String -> IO String
vReadSymbolicLink HVFSChroot a
fh String
fp = do String
result <- (a -> String -> IO String) -> HVFSChroot a -> String -> IO String
forall t t1.
HVFS t =>
(t -> String -> IO t1) -> HVFSChroot t -> String -> IO t1
dch2fph a -> String -> IO String
forall a. HVFS a => a -> String -> IO String
vReadSymbolicLink HVFSChroot a
fh String
fp
                                 HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
fp2dch HVFSChroot a
fh String
result
    vCreateLink :: HVFSChroot a -> String -> String -> IO ()
vCreateLink HVFSChroot a
fh String
old String
new = do String
old' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
old
                                String
new' <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
new
                                a -> String -> String -> IO ()
forall a. HVFS a => a -> String -> String -> IO ()
vCreateLink (HVFSChroot a -> a
forall t. HVFS t => HVFSChroot t -> t
dch HVFSChroot a
fh) String
old' String
new'

instance HVFSOpenable a => HVFSOpenable (HVFSChroot a) where
    vOpen :: HVFSChroot a -> String -> IOMode -> IO HVFSOpenEncap
vOpen HVFSChroot a
fh String
fp IOMode
mode = do String
newfile <- HVFSChroot a -> String -> IO String
forall t. HVFS t => HVFSChroot t -> String -> IO String
dch2fp HVFSChroot a
fh String
fp
                          a -> String -> IOMode -> IO HVFSOpenEncap
forall a.
HVFSOpenable a =>
a -> String -> IOMode -> IO HVFSOpenEncap
vOpen (HVFSChroot a -> a
forall t. HVFS t => HVFSChroot t -> t
dch HVFSChroot a
fh) String
newfile IOMode
mode