{-# LINE 1 "src/System/LibFuse3/Internal.hsc" #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | The core stuff
--
-- This is an internal module. It is exposed to allow fine-tuning and workarounds but its API is not stable.
module System.LibFuse3.Internal where

import Control.Applicative ((<|>))
import Control.Exception (Exception, SomeException, bracket_, catch, finally, fromException, handle)
import Control.Monad (unless, void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Data.Bits ((.&.), (.|.))
import Data.Foldable (traverse_)
import Data.Maybe (fromJust)
import Foreign
  ( FunPtr
  , Ptr
  , StablePtr
  , allocaBytes
  , castPtrToStablePtr
  , castStablePtrToPtr
  , copyArray
  , deRefStablePtr
  , free
  , freeHaskellFunPtr
  , freeStablePtr
  , maybeWith
  , newStablePtr
  , nullFunPtr
  , nullPtr
  , peek
  , peekArray
  , peekByteOff
  , poke
  , pokeByteOff
  , with
  )
import Foreign.C (CInt(CInt), CString, Errno, eFAULT, eINVAL, eIO, eNOSYS, eOK, getErrno, peekCString, resetErrno, throwErrno, withCStringLen)
import GHC.IO.Handle (hDuplicateTo)
import System.Clock (TimeSpec)
import System.Environment (getArgs, getProgName)
import System.Exit (ExitCode(ExitFailure, ExitSuccess), exitFailure, exitSuccess, exitWith)
import System.IO (IOMode(ReadMode, WriteMode), SeekMode(AbsoluteSeek, RelativeSeek, SeekFromEnd), hPutStrLn, stderr, stdin, stdout, withFile)
import System.LibFuse3.FileStat (FileStat)
import System.LibFuse3.FileSystemStats (FileSystemStats)
import System.LibFuse3.FuseConfig (FuseConfig, fromCFuseConfig, toCFuseConfig)
import System.LibFuse3.Internal.Resource (daemonizeResourceT, resMallocBytes, resNew, resNewArray, resNewCString, resNewFilePath)
import System.LibFuse3.Utils (pokeCStringLen0, testBitSet, unErrno)
import System.Posix.Directory (changeWorkingDirectory)
import System.Posix.Files (blockSpecialMode, characterSpecialMode, directoryMode, namedPipeMode, regularFileMode, socketMode, symbolicLinkMode)
import System.Posix.IO (OpenFileFlags, OpenMode(ReadOnly, ReadWrite, WriteOnly), defaultFileFlags)
import System.Posix.Internals (c_access, peekFilePath, withFilePath)
import System.Posix.Process (createSession)
import System.Posix.Types (ByteCount, COff(COff), CSsize, DeviceID, FileMode, FileOffset, GroupID, UserID)
import Text.Printf (hPrintf, printf)

import qualified Control.Monad.Trans.Resource as Res
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import qualified System.LibFuse3.Internal.C as C
import qualified System.Posix.IO
import qualified System.Posix.Signals as Signals





-- | The Unix type of a node in the filesystem.
data EntryType
  = Unknown            -- ^ Unknown entry type
  | NamedPipe
  | CharacterSpecial
  | Directory
  | BlockSpecial
  | RegularFile
  | SymbolicLink
  | Socket
  deriving (EntryType -> EntryType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntryType -> EntryType -> Bool
$c/= :: EntryType -> EntryType -> Bool
== :: EntryType -> EntryType -> Bool
$c== :: EntryType -> EntryType -> Bool
Eq, Int -> EntryType -> ShowS
[EntryType] -> ShowS
EntryType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryType] -> ShowS
$cshowList :: [EntryType] -> ShowS
show :: EntryType -> String
$cshow :: EntryType -> String
showsPrec :: Int -> EntryType -> ShowS
$cshowsPrec :: Int -> EntryType -> ShowS
Show)

-- | Converts an 'EntryType' into the corresponding POSIX 'FileMode'.
entryTypeToFileMode :: EntryType -> FileMode
entryTypeToFileMode :: EntryType -> FileMode
entryTypeToFileMode EntryType
Unknown          = FileMode
0
entryTypeToFileMode EntryType
NamedPipe        = FileMode
namedPipeMode
entryTypeToFileMode EntryType
CharacterSpecial = FileMode
characterSpecialMode
entryTypeToFileMode EntryType
Directory        = FileMode
directoryMode
entryTypeToFileMode EntryType
BlockSpecial     = FileMode
blockSpecialMode
entryTypeToFileMode EntryType
RegularFile      = FileMode
regularFileMode
entryTypeToFileMode EntryType
SymbolicLink     = FileMode
symbolicLinkMode
entryTypeToFileMode EntryType
Socket           = FileMode
socketMode

-- | Decodes `EntryType` from a `FileMode`.
fileModeToEntryType :: FileMode -> EntryType
fileModeToEntryType :: FileMode -> EntryType
fileModeToEntryType FileMode
mode
  | FileMode
fileType forall a. Eq a => a -> a -> Bool
== FileMode
namedPipeMode        = EntryType
NamedPipe
  | FileMode
fileType forall a. Eq a => a -> a -> Bool
== FileMode
characterSpecialMode = EntryType
CharacterSpecial
  | FileMode
fileType forall a. Eq a => a -> a -> Bool
== FileMode
directoryMode        = EntryType
Directory
  | FileMode
fileType forall a. Eq a => a -> a -> Bool
== FileMode
blockSpecialMode     = EntryType
BlockSpecial
  | FileMode
fileType forall a. Eq a => a -> a -> Bool
== FileMode
regularFileMode      = EntryType
RegularFile
  | FileMode
fileType forall a. Eq a => a -> a -> Bool
== FileMode
symbolicLinkMode     = EntryType
SymbolicLink
  | FileMode
fileType forall a. Eq a => a -> a -> Bool
== FileMode
socketMode           = EntryType
Socket
  | Bool
otherwise = EntryType
Unknown
  where
  fileType :: FileMode
fileType = FileMode
mode forall a. Bits a => a -> a -> a
.&. (FileMode
61440)
{-# LINE 106 "src/System/LibFuse3/Internal.hsc" #-}

-- | Passed to `fuseFsync` and `fuseFsyncdir`.
data SyncType
  -- | Synchronize both file content and metadata.
  = FullSync
  -- | Synchronize only the file content.
  | DataSync
  deriving (SyncType -> SyncType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SyncType -> SyncType -> Bool
$c/= :: SyncType -> SyncType -> Bool
== :: SyncType -> SyncType -> Bool
$c== :: SyncType -> SyncType -> Bool
Eq, Int -> SyncType -> ShowS
[SyncType] -> ShowS
SyncType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SyncType] -> ShowS
$cshowList :: [SyncType] -> ShowS
show :: SyncType -> String
$cshow :: SyncType -> String
showsPrec :: Int -> SyncType -> ShowS
$cshowsPrec :: Int -> SyncType -> ShowS
Show)

-- | The query type of @access@. Passed to `fuseAccess`.
data AccessMode
  -- | File existence (@F_OK@)
  = FileOK
  -- | Reading, writing and executing permissions (@R_OK@, @W_OK@ and @X_OK@, resp.)
  | PermOK Bool Bool Bool
  deriving (AccessMode -> AccessMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessMode -> AccessMode -> Bool
$c/= :: AccessMode -> AccessMode -> Bool
== :: AccessMode -> AccessMode -> Bool
$c== :: AccessMode -> AccessMode -> Bool
Eq, Int -> AccessMode -> ShowS
[AccessMode] -> ShowS
AccessMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessMode] -> ShowS
$cshowList :: [AccessMode] -> ShowS
show :: AccessMode -> String
$cshow :: AccessMode -> String
showsPrec :: Int -> AccessMode -> ShowS
$cshowsPrec :: Int -> AccessMode -> ShowS
Show)

-- | Passed to `fuseSetxattr`.
data SetxattrFlag
  -- | Create a new attribute if it does not exist, or replace the value if it already exists (@0@)
  = SetxattrDefault
  -- | Perform a pure create, which fails if the named attribute exists already (@XATTR_CREATE@)
  | SetxattrCreate
  -- | Perform a pure replace operation, which fails if the named attribute does not already exist (@XATTR_REPLACE@)
  | SetxattrReplace
  deriving (SetxattrFlag -> SetxattrFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetxattrFlag -> SetxattrFlag -> Bool
$c/= :: SetxattrFlag -> SetxattrFlag -> Bool
== :: SetxattrFlag -> SetxattrFlag -> Bool
$c== :: SetxattrFlag -> SetxattrFlag -> Bool
Eq, Int -> SetxattrFlag -> ShowS
[SetxattrFlag] -> ShowS
SetxattrFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetxattrFlag] -> ShowS
$cshowList :: [SetxattrFlag] -> ShowS
show :: SetxattrFlag -> String
$cshow :: SetxattrFlag -> String
showsPrec :: Int -> SetxattrFlag -> ShowS
$cshowsPrec :: Int -> SetxattrFlag -> ShowS
Show)

-- | Tests if access permissions to the file is granted or the file exists.
--
-- Calls @access@. Compared to `System.Posix.Files.fileAccess` and
-- `System.Posix.Files.fileExist`, this function doesn't translate the errno and just
-- returns @()@ to indicate success, or throws an error to indicate failure.
access :: FilePath -> AccessMode -> IO ()
access :: String -> AccessMode -> IO ()
access String
path AccessMode
mode = do
  Errno
e <- String -> AccessMode -> IO Errno
accessErrno String
path AccessMode
mode
  if Errno
e forall a. Eq a => a -> a -> Bool
== Errno
eOK
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else forall a. String -> IO a
throwErrno String
"access"

-- | Same as `access` but returns the `Errno` instead of throwing an exception.
--
-- Returns `eOK` on success.
accessErrno :: FilePath -> AccessMode -> IO Errno
accessErrno :: String -> AccessMode -> IO Errno
accessErrno String
path AccessMode
mode = forall a. String -> (CString -> IO a) -> IO a
withFilePath String
path forall a b. (a -> b) -> a -> b
$ \CString
cPath -> do
  let cMode :: CInt
cMode = case AccessMode
mode of
        AccessMode
FileOK -> CInt
0
{-# LINE 152 "src/System/LibFuse3/Internal.hsc" #-}
        PermOK Bool
r Bool
w Bool
x ->
          (if Bool
r then (CInt
4) else CInt
0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 154 "src/System/LibFuse3/Internal.hsc" #-}
          (if Bool
w then (CInt
2) else CInt
0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 155 "src/System/LibFuse3/Internal.hsc" #-}
          (if Bool
x then (CInt
1) else CInt
0)
{-# LINE 156 "src/System/LibFuse3/Internal.hsc" #-}
  resetErrno
  CInt
ret <- CString -> CInt -> IO CInt
c_access CString
cPath CInt
cMode
  if CInt
ret forall a. Eq a => a -> a -> Bool
== CInt
0
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK
    else IO Errno
getErrno

-- memo: when adding a new field, make sure to update resCFuseOperations
-- | The file system operations.
--
-- All operations are optional. Each field is named against @struct fuse_operations@ in
-- @fuse.h@.
--
-- @fh@ is the file handle type returned by `fuseOpen`, and subsequently passed to all
-- other file operations.
--
-- @dh@ is the directory handle type returned by `fuseOpendir`, and subsequently passed to
-- `fuseReaddir` and `fuseReleasedir`.
data FuseOperations fh dh = FuseOperations
  { -- | Implements 'System.Posix.Files.getSymbolicLinkStatus' operation (POSIX @lstat(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
fuseGetattr :: Maybe (FilePath -> Maybe fh -> IO (Either Errno FileStat))

  , -- | Implements 'System.Posix.Files.readSymbolicLink' operation (POSIX @readlink(2)@).
    --
    -- This function should not append a terminating NUL byte. The returned 'FilePath'
    -- might be truncated depending on caller buffer size.
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> IO (Either Errno String))
fuseReadlink :: Maybe (FilePath -> IO (Either Errno FilePath))

  , -- | Implements 'System.Posix.Files.createDevice' (POSIX @mknod(2)@).
    --
    -- This function will also be called for regular file creation if `fuseCreate` is not defined.
    --
    -- `fileModeToEntryType` is handy to pattern match on the request type of the node.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> FileMode -> DeviceID -> IO Errno)
fuseMknod :: Maybe (FilePath -> FileMode -> DeviceID -> IO Errno)

  , -- | Implements 'System.Posix.Directory.createDirectory' (POSIX @mkdir(2)@).
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> FileMode -> IO Errno)
fuseMkdir :: Maybe (FilePath -> FileMode -> IO Errno)

  , -- | Implements 'System.Posix.Files.removeLink' (POSIX @unlink(2)@).
    forall fh dh. FuseOperations fh dh -> Maybe (String -> IO Errno)
fuseUnlink :: Maybe (FilePath -> IO Errno)

  , -- | Implements 'Ststen.Posix.Directory.removeDirectory' (POSIX @rmdir(2)@).
    forall fh dh. FuseOperations fh dh -> Maybe (String -> IO Errno)
fuseRmdir :: Maybe (FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.createSymbolicLink' (POSIX @symlink(2)@).
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseSymlink :: Maybe (FilePath -> FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.rename' (POSIX @rename(2)@).
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseRename :: Maybe (FilePath -> FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.createLink' (POSIX @link(2)@).
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseLink :: Maybe (FilePath -> FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.setFileMode' (POSIX @chmod(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> FileMode -> IO Errno)
fuseChmod :: Maybe (FilePath -> Maybe fh -> FileMode -> IO Errno)

  , -- | Implements 'System.Posix.Files.setOwnerAndGroup' (POSIX @chown(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    --
    -- Unless @FUSE_CAP_HANDLE_KILLPRIV@ is disabled, this method is expected to reset the
    -- setuid and setgid bits.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
fuseChown :: Maybe (FilePath -> Maybe fh -> UserID -> GroupID -> IO Errno)

  , -- | Implements 'System.Posix.Files.setFileSize' (POSIX @truncate(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    --
    -- Unless @FUSE_CAP_HANDLE_KILLPRIV@ is disabled, this method is expected to reset the
    -- setuid and setgid bits.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
fuseTruncate :: Maybe (FilePath -> Maybe fh -> FileOffset -> IO Errno)

  , -- | Implements 'System.Posix.Files.openFd' (POSIX @open(2)@).  On success, returns
    -- 'Right' of a filehandle-like value that will be passed to future file operations; on
    -- failure, returns 'Left' of the appropriate 'Errno'.
    --
    --   * Creation flags will be filtered out / handled by the kernel.
    --   * Access modes should be used by this to check if the operation is permitted.
    --   * The filesystem is expected to properly handle the @O_APPEND@ flag and ensure that
    --     each write is appending to the end of the file.
    --   * If this method returns @Left `eNOSYS`@ and @FUSE_CAP_NO_OPEN_SUPPORT@ is set in
    --     @fuse_conn_info.capable@, this is treated as success and future calls to open
    --     will also succeed without being sent to the filesystem process.
    --
    -- TODO allow this method to set @fuse_file_info.direct_io@ and @fuse_file_info.keep_cache@
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
fuseOpen :: Maybe (FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))

  , -- | Implements Unix98 @pread(2)@.
    --
    -- It differs from 'System.Posix.Files.fdRead' by the explicit 'FileOffset' argument.
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
fuseRead :: Maybe (FilePath -> fh -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString))

  , -- | Implements Unix98 @pwrite(2)@.
    --
    -- It differs from 'System.Posix.Files.fdWrite' by the explicit 'FileOffset' argument.
    --
    -- Unless @FUSE_CAP_HANDLE_KILLPRIV@ is disabled, this method is expected to reset the
    -- setuid and setgid bits.
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
fuseWrite :: Maybe (FilePath -> fh -> B.ByteString -> FileOffset -> IO (Either Errno CInt))

  , -- | Implements @statfs(2)@.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> IO (Either Errno FileSystemStats))
fuseStatfs :: Maybe (String -> IO (Either Errno FileSystemStats))

  , -- | Called when @close(2)@ has been called on an open file.
    --
    -- Note: this does not mean that the file is released.  This function may be called more
    -- than once for each @open(2)@.  The return value is passed on to the @close(2)@ system
    -- call.
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> fh -> IO Errno)
fuseFlush :: Maybe (FilePath -> fh -> IO Errno)

  , -- | Called when an open file has all file descriptors closed and all memory mappings
    -- unmapped.
    --
    -- For every @open@ call there will be exactly one @release@ call with the same flags.
    -- It is possible to have a file opened more than once, in which case only the last
    -- release will mean that no more reads or writes will happen on the file.
    forall fh dh. FuseOperations fh dh -> Maybe (String -> fh -> IO ())
fuseRelease :: Maybe (FilePath -> fh -> IO ())

  , -- | Implements @fsync(2)@.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> fh -> SyncType -> IO Errno)
fuseFsync :: Maybe (FilePath -> fh -> SyncType -> IO Errno)

  , -- | Implements @setxattr(2)@.
    --
    -- The parameters are: path, name, value and flags.
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
fuseSetxattr :: Maybe (FilePath -> String -> B.ByteString -> SetxattrFlag -> IO Errno)

  , -- | Implements @getxattr(2)@.
    --
    -- The parameters are path and name.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> String -> IO (Either Errno ByteString))
fuseGetxattr :: Maybe (FilePath -> String -> IO (Either Errno B.ByteString))

  , -- | Implements @listxattr(2)@.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> IO (Either Errno [String]))
fuseListxattr :: Maybe (FilePath -> IO (Either Errno [String]))

  , -- | Implements @removexattr(2)@.
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseRemovexattr :: Maybe (FilePath -> String -> IO Errno)

  , -- | Implements @opendir(3)@.
    --
    -- This method should check if the open operation is permitted for this directory.
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> IO (Either Errno dh))
fuseOpendir :: Maybe (FilePath -> IO (Either Errno dh))

  , -- | Implements @readdir(3)@.
    --
    -- The entire contents of the directory should be returned as a list of tuples
    -- (corresponding to the first mode of operation documented in @fuse.h@).
    --
    -- The returned list should contain entries of \".\" and \"..\".
    --
    -- Each element of the list is a pair of the name and the stat. The name should not
    -- include the path to it. The implementation may return @Nothing@ as the stat; in this
    -- case `fuseGetattr` is called instead.
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
fuseReaddir :: Maybe (FilePath -> dh -> IO (Either Errno [(String, Maybe FileStat)]))

  , -- | Implements @closedir(3)@.
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> dh -> IO Errno)
fuseReleasedir :: Maybe (FilePath -> dh -> IO Errno)

  , -- | Synchronize the directory's contents; analogous to `fuseFsync`.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> dh -> SyncType -> IO Errno)
fuseFsyncdir :: Maybe (FilePath -> dh -> SyncType -> IO Errno)

  , -- | Initializes the filesystem.  This is called before all other operations.
    --
    -- The filesystem may modify `FuseConfig` to configure the API.
    forall fh dh.
FuseOperations fh dh -> Maybe (FuseConfig -> IO FuseConfig)
fuseInit :: Maybe (FuseConfig -> IO FuseConfig)

  , -- | Called on filesystem exit to allow cleanup.
    forall fh dh. FuseOperations fh dh -> Maybe (IO ())
fuseDestroy :: Maybe (IO ())

  , -- | Implements 'System.Posix.Files.fileAccess' and 'System.Posix.Files.fileExist
    -- (POSIX @access(2)@).
    --
    -- Checks file access permissions as requested by an `AccessMode`.
    --
    -- If the @default_permissions@ mount option is given, this method is not called. This
    -- method is also not called under Linux kernel versions 2.4.x
    --
    -- TODO add notes about @default_permissions@ to other relevant handlers
    forall fh dh.
FuseOperations fh dh -> Maybe (String -> AccessMode -> IO Errno)
fuseAccess :: Maybe (FilePath -> AccessMode -> IO Errno)

  , -- | Implements 'System.Posix.Files.openFd' (POSIX @open(2)@). Creates and opens a regular
    -- file.
    --
    -- If this is not implemented, `fuseMknod` and `fuseOpen` methods will be called instead.
    --
    -- See `fuseOpen` for notes on the flags.
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
fuseCreate :: Maybe (FilePath -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))

    -- TODO , fuseLock :: _

  , -- | Implements @utimensat(2)@.
    --
    -- Changes the access and modification times of a file with nanosecond resolution.
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
fuseUtimens :: Maybe (FilePath -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)

    -- TODO , fuseBmap :: _
    -- TODO , fuseIoctl :: _
    -- TODO , fusePoll :: _
    -- TODO , fuseWriteBuf :: _
    -- TODO , fuseReadBuf :: _
    -- TODO , fuseFlock :: _

  , -- | Implements 'System.Posix.Fcntl.fileAllocate' (@posix_fallocate(3)@). Allocates
    -- space for an open file.
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
fuseFallocate :: Maybe (FilePath -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)

  , -- | Implements @copy_file_range(2)@.
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh
      -> FileOffset
      -> String
      -> fh
      -> FileOffset
      -> ByteCount
      -> CInt
      -> IO (Either Errno CSsize))
fuseCopyFileRange :: Maybe (FilePath -> fh -> FileOffset -> FilePath -> fh -> FileOffset -> ByteCount -> CInt -> IO (Either Errno CSsize))

  , -- | Implements 'System.Posix.IO.fdSeek' @lseek(3)@.
    --
    -- /Note:/ This is silently ignored if libfuse doesn't support @lseek@ operation (requires libfuse-3.8.0).
    forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
fuseLseek :: Maybe (FilePath -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
  }

-- | An empty set of operations whose fields are @Nothing@.
defaultFuseOperations :: FuseOperations fh dh
defaultFuseOperations :: forall fh dh. FuseOperations fh dh
defaultFuseOperations = forall fh dh.
Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
-> Maybe (String -> IO (Either Errno String))
-> Maybe (String -> FileMode -> DeviceID -> IO Errno)
-> Maybe (String -> FileMode -> IO Errno)
-> Maybe (String -> IO Errno)
-> Maybe (String -> IO Errno)
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> Maybe fh -> FileMode -> IO Errno)
-> Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
-> Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
-> Maybe
     (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
-> Maybe
     (String
      -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
-> Maybe
     (String
      -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
-> Maybe (String -> IO (Either Errno FileSystemStats))
-> Maybe (String -> fh -> IO Errno)
-> Maybe (String -> fh -> IO ())
-> Maybe (String -> fh -> SyncType -> IO Errno)
-> Maybe
     (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
-> Maybe (String -> String -> IO (Either Errno ByteString))
-> Maybe (String -> IO (Either Errno [String]))
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> IO (Either Errno dh))
-> Maybe
     (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
-> Maybe (String -> dh -> IO Errno)
-> Maybe (String -> dh -> SyncType -> IO Errno)
-> Maybe (FuseConfig -> IO FuseConfig)
-> Maybe (IO ())
-> Maybe (String -> AccessMode -> IO Errno)
-> Maybe
     (String
      -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
-> Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
-> Maybe
     (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
-> Maybe
     (String
      -> fh
      -> FileOffset
      -> String
      -> fh
      -> FileOffset
      -> ByteCount
      -> CInt
      -> IO (Either Errno CSsize))
-> Maybe
     (String
      -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
-> FuseOperations fh dh
FuseOperations forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Merges two `FuseOperations` in a left-biased manner.
mergeLFuseOperations :: FuseOperations fh dh -> FuseOperations fh dh -> FuseOperations fh dh
mergeLFuseOperations :: forall fh dh.
FuseOperations fh dh
-> FuseOperations fh dh -> FuseOperations fh dh
mergeLFuseOperations
  (FuseOperations Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
a1 Maybe (String -> IO (Either Errno String))
a2 Maybe (String -> FileMode -> DeviceID -> IO Errno)
a3 Maybe (String -> FileMode -> IO Errno)
a4 Maybe (String -> IO Errno)
a5 Maybe (String -> IO Errno)
a6 Maybe (String -> String -> IO Errno)
a7 Maybe (String -> String -> IO Errno)
a8 Maybe (String -> String -> IO Errno)
a9 Maybe (String -> Maybe fh -> FileMode -> IO Errno)
a10 Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
a11 Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
a12 Maybe (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
a13 Maybe
  (String
   -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
a14 Maybe
  (String
   -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
a15 Maybe (String -> IO (Either Errno FileSystemStats))
a16 Maybe (String -> fh -> IO Errno)
a17 Maybe (String -> fh -> IO ())
a18 Maybe (String -> fh -> SyncType -> IO Errno)
a19 Maybe (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
a20 Maybe (String -> String -> IO (Either Errno ByteString))
a21 Maybe (String -> IO (Either Errno [String]))
a22 Maybe (String -> String -> IO Errno)
a23 Maybe (String -> IO (Either Errno dh))
a24 Maybe
  (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
a25 Maybe (String -> dh -> IO Errno)
a26 Maybe (String -> dh -> SyncType -> IO Errno)
a27 Maybe (FuseConfig -> IO FuseConfig)
a28 Maybe (IO ())
a29 Maybe (String -> AccessMode -> IO Errno)
a30 Maybe
  (String
   -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
a31 Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
a32 Maybe
  (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
a33 Maybe
  (String
   -> fh
   -> FileOffset
   -> String
   -> fh
   -> FileOffset
   -> ByteCount
   -> CInt
   -> IO (Either Errno CSsize))
a34 Maybe
  (String
   -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
a35)
  (FuseOperations Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
b1 Maybe (String -> IO (Either Errno String))
b2 Maybe (String -> FileMode -> DeviceID -> IO Errno)
b3 Maybe (String -> FileMode -> IO Errno)
b4 Maybe (String -> IO Errno)
b5 Maybe (String -> IO Errno)
b6 Maybe (String -> String -> IO Errno)
b7 Maybe (String -> String -> IO Errno)
b8 Maybe (String -> String -> IO Errno)
b9 Maybe (String -> Maybe fh -> FileMode -> IO Errno)
b10 Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
b11 Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
b12 Maybe (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
b13 Maybe
  (String
   -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
b14 Maybe
  (String
   -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
b15 Maybe (String -> IO (Either Errno FileSystemStats))
b16 Maybe (String -> fh -> IO Errno)
b17 Maybe (String -> fh -> IO ())
b18 Maybe (String -> fh -> SyncType -> IO Errno)
b19 Maybe (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
b20 Maybe (String -> String -> IO (Either Errno ByteString))
b21 Maybe (String -> IO (Either Errno [String]))
b22 Maybe (String -> String -> IO Errno)
b23 Maybe (String -> IO (Either Errno dh))
b24 Maybe
  (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
b25 Maybe (String -> dh -> IO Errno)
b26 Maybe (String -> dh -> SyncType -> IO Errno)
b27 Maybe (FuseConfig -> IO FuseConfig)
b28 Maybe (IO ())
b29 Maybe (String -> AccessMode -> IO Errno)
b30 Maybe
  (String
   -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
b31 Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
b32 Maybe
  (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
b33 Maybe
  (String
   -> fh
   -> FileOffset
   -> String
   -> fh
   -> FileOffset
   -> ByteCount
   -> CInt
   -> IO (Either Errno CSsize))
b34 Maybe
  (String
   -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
b35)
  = forall fh dh.
Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
-> Maybe (String -> IO (Either Errno String))
-> Maybe (String -> FileMode -> DeviceID -> IO Errno)
-> Maybe (String -> FileMode -> IO Errno)
-> Maybe (String -> IO Errno)
-> Maybe (String -> IO Errno)
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> Maybe fh -> FileMode -> IO Errno)
-> Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
-> Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
-> Maybe
     (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
-> Maybe
     (String
      -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
-> Maybe
     (String
      -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
-> Maybe (String -> IO (Either Errno FileSystemStats))
-> Maybe (String -> fh -> IO Errno)
-> Maybe (String -> fh -> IO ())
-> Maybe (String -> fh -> SyncType -> IO Errno)
-> Maybe
     (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
-> Maybe (String -> String -> IO (Either Errno ByteString))
-> Maybe (String -> IO (Either Errno [String]))
-> Maybe (String -> String -> IO Errno)
-> Maybe (String -> IO (Either Errno dh))
-> Maybe
     (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
-> Maybe (String -> dh -> IO Errno)
-> Maybe (String -> dh -> SyncType -> IO Errno)
-> Maybe (FuseConfig -> IO FuseConfig)
-> Maybe (IO ())
-> Maybe (String -> AccessMode -> IO Errno)
-> Maybe
     (String
      -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
-> Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
-> Maybe
     (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
-> Maybe
     (String
      -> fh
      -> FileOffset
      -> String
      -> fh
      -> FileOffset
      -> ByteCount
      -> CInt
      -> IO (Either Errno CSsize))
-> Maybe
     (String
      -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
-> FuseOperations fh dh
FuseOperations (Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
a1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
b1) (Maybe (String -> IO (Either Errno String))
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> IO (Either Errno String))
b2) (Maybe (String -> FileMode -> DeviceID -> IO Errno)
a3 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> FileMode -> DeviceID -> IO Errno)
b3) (Maybe (String -> FileMode -> IO Errno)
a4 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> FileMode -> IO Errno)
b4) (Maybe (String -> IO Errno)
a5 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> IO Errno)
b5) (Maybe (String -> IO Errno)
a6 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> IO Errno)
b6) (Maybe (String -> String -> IO Errno)
a7 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> String -> IO Errno)
b7) (Maybe (String -> String -> IO Errno)
a8 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> String -> IO Errno)
b8) (Maybe (String -> String -> IO Errno)
a9 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> String -> IO Errno)
b9) (Maybe (String -> Maybe fh -> FileMode -> IO Errno)
a10 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> Maybe fh -> FileMode -> IO Errno)
b10) (Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
a11 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
b11) (Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
a12 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
b12) (Maybe (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
a13 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
b13) (Maybe
  (String
   -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
a14 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe
  (String
   -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
b14) (Maybe
  (String
   -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
a15 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe
  (String
   -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
b15) (Maybe (String -> IO (Either Errno FileSystemStats))
a16 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> IO (Either Errno FileSystemStats))
b16) (Maybe (String -> fh -> IO Errno)
a17 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> fh -> IO Errno)
b17) (Maybe (String -> fh -> IO ())
a18 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> fh -> IO ())
b18) (Maybe (String -> fh -> SyncType -> IO Errno)
a19 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> fh -> SyncType -> IO Errno)
b19) (Maybe (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
a20 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
b20) (Maybe (String -> String -> IO (Either Errno ByteString))
a21 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> String -> IO (Either Errno ByteString))
b21) (Maybe (String -> IO (Either Errno [String]))
a22 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> IO (Either Errno [String]))
b22) (Maybe (String -> String -> IO Errno)
a23 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> String -> IO Errno)
b23) (Maybe (String -> IO (Either Errno dh))
a24 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> IO (Either Errno dh))
b24) (Maybe
  (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
a25 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe
  (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
b25) (Maybe (String -> dh -> IO Errno)
a26 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> dh -> IO Errno)
b26) (Maybe (String -> dh -> SyncType -> IO Errno)
a27 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> dh -> SyncType -> IO Errno)
b27) (Maybe (FuseConfig -> IO FuseConfig)
a28 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (FuseConfig -> IO FuseConfig)
b28) (Maybe (IO ())
a29 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (IO ())
b29) (Maybe (String -> AccessMode -> IO Errno)
a30 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> AccessMode -> IO Errno)
b30) (Maybe
  (String
   -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
a31 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe
  (String
   -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
b31) (Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
a32 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
b32) (Maybe
  (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
a33 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe
  (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
b33) (Maybe
  (String
   -> fh
   -> FileOffset
   -> String
   -> fh
   -> FileOffset
   -> ByteCount
   -> CInt
   -> IO (Either Errno CSsize))
a34 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe
  (String
   -> fh
   -> FileOffset
   -> String
   -> fh
   -> FileOffset
   -> ByteCount
   -> CInt
   -> IO (Either Errno CSsize))
b34) (Maybe
  (String
   -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
a35 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe
  (String
   -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
b35)

-- | Allocates a @fuse_operations@ struct and pokes `FuseOperations` into it.
--
-- Each field of `FuseOperations` is converted into a C function pointer and is assigned
-- to a corresponding field of @struct fuse_operations@.
--
-- The created `C.FuseOperations` has the following invariants:
--
--   - The content of @fuse_file_info.fh@ is a Haskell value of type @StablePtr fh@ or
--     @StablePtr dh@, depending on operations. It is created with `newFH`, accessed with
--     `getFH` and released with `delFH`.
--
--   - Every methods handle Haskell exception with the supplied error handler. Any exceptions
--     not catched by it are catched, logged and returns `eIO`. This means that `exitSuccess`
--     /does not work/ inside `FuseOperations`.
--
--   - NULL filepaths (passed from libfuse if `FuseConfig.nullpathOk` is set) are
--     translated to empty strings.
resCFuseOperations
  :: forall fh dh e
   . Exception e
  => FuseOperations fh dh
  -> ExceptionHandler e
  -> ResourceT IO (Ptr C.FuseOperations)
resCFuseOperations :: forall fh dh e.
Exception e =>
FuseOperations fh dh
-> ExceptionHandler e -> ResourceT IO (Ptr FuseOperations)
resCFuseOperations FuseOperations fh dh
ops ExceptionHandler e
handlerRaw = do
  FunPtr CGetattr
fuseGetattr       <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CGetattr -> IO (FunPtr CGetattr)
C.mkGetattr       (String -> Maybe fh -> IO (Either Errno FileStat)) -> CGetattr
wrapGetattr       (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> IO (Either Errno FileStat))
fuseGetattr FuseOperations fh dh
ops)
  FunPtr CReadlink
fuseReadlink      <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CReadlink -> IO (FunPtr CReadlink)
C.mkReadlink      (String -> IO (Either Errno String)) -> CReadlink
wrapReadlink      (forall fh dh.
FuseOperations fh dh -> Maybe (String -> IO (Either Errno String))
fuseReadlink FuseOperations fh dh
ops)
  FunPtr CMknod
fuseMknod         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CMknod -> IO (FunPtr CMknod)
C.mkMknod         (String -> FileMode -> DeviceID -> IO Errno) -> CMknod
wrapMknod         (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> FileMode -> DeviceID -> IO Errno)
fuseMknod FuseOperations fh dh
ops)
  FunPtr CMkdir
fuseMkdir         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CMkdir -> IO (FunPtr CMkdir)
C.mkMkdir         (String -> FileMode -> IO Errno) -> CMkdir
wrapMkdir         (forall fh dh.
FuseOperations fh dh -> Maybe (String -> FileMode -> IO Errno)
fuseMkdir FuseOperations fh dh
ops)
  FunPtr CUnlink
fuseUnlink        <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CUnlink -> IO (FunPtr CUnlink)
C.mkUnlink        (String -> IO Errno) -> CUnlink
wrapUnlink        (forall fh dh. FuseOperations fh dh -> Maybe (String -> IO Errno)
fuseUnlink FuseOperations fh dh
ops)
  FunPtr CUnlink
fuseRmdir         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CUnlink -> IO (FunPtr CUnlink)
C.mkRmdir         (String -> IO Errno) -> CUnlink
wrapRmdir         (forall fh dh. FuseOperations fh dh -> Maybe (String -> IO Errno)
fuseRmdir FuseOperations fh dh
ops)
  FunPtr CSymlink
fuseSymlink       <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CSymlink -> IO (FunPtr CSymlink)
C.mkSymlink       (String -> String -> IO Errno) -> CSymlink
wrapSymlink       (forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseSymlink FuseOperations fh dh
ops)
  FunPtr CRename
fuseRename        <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CRename -> IO (FunPtr CRename)
C.mkRename        (String -> String -> IO Errno) -> CRename
wrapRename        (forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseRename FuseOperations fh dh
ops)
  FunPtr CSymlink
fuseLink          <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CSymlink -> IO (FunPtr CSymlink)
C.mkLink          (String -> String -> IO Errno) -> CSymlink
wrapLink          (forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseLink FuseOperations fh dh
ops)
  FunPtr CChmod
fuseChmod         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CChmod -> IO (FunPtr CChmod)
C.mkChmod         (String -> Maybe fh -> FileMode -> IO Errno) -> CChmod
wrapChmod         (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> FileMode -> IO Errno)
fuseChmod FuseOperations fh dh
ops)
  FunPtr CChown
fuseChown         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CChown -> IO (FunPtr CChown)
C.mkChown         (String -> Maybe fh -> UserID -> GroupID -> IO Errno) -> CChown
wrapChown         (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> UserID -> GroupID -> IO Errno)
fuseChown FuseOperations fh dh
ops)
  FunPtr CTruncate
fuseTruncate      <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CTruncate -> IO (FunPtr CTruncate)
C.mkTruncate      (String -> Maybe fh -> FileOffset -> IO Errno) -> CTruncate
wrapTruncate      (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> FileOffset -> IO Errno)
fuseTruncate FuseOperations fh dh
ops)
  FunPtr COpen
fuseOpen          <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC COpen -> IO (FunPtr COpen)
C.mkOpen          (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
-> COpen
wrapOpen          (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
fuseOpen FuseOperations fh dh
ops)
  FunPtr CRead
fuseRead          <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CRead -> IO (FunPtr CRead)
C.mkRead          (String
 -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
-> CRead
wrapRead          (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
fuseRead FuseOperations fh dh
ops)
  FunPtr CRead
fuseWrite         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CRead -> IO (FunPtr CRead)
C.mkWrite         (String
 -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
-> CRead
wrapWrite         (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
fuseWrite FuseOperations fh dh
ops)
  FunPtr CStatfs
fuseStatfs        <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CStatfs -> IO (FunPtr CStatfs)
C.mkStatfs        (String -> IO (Either Errno FileSystemStats)) -> CStatfs
wrapStatfs        (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> IO (Either Errno FileSystemStats))
fuseStatfs FuseOperations fh dh
ops)
  FunPtr COpen
fuseFlush         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC COpen -> IO (FunPtr COpen)
C.mkFlush         (String -> fh -> IO Errno) -> COpen
wrapFlush         (forall fh dh.
FuseOperations fh dh -> Maybe (String -> fh -> IO Errno)
fuseFlush FuseOperations fh dh
ops)
  FunPtr COpen
fuseRelease       <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC COpen -> IO (FunPtr COpen)
C.mkRelease       (String -> fh -> IO ()) -> COpen
wrapRelease       (forall fh dh. FuseOperations fh dh -> Maybe (String -> fh -> IO ())
fuseRelease FuseOperations fh dh
ops)
  FunPtr CFsync
fuseFsync         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CFsync -> IO (FunPtr CFsync)
C.mkFsync         (String -> fh -> SyncType -> IO Errno) -> CFsync
wrapFsync         (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> fh -> SyncType -> IO Errno)
fuseFsync FuseOperations fh dh
ops)
  FunPtr CSetxattr
fuseSetxattr      <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CSetxattr -> IO (FunPtr CSetxattr)
C.mkSetxattr      (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
-> CSetxattr
wrapSetxattr      (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
fuseSetxattr FuseOperations fh dh
ops)
  FunPtr CGetxattr
fuseGetxattr      <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CGetxattr -> IO (FunPtr CGetxattr)
C.mkGetxattr      (String -> String -> IO (Either Errno ByteString)) -> CGetxattr
wrapGetxattr      (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> String -> IO (Either Errno ByteString))
fuseGetxattr FuseOperations fh dh
ops)
  FunPtr CReadlink
fuseListxattr     <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CReadlink -> IO (FunPtr CReadlink)
C.mkListxattr     (String -> IO (Either Errno [String])) -> CReadlink
wrapListxattr     (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> IO (Either Errno [String]))
fuseListxattr FuseOperations fh dh
ops)
  FunPtr CSymlink
fuseRemovexattr   <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CSymlink -> IO (FunPtr CSymlink)
C.mkRemovexattr   (String -> String -> IO Errno) -> CSymlink
wrapRemovexattr   (forall fh dh.
FuseOperations fh dh -> Maybe (String -> String -> IO Errno)
fuseRemovexattr FuseOperations fh dh
ops)
  FunPtr COpen
fuseOpendir       <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC COpen -> IO (FunPtr COpen)
C.mkOpendir       (String -> IO (Either Errno dh)) -> COpen
wrapOpendir       (forall fh dh.
FuseOperations fh dh -> Maybe (String -> IO (Either Errno dh))
fuseOpendir FuseOperations fh dh
ops)
  FunPtr CReaddir
fuseReaddir       <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CReaddir -> IO (FunPtr CReaddir)
C.mkReaddir       (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
-> CReaddir
wrapReaddir       (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
fuseReaddir FuseOperations fh dh
ops)
  FunPtr COpen
fuseReleasedir    <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC COpen -> IO (FunPtr COpen)
C.mkReleasedir    (String -> dh -> IO Errno) -> COpen
wrapReleasedir    (forall fh dh.
FuseOperations fh dh -> Maybe (String -> dh -> IO Errno)
fuseReleasedir FuseOperations fh dh
ops)
  FunPtr CFsync
fuseFsyncdir      <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CFsync -> IO (FunPtr CFsync)
C.mkFsyncdir      (String -> dh -> SyncType -> IO Errno) -> CFsync
wrapFsyncdir      (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> dh -> SyncType -> IO Errno)
fuseFsyncdir FuseOperations fh dh
ops)
  FunPtr CInit
fuseInit          <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CInit -> IO (FunPtr CInit)
C.mkInit          (FuseConfig -> IO FuseConfig) -> CInit
wrapInit          (forall fh dh.
FuseOperations fh dh -> Maybe (FuseConfig -> IO FuseConfig)
fuseInit FuseOperations fh dh
ops)
  FunPtr CDestroy
fuseDestroy       <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CDestroy -> IO (FunPtr CDestroy)
C.mkDestroy       IO () -> CDestroy
wrapDestroy       (forall fh dh. FuseOperations fh dh -> Maybe (IO ())
fuseDestroy FuseOperations fh dh
ops)
  FunPtr (CString -> CInt -> IO CInt)
fuseAccess        <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC (CString -> CInt -> IO CInt)
-> IO (FunPtr (CString -> CInt -> IO CInt))
C.mkAccess        (String -> AccessMode -> IO Errno) -> CString -> CInt -> IO CInt
wrapAccess        (forall fh dh.
FuseOperations fh dh -> Maybe (String -> AccessMode -> IO Errno)
fuseAccess FuseOperations fh dh
ops)
  FunPtr CChmod
fuseCreate        <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CChmod -> IO (FunPtr CChmod)
C.mkCreate        (String
 -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
-> CChmod
wrapCreate        (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
fuseCreate FuseOperations fh dh
ops)
  FunPtr CUtimens
fuseUtimens       <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CUtimens -> IO (FunPtr CUtimens)
C.mkUtimens       (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
-> CUtimens
wrapUtimens       (forall fh dh.
FuseOperations fh dh
-> Maybe (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
fuseUtimens FuseOperations fh dh
ops)
  FunPtr CFallocate
fuseFallocate     <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CFallocate -> IO (FunPtr CFallocate)
C.mkFallocate     (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
-> CFallocate
wrapFallocate     (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
fuseFallocate FuseOperations fh dh
ops)
  FunPtr CCopyFileRange
fuseCopyFileRange <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CCopyFileRange -> IO (FunPtr CCopyFileRange)
C.mkCopyFileRange (String
 -> fh
 -> FileOffset
 -> String
 -> fh
 -> FileOffset
 -> ByteCount
 -> CInt
 -> IO (Either Errno CSsize))
-> CCopyFileRange
wrapCopyFileRange (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh
      -> FileOffset
      -> String
      -> fh
      -> FileOffset
      -> ByteCount
      -> CInt
      -> IO (Either Errno CSsize))
fuseCopyFileRange FuseOperations fh dh
ops)
  FunPtr CLseek
fuseLseek         <- forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC CLseek -> IO (FunPtr CLseek)
C.mkLseek         (String
 -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
-> CLseek
wrapLseek         (forall fh dh.
FuseOperations fh dh
-> Maybe
     (String
      -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
fuseLseek FuseOperations fh dh
ops)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> ResourceT IO (ReleaseKey, Ptr a)
resNew C.FuseOperations
    -- not (yet) implemented methods
    { fuseLock :: FunPtr CLock
fuseLock = forall a. FunPtr a
nullFunPtr
    , fuseBmap :: FunPtr CBmap
fuseBmap = forall a. FunPtr a
nullFunPtr
    , fuseIoctl :: FunPtr CIoctl
fuseIoctl = forall a. FunPtr a
nullFunPtr
    , fusePoll :: FunPtr CPoll
fusePoll = forall a. FunPtr a
nullFunPtr
    , fuseWriteBuf :: FunPtr CWriteBuf
fuseWriteBuf = forall a. FunPtr a
nullFunPtr
    , fuseReadBuf :: FunPtr CReadBuf
fuseReadBuf = forall a. FunPtr a
nullFunPtr
    , fuseFlock :: FunPtr CFlock
fuseFlock = forall a. FunPtr a
nullFunPtr
    , FunPtr CDestroy
FunPtr CUnlink
FunPtr CSymlink
FunPtr CGetxattr
FunPtr CSetxattr
FunPtr CRename
FunPtr CReadlink
FunPtr CRead
FunPtr CUtimens
FunPtr CGetattr
FunPtr CStatfs
FunPtr CReaddir
FunPtr COpen
FunPtr CCopyFileRange
FunPtr CChown
FunPtr CTruncate
FunPtr CLseek
FunPtr CMkdir
FunPtr CChmod
FunPtr CMknod
FunPtr (CString -> CInt -> IO CInt)
FunPtr CFsync
FunPtr CFallocate
FunPtr CInit
fuseLseek :: FunPtr CLseek
fuseCopyFileRange :: FunPtr CCopyFileRange
fuseFallocate :: FunPtr CFallocate
fuseUtimens :: FunPtr CUtimens
fuseCreate :: FunPtr CChmod
fuseAccess :: FunPtr (CString -> CInt -> IO CInt)
fuseDestroy :: FunPtr CDestroy
fuseInit :: FunPtr CInit
fuseFsyncdir :: FunPtr CFsync
fuseReleasedir :: FunPtr COpen
fuseReaddir :: FunPtr CReaddir
fuseOpendir :: FunPtr COpen
fuseRemovexattr :: FunPtr CSymlink
fuseListxattr :: FunPtr CReadlink
fuseGetxattr :: FunPtr CGetxattr
fuseSetxattr :: FunPtr CSetxattr
fuseFsync :: FunPtr CFsync
fuseRelease :: FunPtr COpen
fuseFlush :: FunPtr COpen
fuseStatfs :: FunPtr CStatfs
fuseWrite :: FunPtr CRead
fuseRead :: FunPtr CRead
fuseOpen :: FunPtr COpen
fuseTruncate :: FunPtr CTruncate
fuseChown :: FunPtr CChown
fuseChmod :: FunPtr CChmod
fuseLink :: FunPtr CSymlink
fuseRename :: FunPtr CRename
fuseSymlink :: FunPtr CSymlink
fuseRmdir :: FunPtr CUnlink
fuseUnlink :: FunPtr CUnlink
fuseMkdir :: FunPtr CMkdir
fuseMknod :: FunPtr CMknod
fuseReadlink :: FunPtr CReadlink
fuseGetattr :: FunPtr CGetattr
fuseLseek :: FunPtr CLseek
fuseCopyFileRange :: FunPtr CCopyFileRange
fuseFallocate :: FunPtr CFallocate
fuseUtimens :: FunPtr CUtimens
fuseCreate :: FunPtr CChmod
fuseAccess :: FunPtr (CString -> CInt -> IO CInt)
fuseDestroy :: FunPtr CDestroy
fuseInit :: FunPtr CInit
fuseFsyncdir :: FunPtr CFsync
fuseReleasedir :: FunPtr COpen
fuseReaddir :: FunPtr CReaddir
fuseOpendir :: FunPtr COpen
fuseRemovexattr :: FunPtr CSymlink
fuseListxattr :: FunPtr CReadlink
fuseGetxattr :: FunPtr CGetxattr
fuseSetxattr :: FunPtr CSetxattr
fuseFsync :: FunPtr CFsync
fuseRelease :: FunPtr COpen
fuseFlush :: FunPtr COpen
fuseStatfs :: FunPtr CStatfs
fuseWrite :: FunPtr CRead
fuseRead :: FunPtr CRead
fuseOpen :: FunPtr COpen
fuseTruncate :: FunPtr CTruncate
fuseChown :: FunPtr CChown
fuseChmod :: FunPtr CChmod
fuseLink :: FunPtr CSymlink
fuseRename :: FunPtr CRename
fuseSymlink :: FunPtr CSymlink
fuseRmdir :: FunPtr CUnlink
fuseUnlink :: FunPtr CUnlink
fuseMkdir :: FunPtr CMkdir
fuseMknod :: FunPtr CMknod
fuseReadlink :: FunPtr CReadlink
fuseGetattr :: FunPtr CGetattr
..
    }
  where
  -- wraps the supplied handler to make sure no Haskell exceptions are propagated to the C land
  handler :: ExceptionHandler SomeException
  handler :: ExceptionHandler SomeException
handler SomeException
se = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
    Maybe e
Nothing -> ExceptionHandler SomeException
defaultExceptionHandler SomeException
se
    Just e
e -> ExceptionHandler e
handlerRaw e
e forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` ExceptionHandler SomeException
defaultExceptionHandler

  -- convert a Haskell function to C one with @wrapMeth@, get its @FunPtr@, and associate it with freeHaskellFunPtr
  resC :: (cfunc -> IO (FunPtr cfunc)) -> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
  resC :: forall cfunc hsfunc.
(cfunc -> IO (FunPtr cfunc))
-> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
resC cfunc -> IO (FunPtr cfunc)
_ hsfunc -> cfunc
_ Maybe hsfunc
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FunPtr a
nullFunPtr
  resC cfunc -> IO (FunPtr cfunc)
mkMeth hsfunc -> cfunc
wrapMeth (Just hsfunc
hsfunc) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Res.allocate (cfunc -> IO (FunPtr cfunc)
mkMeth forall a b. (a -> b) -> a -> b
$ hsfunc -> cfunc
wrapMeth hsfunc
hsfunc) forall a. FunPtr a -> IO ()
freeHaskellFunPtr

  -- return negated errno as specified by fuse.h. also handle any Haskell exceptions
  handleAsFuseError :: IO Errno -> IO CInt
  handleAsFuseError :: IO Errno -> IO CInt
handleAsFuseError = IO (Either Errno CInt) -> IO CInt
handleAsFuseErrorResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left -- assumes eOK == 0

  -- return a (successful) result as positive int and a negated errno as negative int
  handleAsFuseErrorResult :: IO (Either Errno CInt) -> IO CInt
  handleAsFuseErrorResult :: IO (Either Errno CInt) -> IO CInt
handleAsFuseErrorResult = forall a. Integral a => IO (Either Errno a) -> IO a
handleAsFuseErrorIntegral

  handleAsFuseErrorCSsize :: IO (Either Errno CSsize) -> IO CSsize
  handleAsFuseErrorCSsize :: IO (Either Errno CSsize) -> IO CSsize
handleAsFuseErrorCSsize = forall a. Integral a => IO (Either Errno a) -> IO a
handleAsFuseErrorIntegral

  handleAsFuseErrorCOff :: IO (Either Errno COff) -> IO COff
  handleAsFuseErrorCOff :: IO (Either Errno FileOffset) -> IO FileOffset
handleAsFuseErrorCOff = forall a. Integral a => IO (Either Errno a) -> IO a
handleAsFuseErrorIntegral

  handleAsFuseErrorIntegral :: Integral a => IO (Either Errno a) -> IO a
  handleAsFuseErrorIntegral :: forall a. Integral a => IO (Either Errno a) -> IO a
handleAsFuseErrorIntegral = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errno -> CInt
unErrno) forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionHandler SomeException
handler)

  peekFilePathOrEmpty :: CString -> IO FilePath
  peekFilePathOrEmpty :: CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    | CString
pFilePath forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
    | Bool
otherwise            = CString -> IO String
peekFilePath CString
pFilePath

  peekOpenFileFlagsAndMode :: Ptr C.FuseFileInfo -> IO (OpenFileFlags, OpenMode)
  peekOpenFileFlagsAndMode :: Ptr FuseFileInfo -> IO (OpenFileFlags, OpenMode)
peekOpenFileFlagsAndMode Ptr FuseFileInfo
pFuseFileInfo = do
    (CInt
flags :: CInt) <- ((\Ptr FuseFileInfo
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FuseFileInfo
hsc_ptr Int
0)) Ptr FuseFileInfo
pFuseFileInfo
{-# LINE 498 "src/System/LibFuse3/Internal.hsc" #-}
    let openFileFlags = defaultFileFlags
          { System.Posix.IO.append   = testBitSet flags (1024)
{-# LINE 500 "src/System/LibFuse3/Internal.hsc" #-}
          , System.Posix.IO.nonBlock = testBitSet flags (2048)
{-# LINE 501 "src/System/LibFuse3/Internal.hsc" #-}
          , System.Posix.IO.trunc    = testBitSet flags (512)
{-# LINE 502 "src/System/LibFuse3/Internal.hsc" #-}
          }
        openMode
          | testBitSet flags (2)   = ReadWrite
{-# LINE 505 "src/System/LibFuse3/Internal.hsc" #-}
          | testBitSet flags (1) = WriteOnly
{-# LINE 506 "src/System/LibFuse3/Internal.hsc" #-}
          | otherwise = ReadOnly -- O_RDONLY
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenFileFlags
openFileFlags, OpenMode
openMode)

  wrapGetattr :: (FilePath -> Maybe fh -> IO (Either Errno FileStat)) -> C.CGetattr
  wrapGetattr :: (String -> Maybe fh -> IO (Either Errno FileStat)) -> CGetattr
wrapGetattr String -> Maybe fh -> IO (Either Errno FileStat)
go CString
pFilePath Ptr FileStat
pStat Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    Maybe fh
mfh <- forall fh. Ptr FuseFileInfo -> IO (Maybe fh)
getFH Ptr FuseFileInfo
pFuseFileInfo
    String -> Maybe fh -> IO (Either Errno FileStat)
go String
filePath Maybe fh
mfh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
errno
      Right FileStat
stat -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr FileStat
pStat FileStat
stat
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapReadlink :: (FilePath -> IO (Either Errno FilePath)) -> C.CReadlink
  wrapReadlink :: (String -> IO (Either Errno String)) -> CReadlink
wrapReadlink String -> IO (Either Errno String)
go CString
pFilePath CString
pBuf ByteCount
bufSize = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> IO (Either Errno String)
go String
filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
errno
      Right String
target -> do
        -- This will truncate target if it's longer than the buffer can hold,
        -- as specified by fuse.h
        CStringLen -> String -> IO ()
pokeCStringLen0 (CString
pBuf, (forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bufSize)) String
target
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapMknod :: (FilePath -> FileMode -> DeviceID -> IO Errno) -> C.CMknod
  wrapMknod :: (String -> FileMode -> DeviceID -> IO Errno) -> CMknod
wrapMknod String -> FileMode -> DeviceID -> IO Errno
go CString
pFilePath FileMode
mode DeviceID
dev = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> FileMode -> DeviceID -> IO Errno
go String
filePath FileMode
mode DeviceID
dev

  wrapMkdir :: (FilePath -> FileMode -> IO Errno) -> C.CMkdir
  wrapMkdir :: (String -> FileMode -> IO Errno) -> CMkdir
wrapMkdir String -> FileMode -> IO Errno
go CString
pFilePath FileMode
mode = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> FileMode -> IO Errno
go String
filePath FileMode
mode

  wrapUnlink :: (FilePath -> IO Errno) -> C.CUnlink
  wrapUnlink :: (String -> IO Errno) -> CUnlink
wrapUnlink String -> IO Errno
go CString
pFilePath = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> IO Errno
go String
filePath

  wrapRmdir :: (FilePath -> IO Errno) -> C.CRmdir
  wrapRmdir :: (String -> IO Errno) -> CUnlink
wrapRmdir String -> IO Errno
go CString
pFilePath = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> IO Errno
go String
filePath

  wrapSymlink :: (FilePath -> FilePath -> IO Errno) -> C.CSymlink
  wrapSymlink :: (String -> String -> IO Errno) -> CSymlink
wrapSymlink String -> String -> IO Errno
go CString
pSource CString
pDestination = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
source <- CString -> IO String
peekFilePath CString
pSource
    String
destination <- CString -> IO String
peekFilePath CString
pDestination
    String -> String -> IO Errno
go String
source String
destination

  wrapRename :: (FilePath -> FilePath -> IO Errno) -> C.CRename
  wrapRename :: (String -> String -> IO Errno) -> CRename
wrapRename String -> String -> IO Errno
go CString
pOld CString
pNew CUInt
_flags = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    -- we ignore the rename flags because #define _GNU_SOURCE is needed to use the constants
    -- TODO return EINVAL if flags are specified?
    String
old <- CString -> IO String
peekFilePath CString
pOld
    String
new <- CString -> IO String
peekFilePath CString
pNew
    String -> String -> IO Errno
go String
old String
new

  wrapLink :: (FilePath -> FilePath -> IO Errno) -> C.CLink
  wrapLink :: (String -> String -> IO Errno) -> CSymlink
wrapLink String -> String -> IO Errno
go CString
pSource CString
pDestination = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
source <- CString -> IO String
peekFilePath CString
pSource
    String
destination <- CString -> IO String
peekFilePath CString
pDestination
    String -> String -> IO Errno
go String
source String
destination

  wrapChmod :: (FilePath -> Maybe fh -> FileMode -> IO Errno) -> C.CChmod
  wrapChmod :: (String -> Maybe fh -> FileMode -> IO Errno) -> CChmod
wrapChmod String -> Maybe fh -> FileMode -> IO Errno
go CString
pFilePath FileMode
mode Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    Maybe fh
mfh <- forall fh. Ptr FuseFileInfo -> IO (Maybe fh)
getFH Ptr FuseFileInfo
pFuseFileInfo
    String -> Maybe fh -> FileMode -> IO Errno
go String
filePath Maybe fh
mfh FileMode
mode

  wrapChown :: (FilePath -> Maybe fh -> UserID -> GroupID -> IO Errno) -> C.CChown
  wrapChown :: (String -> Maybe fh -> UserID -> GroupID -> IO Errno) -> CChown
wrapChown String -> Maybe fh -> UserID -> GroupID -> IO Errno
go CString
pFilePath UserID
uid GroupID
gid Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    Maybe fh
mfh <- forall fh. Ptr FuseFileInfo -> IO (Maybe fh)
getFH Ptr FuseFileInfo
pFuseFileInfo
    String -> Maybe fh -> UserID -> GroupID -> IO Errno
go String
filePath Maybe fh
mfh UserID
uid GroupID
gid

  wrapTruncate :: (FilePath -> Maybe fh -> FileOffset -> IO Errno) -> C.CTruncate
  wrapTruncate :: (String -> Maybe fh -> FileOffset -> IO Errno) -> CTruncate
wrapTruncate String -> Maybe fh -> FileOffset -> IO Errno
go CString
pFilePath FileOffset
off Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    Maybe fh
mfh <- forall fh. Ptr FuseFileInfo -> IO (Maybe fh)
getFH Ptr FuseFileInfo
pFuseFileInfo
    String -> Maybe fh -> FileOffset -> IO Errno
go String
filePath Maybe fh
mfh FileOffset
off

  wrapOpen :: (FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno fh)) -> C.COpen
  wrapOpen :: (String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))
-> COpen
wrapOpen String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh)
go CString
pFilePath Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    (OpenFileFlags
openFileFlags, OpenMode
openMode) <- Ptr FuseFileInfo -> IO (OpenFileFlags, OpenMode)
peekOpenFileFlagsAndMode Ptr FuseFileInfo
pFuseFileInfo
    String -> OpenMode -> OpenFileFlags -> IO (Either Errno fh)
go String
filePath OpenMode
openMode OpenFileFlags
openFileFlags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
errno
      Right fh
fh -> do
        forall fh. Ptr FuseFileInfo -> fh -> IO ()
newFH Ptr FuseFileInfo
pFuseFileInfo fh
fh
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapRead :: (FilePath -> fh -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString)) -> C.CRead
  wrapRead :: (String
 -> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString))
-> CRead
wrapRead String
-> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString)
go CString
pFilePath CString
pBuf ByteCount
bufSize FileOffset
off Ptr FuseFileInfo
pFuseFileInfo = IO (Either Errno CInt) -> IO CInt
handleAsFuseErrorResult forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    fh
fh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    String
-> fh -> ByteCount -> FileOffset -> IO (Either Errno ByteString)
go String
filePath fh
fh ByteCount
bufSize FileOffset
off forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Errno
errno
      Right ByteString
bytes -> forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bytes forall a b. (a -> b) -> a -> b
$ \(CString
pBytes, Int
bytesLen) -> do
        let len :: Int
len = Int
bytesLen forall a. Ord a => a -> a -> a
`min` forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bufSize
        forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray CString
pBuf CString
pBytes Int
len
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len

  wrapWrite :: (FilePath -> fh -> B.ByteString -> FileOffset -> IO (Either Errno CInt)) -> C.CWrite
  wrapWrite :: (String
 -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt))
-> CRead
wrapWrite String -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt)
go CString
pFilePath CString
pBuf ByteCount
bufSize FileOffset
off Ptr FuseFileInfo
pFuseFileInfo = IO (Either Errno CInt) -> IO CInt
handleAsFuseErrorResult forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    fh
fh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    ByteString
buf <- CStringLen -> IO ByteString
BU.unsafePackCStringLen (CString
pBuf, forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bufSize)
    String -> fh -> ByteString -> FileOffset -> IO (Either Errno CInt)
go String
filePath fh
fh ByteString
buf FileOffset
off

  wrapStatfs :: (String -> IO (Either Errno FileSystemStats)) -> C.CStatfs
  wrapStatfs :: (String -> IO (Either Errno FileSystemStats)) -> CStatfs
wrapStatfs String -> IO (Either Errno FileSystemStats)
go CString
pStr Ptr FileSystemStats
pStatVFS = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
str <- CString -> IO String
peekFilePath CString
pStr
    String -> IO (Either Errno FileSystemStats)
go String
str forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
errno
      Right FileSystemStats
statvfs -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr FileSystemStats
pStatVFS FileSystemStats
statvfs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapFlush :: (FilePath -> fh -> IO Errno) -> C.CFlush
  wrapFlush :: (String -> fh -> IO Errno) -> COpen
wrapFlush String -> fh -> IO Errno
go CString
pFilePath Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    fh
fh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    String -> fh -> IO Errno
go String
filePath fh
fh

  wrapRelease :: (FilePath -> fh -> IO ()) -> C.CRelease
  wrapRelease :: (String -> fh -> IO ()) -> COpen
wrapRelease String -> fh -> IO ()
go CString
pFilePath Ptr FuseFileInfo
pFuseFileInfo = IO CInt
go' forall a b. IO a -> IO b -> IO a
`finally` Ptr FuseFileInfo -> IO ()
delFH Ptr FuseFileInfo
pFuseFileInfo
    where
    go' :: IO CInt
go' = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
      String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
      fh
fh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
      String -> fh -> IO ()
go String
filePath fh
fh
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapFsync :: (FilePath -> fh -> SyncType -> IO Errno) -> C.CFsync
  wrapFsync :: (String -> fh -> SyncType -> IO Errno) -> CFsync
wrapFsync String -> fh -> SyncType -> IO Errno
go CString
pFilePath CInt
isDataSync Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    fh
fh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    String -> fh -> SyncType -> IO Errno
go String
filePath fh
fh (if CInt
isDataSync forall a. Eq a => a -> a -> Bool
/= CInt
0 then SyncType
DataSync else SyncType
FullSync)

  wrapSetxattr :: (FilePath -> String -> B.ByteString -> SetxattrFlag -> IO Errno) -> C.CSetxattr
  wrapSetxattr :: (String -> String -> ByteString -> SetxattrFlag -> IO Errno)
-> CSetxattr
wrapSetxattr String -> String -> ByteString -> SetxattrFlag -> IO Errno
go CString
pFilePath CString
pName CString
pValue ByteCount
valueSize CInt
cFlags = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String
name <- CString -> IO String
peekCString CString
pName
    ByteString
value <- CStringLen -> IO ByteString
BU.unsafePackCStringLen (CString
pValue, forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
valueSize)
    let eflag :: Either Errno SetxattrFlag
eflag = case CInt
cFlags of
          CInt
0 -> forall a b. b -> Either a b
Right SetxattrFlag
SetxattrDefault
          (CInt
1) -> forall a b. b -> Either a b
Right SetxattrFlag
SetxattrCreate
{-# LINE 654 "src/System/LibFuse3/Internal.hsc" #-}
          (CInt
2) -> forall a b. b -> Either a b
Right SetxattrFlag
SetxattrReplace
{-# LINE 655 "src/System/LibFuse3/Internal.hsc" #-}
          CInt
_ -> forall a b. a -> Either a b
Left Errno
eINVAL
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> String -> ByteString -> SetxattrFlag -> IO Errno
go String
filePath String
name ByteString
value) Either Errno SetxattrFlag
eflag

  wrapGetxattr :: (FilePath -> String -> IO (Either Errno B.ByteString)) -> C.CGetxattr
  wrapGetxattr :: (String -> String -> IO (Either Errno ByteString)) -> CGetxattr
wrapGetxattr String -> String -> IO (Either Errno ByteString)
go CString
pFilePath CString
pName CString
pValueBuf ByteCount
bufSize = IO (Either Errno CInt) -> IO CInt
handleAsFuseErrorResult forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String
name <- CString -> IO String
peekCString CString
pName
    String -> String -> IO (Either Errno ByteString)
go String
filePath String
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Errno
errno
      Right ByteString
bytes
        | ByteCount
bufSize forall a. Eq a => a -> a -> Bool
== ByteCount
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bytes
        | Bool
otherwise -> forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bytes forall a b. (a -> b) -> a -> b
$ \(CString
pBytes, Int
bytesLen) -> do
            let len :: Int
len = Int
bytesLen forall a. Ord a => a -> a -> a
`min` forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bufSize
            forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray CString
pValueBuf CString
pBytes Int
len
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len

  wrapListxattr :: (FilePath -> IO (Either Errno [String])) -> C.CListxattr
  wrapListxattr :: (String -> IO (Either Errno [String])) -> CReadlink
wrapListxattr String -> IO (Either Errno [String])
go CString
pFilePath CString
pBuf ByteCount
bufSize = IO (Either Errno CInt) -> IO CInt
handleAsFuseErrorResult forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> IO (Either Errno [String])
go String
filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Errno
errno
      Right [String]
names -> forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Semigroup a => a -> a -> a
<> String
"\0") [String]
names) forall a b. (a -> b) -> a -> b
$ \(CString
pNames, Int
namesLen) ->
        if ByteCount
bufSize forall a. Eq a => a -> a -> Bool
== ByteCount
0
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
namesLen
          else do
            let len :: Int
len = Int
namesLen forall a. Ord a => a -> a -> a
`min` forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bufSize
            forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray CString
pBuf CString
pNames Int
len
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len

  wrapRemovexattr :: (FilePath -> String -> IO Errno) -> C.CRemovexattr
  wrapRemovexattr :: (String -> String -> IO Errno) -> CSymlink
wrapRemovexattr String -> String -> IO Errno
go CString
pFilePath CString
pName = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String
name <- CString -> IO String
peekCString CString
pName
    String -> String -> IO Errno
go String
filePath String
name

  wrapOpendir :: (FilePath -> IO (Either Errno dh)) -> C.COpendir
  wrapOpendir :: (String -> IO (Either Errno dh)) -> COpen
wrapOpendir String -> IO (Either Errno dh)
go CString
pFilePath Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> IO (Either Errno dh)
go String
filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
errno
      Right dh
dh -> do
        forall fh. Ptr FuseFileInfo -> fh -> IO ()
newFH Ptr FuseFileInfo
pFuseFileInfo dh
dh
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapReaddir :: (FilePath -> dh -> IO (Either Errno [(String, Maybe FileStat)])) -> C.CReaddir
  wrapReaddir :: (String -> dh -> IO (Either Errno [(String, Maybe FileStat)]))
-> CReaddir
wrapReaddir String -> dh -> IO (Either Errno [(String, Maybe FileStat)])
go CString
pFilePath Ptr FuseFillDirBuf
pBuf FunPtr FuseFillDir
pFillDir FileOffset
_off Ptr FuseFileInfo
pFuseFileInfo FuseFillDirFlags
_readdirFlags = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    dh
dh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    let fillDir :: FuseFillDir
fillDir = FunPtr FuseFillDir -> FuseFillDir
peekFuseFillDir FunPtr FuseFillDir
pFillDir
        fillEntry :: (FilePath, Maybe FileStat) -> IO ()
        fillEntry :: (String, Maybe FileStat) -> IO ()
fillEntry (String
fileName, Maybe FileStat
fileStat) =
          forall a. String -> (CString -> IO a) -> IO a
withFilePath String
fileName forall a b. (a -> b) -> a -> b
$ \CString
pFileName ->
          forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe FileStat
fileStat forall a b. (a -> b) -> a -> b
$ \Ptr FileStat
pFileStat -> do
            CInt
_ <- FuseFillDir
fillDir Ptr FuseFillDirBuf
pBuf CString
pFileName Ptr FileStat
pFileStat FileOffset
0 FuseFillDirFlags
0
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    String -> dh -> IO (Either Errno [(String, Maybe FileStat)])
go String
filePath dh
dh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
errno
      Right [(String, Maybe FileStat)]
entries -> do
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String, Maybe FileStat) -> IO ()
fillEntry [(String, Maybe FileStat)]
entries
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapReleasedir :: (FilePath -> dh -> IO Errno) -> C.CReleasedir
  wrapReleasedir :: (String -> dh -> IO Errno) -> COpen
wrapReleasedir String -> dh -> IO Errno
go CString
pFilePath Ptr FuseFileInfo
pFuseFileInfo = IO CInt
go' forall a b. IO a -> IO b -> IO a
`finally` Ptr FuseFileInfo -> IO ()
delFH Ptr FuseFileInfo
pFuseFileInfo
    where
    go' :: IO CInt
go' = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
      String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
      dh
dh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
      String -> dh -> IO Errno
go String
filePath dh
dh

  wrapFsyncdir :: (FilePath -> dh -> SyncType -> IO Errno) -> C.CFsyncdir
  wrapFsyncdir :: (String -> dh -> SyncType -> IO Errno) -> CFsync
wrapFsyncdir String -> dh -> SyncType -> IO Errno
go CString
pFilePath CInt
isDataSync Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    dh
dh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    String -> dh -> SyncType -> IO Errno
go String
filePath dh
dh (if CInt
isDataSync forall a. Eq a => a -> a -> Bool
/= CInt
0 then SyncType
DataSync else SyncType
FullSync)

  wrapInit :: (FuseConfig -> IO FuseConfig) -> C.CInit
  -- TODO implement read/write of fuseConnInfo; watch out for read-only fields
  wrapInit :: (FuseConfig -> IO FuseConfig) -> CInit
wrapInit FuseConfig -> IO FuseConfig
go Ptr FuseConnInfo
_fuseConnInfo Ptr FuseConfig
pFuseConfig = do
    ()
_ <- forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionHandler SomeException
handler) forall a b. (a -> b) -> a -> b
$ do
      -- @pFuseConfig@ is filled beforehand by fuse_opt_parse in libfuse so we pass it
      -- as-is to the callback as the default value.
      FuseConfig
fuseConfigOld <- FuseConfig -> FuseConfig
fromCFuseConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr FuseConfig
pFuseConfig
      FuseConfig
fuseConfigNew <- FuseConfig -> IO FuseConfig
go FuseConfig
fuseConfigOld
      -- The return value of the callback is poked back to @pFuseConfig@. Note that, by
      -- doing this the fields of @fuse_config@ which we do /not/ implement are left
      -- unchanged. This is the intended behavior.
      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr FuseConfig
pFuseConfig forall a b. (a -> b) -> a -> b
$ FuseConfig -> FuseConfig
toCFuseConfig FuseConfig
fuseConfigNew
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr

  wrapDestroy :: IO () -> C.CDestroy
  wrapDestroy :: IO () -> CDestroy
wrapDestroy IO ()
go Ptr ()
_privateData = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionHandler SomeException
handler) IO ()
go

  wrapAccess :: (FilePath -> AccessMode -> IO Errno) -> C.CAccess
  wrapAccess :: (String -> AccessMode -> IO Errno) -> CString -> CInt -> IO CInt
wrapAccess String -> AccessMode -> IO Errno
go CString
pFilePath CInt
mode = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    String -> AccessMode -> IO Errno
go String
filePath AccessMode
accessMode
    where
    accessMode :: AccessMode
accessMode
      | forall a. Bits a => a -> a -> Bool
testBitSet CInt
mode (CInt
0) = AccessMode
FileOK
{-# LINE 754 "src/System/LibFuse3/Internal.hsc" #-}
      | otherwise = PermOK
          (testBitSet mode (4))
{-# LINE 756 "src/System/LibFuse3/Internal.hsc" #-}
          (testBitSet mode (2))
{-# LINE 757 "src/System/LibFuse3/Internal.hsc" #-}
          (testBitSet mode (1))
{-# LINE 758 "src/System/LibFuse3/Internal.hsc" #-}

  wrapCreate :: (FilePath -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh)) -> C.CCreate
  wrapCreate :: (String
 -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))
-> CChmod
wrapCreate String
-> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh)
go CString
pFilePath FileMode
mode Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    (OpenFileFlags
openFileFlags, OpenMode
openMode) <- Ptr FuseFileInfo -> IO (OpenFileFlags, OpenMode)
peekOpenFileFlagsAndMode Ptr FuseFileInfo
pFuseFileInfo
    String
-> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh)
go String
filePath OpenMode
openMode FileMode
mode OpenFileFlags
openFileFlags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Errno
errno -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
errno
      Right fh
fh -> do
        forall fh. Ptr FuseFileInfo -> fh -> IO ()
newFH Ptr FuseFileInfo
pFuseFileInfo fh
fh
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eOK

  wrapUtimens :: (FilePath -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno) -> C.CUtimens
  wrapUtimens :: (String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)
-> CUtimens
wrapUtimens String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno
go CString
pFilePath Ptr TimeSpec
arrTs Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePathOrEmpty CString
pFilePath
    Maybe fh
mfh <- forall fh. Ptr FuseFileInfo -> IO (Maybe fh)
getFH Ptr FuseFileInfo
pFuseFileInfo
    [TimeSpec
atime, TimeSpec
mtime] <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr TimeSpec
arrTs
    String -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno
go String
filePath Maybe fh
mfh TimeSpec
atime TimeSpec
mtime

  wrapFallocate :: (FilePath -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno) -> C.CFallocate
  wrapFallocate :: (String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)
-> CFallocate
wrapFallocate String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno
go CString
pFilePath CInt
mode FileOffset
offset FileOffset
len Ptr FuseFileInfo
pFuseFileInfo = IO Errno -> IO CInt
handleAsFuseError forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    fh
fh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    String -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno
go String
filePath fh
fh CInt
mode FileOffset
offset FileOffset
len

  wrapCopyFileRange :: (FilePath -> fh -> FileOffset -> FilePath -> fh -> FileOffset -> ByteCount -> CInt -> IO (Either Errno CSsize)) -> C.CCopyFileRange
  wrapCopyFileRange :: (String
 -> fh
 -> FileOffset
 -> String
 -> fh
 -> FileOffset
 -> ByteCount
 -> CInt
 -> IO (Either Errno CSsize))
-> CCopyFileRange
wrapCopyFileRange String
-> fh
-> FileOffset
-> String
-> fh
-> FileOffset
-> ByteCount
-> CInt
-> IO (Either Errno CSsize)
go CString
pFilePathIn Ptr FuseFileInfo
pFuseFileInfoIn FileOffset
offsetIn CString
pFilePathOut Ptr FuseFileInfo
pFuseFileInfoOut FileOffset
offsetOut ByteCount
size CInt
flags = IO (Either Errno CSsize) -> IO CSsize
handleAsFuseErrorCSsize forall a b. (a -> b) -> a -> b
$ do
    String
filePathIn <- CString -> IO String
peekFilePath CString
pFilePathIn
    fh
fhIn <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfoIn
    String
filePathOut <- CString -> IO String
peekFilePath CString
pFilePathOut
    fh
fhOut <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfoOut
    String
-> fh
-> FileOffset
-> String
-> fh
-> FileOffset
-> ByteCount
-> CInt
-> IO (Either Errno CSsize)
go String
filePathIn fh
fhIn FileOffset
offsetIn String
filePathOut fh
fhOut FileOffset
offsetOut ByteCount
size CInt
flags

  wrapLseek :: (FilePath -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset)) -> C.CLseek
  wrapLseek :: (String
 -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
-> CLseek
wrapLseek String
-> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset)
go CString
pFilePath FileOffset
offset CInt
whence Ptr FuseFileInfo
pFuseFileInfo = IO (Either Errno FileOffset) -> IO FileOffset
handleAsFuseErrorCOff forall a b. (a -> b) -> a -> b
$ do
    String
filePath <- CString -> IO String
peekFilePath CString
pFilePath
    fh
fh <- forall fh. Ptr FuseFileInfo -> IO fh
getFHJust Ptr FuseFileInfo
pFuseFileInfo
    let emode :: Either Errno SeekMode
emode = case CInt
whence of
          (CInt
0) -> forall a b. b -> Either a b
Right SeekMode
AbsoluteSeek
{-# LINE 796 "src/System/LibFuse3/Internal.hsc" #-}
          (CInt
1) -> forall a b. b -> Either a b
Right SeekMode
RelativeSeek
{-# LINE 797 "src/System/LibFuse3/Internal.hsc" #-}
          (CInt
2) -> forall a b. b -> Either a b
Right SeekMode
SeekFromEnd
{-# LINE 798 "src/System/LibFuse3/Internal.hsc" #-}
          CInt
_ -> forall a b. a -> Either a b
Left Errno
eINVAL
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (String
-> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset)
go String
filePath fh
fh FileOffset
offset) Either Errno SeekMode
emode

  _dummyToSuppressWarnings :: StablePtr a
  _dummyToSuppressWarnings :: forall a. StablePtr a
_dummyToSuppressWarnings = forall a. HasCallStack => String -> a
error String
"dummy" Errno
eNOSYS

-- | Allocates a @fuse_args@ struct to hold commandline arguments.
resFuseArgs :: String -> [String] -> ResourceT IO (Ptr C.FuseArgs)
resFuseArgs :: String -> [String] -> ResourceT IO (Ptr FuseArgs)
resFuseArgs String
prog [String]
args = do
  let allArgs :: [String]
allArgs = (String
progforall a. a -> [a] -> [a]
:[String]
args)
      argc :: Int
argc = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
allArgs
  [CString]
cArgs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ResourceT IO (ReleaseKey, CString)
resNewCString) [String]
allArgs
  Ptr CString
pArgv <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [a] -> ResourceT IO (ReleaseKey, Ptr a)
resNewArray [CString]
cArgs
  -- call FUSE_ARGS_INIT instead?
  Ptr FuseArgs
fuseArgs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Int -> ResourceT IO (ReleaseKey, Ptr a)
resMallocBytes ((Int
24))
{-# LINE 813 "src/System/LibFuse3/Internal.hsc" #-}
  liftIO $ do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) fuseArgs argc
{-# LINE 815 "src/System/LibFuse3/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) fuseArgs pArgv
{-# LINE 816 "src/System/LibFuse3/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) fuseArgs (0::CInt)
{-# LINE 817 "src/System/LibFuse3/Internal.hsc" #-}
  _ <- Res.register $ C.fuse_opt_free_args fuseArgs
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr FuseArgs
fuseArgs

-- | Calls @fuse_parse_cmdline@ to parse the part of the commandline arguments that
-- we care about.
--
-- @fuse_parse_cmdline@ will modify the `C.FuseArgs` struct passed in to remove those
-- arguments; the `C.FuseArgs` struct containing remaining arguments must be passed to
-- @fuse_mount@/@fuse_new@.
--
-- The multithreaded runtime will be used regardless of the threading flag!
-- See the comment in @fuse_session_exit@ for why.
fuseParseCommandLine :: Ptr C.FuseArgs -> IO (Either ExitCode FuseMainArgs)
fuseParseCommandLine :: Ptr FuseArgs -> IO (Either ExitCode FuseMainArgs)
fuseParseCommandLine Ptr FuseArgs
pArgs =
  forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
48)) forall a b. (a -> b) -> a -> b
$ \Ptr FuseCmdlineOpts
pOpts -> do
{-# LINE 832 "src/System/LibFuse3/Internal.hsc" #-}
    retval <- C.fuse_parse_cmdline pArgs pOpts
    if retval /= 0
      -- fuse_parse_cmdline prints an error message
      then pure $ Left $ ExitFailure 1
      else go pOpts
  where
  go :: Ptr b -> IO (Either ExitCode (Bool, String, c))
go Ptr b
pOpts = do
    CString
pMountPoint <- ((\Ptr b
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
hsc_ptr Int
16)) Ptr b
pOpts
{-# LINE 840 "src/System/LibFuse3/Internal.hsc" #-}
    showHelp    <- (/= (0 :: CInt)) <$> ((\hsc_ptr -> peekByteOff hsc_ptr 28)) pOpts
{-# LINE 841 "src/System/LibFuse3/Internal.hsc" #-}
    showVersion <- (/= (0 :: CInt)) <$> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) pOpts
{-# LINE 842 "src/System/LibFuse3/Internal.hsc" #-}
    -- free fuse_cmdline_opts.mountpoint because it is allocated with realloc (see libfuse's examples)
    let freeMountPoint :: IO ()
freeMountPoint = forall a. Ptr a -> IO ()
free CString
pMountPoint
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
finally IO ()
freeMountPoint forall a b. (a -> b) -> a -> b
$ case () of
      ()
_ | Bool
showHelp -> do
            forall r. PrintfType r => String -> r
printf String
"usage: %s [options] <mountpoint>\n\n" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
getProgName
            IO ()
C.fuse_cmdline_help
            Ptr FuseArgs -> IO ()
C.fuse_lib_help Ptr FuseArgs
pArgs
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ExitCode
ExitSuccess
        | Bool
showVersion -> do
            String
ver <- CString -> IO String
peekCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString
C.fuse_pkgversion
            forall r. PrintfType r => String -> r
printf String
"FUSE library version %s\n" String
ver
            IO ()
C.fuse_lowlevel_version
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ExitCode
ExitSuccess
        | CString
pMountPoint forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr -> do
            String
progName <- IO String
getProgName
            forall r. HPrintfType r => Handle -> String -> r
hPrintf Handle
stderr String
"usage: %s [options] <mountpoint>\n" String
progName
            forall r. HPrintfType r => Handle -> String -> r
hPrintf Handle
stderr String
"       %s --help\n" String
progName
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
        | Bool
otherwise -> do
            String
mountPoint <- CString -> IO String
peekFilePath CString
pMountPoint
            Bool
foreground <- (forall a. Eq a => a -> a -> Bool
/= (CInt
0 :: CInt)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr b
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
hsc_ptr Int
4)) Ptr b
pOpts
{-# LINE 863 "src/System/LibFuse3/Internal.hsc" #-}
            c
cloneFd <- ((\Ptr b
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
hsc_ptr Int
32)) Ptr b
pOpts
{-# LINE 864 "src/System/LibFuse3/Internal.hsc" #-}
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Bool
foreground, String
mountPoint, c
cloneFd)

-- | Parses the commandline arguments and exit if the args are bad or certain informational
-- flag(s) are specified. See `fuseParseCommandLine`.
fuseParseCommandLineOrExit :: Ptr C.FuseArgs -> IO FuseMainArgs
fuseParseCommandLineOrExit :: Ptr FuseArgs -> IO FuseMainArgs
fuseParseCommandLineOrExit Ptr FuseArgs
pArgs = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. ExitCode -> IO a
exitWith forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr FuseArgs -> IO (Either ExitCode FuseMainArgs)
fuseParseCommandLine Ptr FuseArgs
pArgs

-- | Haskell version of @fuse_daemonize@.
--
-- During the fork, transfers all of the resources in `ResourceT` (and its cleanup actions)
-- to the forked process.
--
-- Mimics @daemon()@'s use of @_exit()@ instead of @exit()@; we depend on this in
-- `fuseMainReal`, because otherwise we'll unmount the filesystem when the foreground
-- process exits.
fuseDaemonize :: ResourceT IO a -> ResourceT IO b
fuseDaemonize :: forall a b. ResourceT IO a -> ResourceT IO b
fuseDaemonize ResourceT IO a
job = forall a b. ResourceT IO a -> ResourceT IO b
daemonizeResourceT forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    ProcessGroupID
_ <- IO ProcessGroupID
createSession
    String -> IO ()
changeWorkingDirectory String
"/"
    -- need to open @/dev/null@ twice because `hDuplicateTo` can't dup a
    -- ReadWriteMode to a ReadMode handle
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
"/dev/null" IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
devNullOut -> do
      Handle -> Handle -> IO ()
hDuplicateTo Handle
devNullOut Handle
stdout
      Handle -> Handle -> IO ()
hDuplicateTo Handle
devNullOut Handle
stderr
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
"/dev/null" IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
devNullIn -> do
      Handle -> Handle -> IO ()
hDuplicateTo Handle
devNullIn Handle
stdin
  a
_ <- ResourceT IO a
job
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a
exitSuccess

-- | @withSignalHandlers handler io@ installs signal handlers while @io@ is executed.
withSignalHandlers :: IO () -> IO a -> IO a
withSignalHandlers :: forall a. IO () -> IO a -> IO a
withSignalHandlers IO ()
exitHandler = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
setHandlers IO ()
resetHandlers
  where
  setHandlers :: IO ()
setHandlers = do
    let sigHandler :: Handler
sigHandler = IO () -> Handler
Signals.Catch IO ()
exitHandler
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigINT  Handler
sigHandler forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigHUP  Handler
sigHandler forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigTERM Handler
sigHandler forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigPIPE Handler
Signals.Ignore forall a. Maybe a
Nothing
  resetHandlers :: IO ()
resetHandlers = do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigINT  Handler
Signals.Default forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigHUP  Handler
Signals.Default forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigTERM Handler
Signals.Default forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler CInt
Signals.sigPIPE Handler
Signals.Default forall a. Maybe a
Nothing

-- | The parts of @fuse_parse_cmdline@ we are interested in. Passed to `fuseMainReal`.
--
-- @(foreground, mountpoint, clone_fd)@
--
-- So far, we don't interpret the value of @clone_fd@ at all so its type is `CInt`.
type FuseMainArgs = (Bool, String, CInt)

-- | Mounts the filesystem, forks (if requested), and then starts fuse.
fuseMainReal
  :: Ptr C.StructFuse
  -> FuseMainArgs
  -> ResourceT IO a
fuseMainReal :: forall a. Ptr StructFuse -> FuseMainArgs -> ResourceT IO a
fuseMainReal = \Ptr StructFuse
pFuse (Bool
foreground, String
mountPt, CInt
cloneFd) -> do
  let run :: IO a -> ResourceT IO a
run = if Bool
foreground
        then \IO a
io -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
changeWorkingDirectory String
"/" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
        else forall a b. ResourceT IO a -> ResourceT IO b
fuseDaemonize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  CString
cMountPt <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ String -> ResourceT IO (ReleaseKey, CString)
resNewFilePath String
mountPt
  CInt
mountResult <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Res.allocate (Ptr StructFuse -> CUnlink
C.fuse_mount Ptr StructFuse
pFuse CString
cMountPt) (\CInt
_ -> Ptr StructFuse -> IO ()
C.fuse_unmount Ptr StructFuse
pFuse)
  if CInt
mountResult forall a. Eq a => a -> a -> Bool
== CInt
0
    then forall {a}. IO a -> ResourceT IO a
run forall a b. (a -> b) -> a -> b
$ forall {b}. Ptr StructFuse -> CInt -> IO b
procMain Ptr StructFuse
pFuse CInt
cloneFd
    else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"fuse_mount failed"
  where
  -- here, we're finally inside the daemon process, we can run the main loop
  procMain :: Ptr StructFuse -> CInt -> IO b
procMain Ptr StructFuse
pFuse CInt
cloneFd = do
    Ptr FuseSession
session <- Ptr StructFuse -> IO (Ptr FuseSession)
C.fuse_get_session Ptr StructFuse
pFuse
    -- Due to some interaction between GHC runtime, calling fuse_session_exit once doesn't
    -- stop fuse_loop_mt_31. On receiving a second signal the loop exits and the filesystem
    -- is unmounted.
    -- Adding the RTS option @--install-signal-handlers=no@ does not fix the issue.
    --
    -- On the other hand, @fusermount3 -u@ successfully unmounts the filesystem on the first
    -- attempt.
    forall a. IO () -> IO a -> IO a
withSignalHandlers (Ptr FuseSession -> IO ()
C.fuse_session_exit Ptr FuseSession
session) forall a b. (a -> b) -> a -> b
$ do
      Int
retVal <- Ptr StructFuse -> CInt -> IO Int
C.fuse_loop_mt_31 Ptr StructFuse
pFuse CInt
cloneFd
      if Int
retVal forall a. Eq a => a -> a -> Bool
== Int
0
        then forall a. IO a
exitSuccess
        else forall a. IO a
exitFailure

-- | Parses the commandline arguments and runs fuse.
fuseRun :: Exception e => String -> [String] -> FuseOperations fh dh -> ExceptionHandler e -> IO a
fuseRun :: forall e fh dh a.
Exception e =>
String
-> [String] -> FuseOperations fh dh -> ExceptionHandler e -> IO a
fuseRun String
prog [String]
args FuseOperations fh dh
ops ExceptionHandler e
handler = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ do
  Ptr FuseArgs
pArgs <- String -> [String] -> ResourceT IO (Ptr FuseArgs)
resFuseArgs String
prog [String]
args
  FuseMainArgs
mainArgs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Ptr FuseArgs -> IO FuseMainArgs
fuseParseCommandLineOrExit Ptr FuseArgs
pArgs
  Ptr FuseOperations
pOp <- forall fh dh e.
Exception e =>
FuseOperations fh dh
-> ExceptionHandler e -> ResourceT IO (Ptr FuseOperations)
resCFuseOperations FuseOperations fh dh
ops ExceptionHandler e
handler
  Ptr StructFuse
pFuse <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Res.allocate
    (forall a.
Ptr FuseArgs
-> Ptr FuseOperations -> ByteCount -> Ptr a -> IO (Ptr StructFuse)
C.fuse_new Ptr FuseArgs
pArgs Ptr FuseOperations
pOp ((ByteCount
336)) forall a. Ptr a
nullPtr)
{-# LINE 956 "src/System/LibFuse3/Internal.hsc" #-}
    (\p -> unless (p == nullPtr) $ C.fuse_destroy p)
  if Ptr StructFuse
pFuse forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO a
exitFailure -- fuse_new prints an error message
    else forall a. Ptr StructFuse -> FuseMainArgs -> ResourceT IO a
fuseMainReal Ptr StructFuse
pFuse FuseMainArgs
mainArgs

-- | Main function of FUSE.
--
-- This is all that has to be called from the @main@ function. On top of
-- the `FuseOperations` record with filesystem implementation, you must give
-- an exception handler converting Haskell exceptions to `Errno`.
fuseMain :: Exception e => FuseOperations fh dh -> ExceptionHandler e -> IO ()
fuseMain :: forall e fh dh.
Exception e =>
FuseOperations fh dh -> ExceptionHandler e -> IO ()
fuseMain FuseOperations fh dh
ops ExceptionHandler e
handler = do
  -- this used to be implemented using libfuse's fuse_main. Doing this will fork()
  -- from C behind the GHC runtime's back, which deadlocks in GHC 6.8.
  -- Instead, we reimplement fuse_main in Haskell using the forkProcess and the
  -- lower-level fuse_new/fuse_loop_mt API.
  String
prog <- IO String
getProgName
  [String]
args <- IO [String]
getArgs
  forall e fh dh a.
Exception e =>
String
-> [String] -> FuseOperations fh dh -> ExceptionHandler e -> IO a
fuseRun String
prog [String]
args FuseOperations fh dh
ops ExceptionHandler e
handler

-- | An exception handler which converts Haskell exceptions from `FuseOperations` methods to `Errno`.
type ExceptionHandler e = e -> IO Errno

-- | Catches any exception, logs it to stderr, and returns `eIO`.
--
-- Suitable as a default exception handler.
--
-- __NOTE 1__ This differs from the one in the @HFuse@ package which returns `eFAULT`.
--
-- __NOTE 2__ If the filesystem is daemonized (as default), the exceptions will not be logged because
-- stderr is redirected to @\/dev\/null@.
defaultExceptionHandler :: ExceptionHandler SomeException
defaultExceptionHandler :: ExceptionHandler SomeException
defaultExceptionHandler SomeException
e = Handle -> String -> IO ()
hPutStrLn Handle
stderr (forall a. Show a => a -> String
show SomeException
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Errno
eIO
  where
  _dummyToSuppressWarnings :: t
_dummyToSuppressWarnings = forall a. HasCallStack => String -> a
error String
"dummy" Errno
eFAULT

-- | Gets a file handle from `C.FuseFileInfo` which is embedded with `newFH`.
--
-- If either the @Ptr `C.FuseFileInfo`@ itself or its @fh@ field is NULL, returns @Nothing@.
getFH :: Ptr C.FuseFileInfo -> IO (Maybe fh)
getFH :: forall fh. Ptr FuseFileInfo -> IO (Maybe fh)
getFH Ptr FuseFileInfo
pFuseFileInfo
  | Ptr FuseFileInfo
pFuseFileInfo forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  | Bool
otherwise = do
    Ptr ()
sptr <- ((\Ptr FuseFileInfo
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FuseFileInfo
hsc_ptr Int
16)) Ptr FuseFileInfo
pFuseFileInfo
{-# LINE 1000 "src/System/LibFuse3/Internal.hsc" #-}
    -- Note that this implementation relies on the fact that @fuse_file_info.fh@ is
    -- @NULL@-initialized before @fuse_operations.open@ and @.opendir@, and remains @NULL@
    -- if they are unimplemented. It's a hack but we check this because because if we
    -- didn't, we'll hit undefined behavior.
    if Ptr ()
sptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. StablePtr a -> IO a
deRefStablePtr forall a b. (a -> b) -> a -> b
$ forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
sptr

-- | Gets a file handle from `C.FuseFileInfo`.
--
-- @
-- getFHJust = fmap fromJust . `getFH`
-- @
--
-- This means you must make sure that `getFH` returns @Just@ or you'll get a Haskell
-- exception. /However/, it's deliberately made lazy so that calling `getFHJust` itself
-- won't throw but trying to use the returned value will.
--
-- This function is implemented this way in order to take care of rare(?) cases in which
-- `fuseRead`\/`fuseReaddir` is implemented but not `fuseOpen`\/`fuseOpendir` resp. In
-- such a case, `newFH` would not be called but only `getFH` would be. Without some
-- protection, we would be dereferencing a non-initialized `StablePtr`, which is
-- /undefined behavior/. Throwing a Haskell exception in a pure code is much better than
-- UB. See the comment in the source of `getFH` if you are interested in more explanation.
getFHJust :: Ptr C.FuseFileInfo -> IO fh
getFHJust :: forall fh. Ptr FuseFileInfo -> IO fh
getFHJust = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fh. Ptr FuseFileInfo -> IO (Maybe fh)
getFH

-- | Embeds a file handle into `C.FuseFileInfo`. It should be freed with `delFH` when no
-- longer required.
newFH :: Ptr C.FuseFileInfo -> fh -> IO ()
newFH :: forall fh. Ptr FuseFileInfo -> fh -> IO ()
newFH Ptr FuseFileInfo
pFuseFileInfo fh
fh = do
  StablePtr fh
sptr <- forall a. a -> IO (StablePtr a)
newStablePtr fh
fh
  ((\Ptr FuseFileInfo
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FuseFileInfo
hsc_ptr Int
16)) Ptr FuseFileInfo
pFuseFileInfo forall a b. (a -> b) -> a -> b
$ forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr fh
sptr
{-# LINE 1033 "src/System/LibFuse3/Internal.hsc" #-}

-- | Frees a file handle in `C.FuseFileInfo` which is embedded with `newFH`.
delFH :: Ptr C.FuseFileInfo -> IO ()
delFH :: Ptr FuseFileInfo -> IO ()
delFH Ptr FuseFileInfo
pFuseFileInfo = do
  Ptr ()
sptr <- ((\Ptr FuseFileInfo
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FuseFileInfo
hsc_ptr Int
16)) Ptr FuseFileInfo
pFuseFileInfo
{-# LINE 1038 "src/System/LibFuse3/Internal.hsc" #-}
  -- if sptr is NULL, it should mean newFH have not called. See getFH and getFHJust for
  -- more info
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr ()
sptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$
    forall a. StablePtr a -> IO ()
freeStablePtr forall a b. (a -> b) -> a -> b
$ forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
sptr

-- | Materializes the callback of @readdir@ to marshal `fuseReaddir`.
foreign import ccall "dynamic"
  peekFuseFillDir :: FunPtr C.FuseFillDir -> C.FuseFillDir