Add read-only mounting of a directory by FUSE.

Vendoring hfuse with relaxed deps.

flake.nix

@@ -48,6 +48,7 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
       "db-pipe"
       "fuzzy-parse"
       "suckless-conf"
+      "hfuse"
       ];
 
     jailbreakUnbreak = pkgs: pkg:

hbs2-sync/hbs2-sync.cabal

@@ -67,6 +67,7 @@ common shared-properties
       , directory
       , filepath
       , filepattern
+      , hfuse
       , interpolatedstring-perl6
       , memory
       , microlens-platform
@@ -80,6 +81,7 @@ common shared-properties
       , timeit
       , transformers
       , typed-process
+      , unix
       , unordered-containers
       , unliftio
       , zlib
@@ -91,23 +93,17 @@ library
     exposed-modules:
       HBS2.Sync.Prelude
       HBS2.Sync.State
+      HBS2.Sync.Mount
       HBS2.Sync.Internal
       HBS2.Sync
 
-    other-modules:
-
-    -- other-modules:
-    -- other-extensions:
     build-depends:    base, hbs2-peer, hbs2-cli
     hs-source-dirs:   src
 
 executable hbs2-sync
     import:           shared-properties
     main-is:          Main.hs
-    -- other-modules:
-    -- other-extensions:
     build-depends:
         base, hbs2-sync, hbs2-peer
-
     hs-source-dirs:   app
     default-language: GHC2021

hbs2-sync/src/HBS2/Sync.hs

@@ -5,5 +5,3 @@ module HBS2.Sync
 
 import HBS2.Sync.Internal as Exported
 import HBS2.Sync.State as Exported
-
-

hbs2-sync/src/HBS2/Sync/Internal.hs

@@ -4,6 +4,7 @@ module HBS2.Sync.Internal
 
 import HBS2.Sync.Prelude
 import HBS2.Sync.State
+import HBS2.Sync.Mount (mountPath)
 import HBS2.System.Dir
 import HBS2.Storage.Operations.ByteString
 import HBS2.Peer.RPC.API.RefChan
@@ -105,9 +106,7 @@ syncInit keys = do
       >>= orThrowUser "invalid hbs2-peer attributes"
 
   peerKey <-
-    [ x
+    [x | ListVal [SymbolVal "peer-key:", SignPubKeyLike x] <- poked]
-    | ListVal [SymbolVal "peer-key:", SignPubKeyLike x] <- poked
-    ]
       & headMay
       & orThrowUser "hbs2-peer key not found"
 
@@ -234,6 +233,29 @@ hbs2-sync init --refchan 94GF31TtD38yWG6iZLRy1xZBb1dxcAC7BRBJTMyAq8VF
       _ -> do
         err "unknown parameters, please use `help init` command"
 
+  brief "mount"
+    $ desc "mount"
+    $ entry $ bindMatch "mount" $ nil_ $ \case
+      [StringLike configPath, StringLike path] -> do
+        config :: [Syntax c] <-
+          try @_ @IOError (liftIO $ readFile configPath)
+            <&> fromRight mempty
+            <&> parseTop
+            <&> either mempty (fmap fixContext)
+
+        void $ evalTop $ [mkList [mkSym "dir", mkStr "."]] ++ config
+
+        dir <- getRunDir
+        env <- getRunDirEnv dir >>= orThrow DirNotSet
+        refchan <-
+           view dirSyncRefChan env
+             & orThrowUser "refchan not found"
+
+        liftIO $ mountPath refchan path
+
+      _ ->
+        err "unknown"
+
   brief "deleted entries"
     $ desc "show deleted entries"
     $ entry $ bindMatch "deleted" $ nil_ $ \_ -> do

hbs2-sync/src/HBS2/Sync/Mount.hs

@@ -0,0 +1,354 @@
+module HBS2.Sync.Mount
+  ( mountPath
+  ) where
+
+import HBS2.Sync.Prelude hiding (SyncEnv(..))
+import HBS2.Sync.State
+
+import HBS2.Actors.Peer (makeResponse, runProto)
+import HBS2.CLI.Run.MetaData (getTreeContents)
+import HBS2.KeyMan.Keys.Direct qualified as KE
+import HBS2.Net.Messaging.Unix as Unix
+import HBS2.Net.Proto.Service qualified as HBS2
+import HBS2.Net.Proto.Notify (runNotifySink, makeNotifyClient, newNotifySink, runNotifyWorkerClient)
+import HBS2.Peer.CLI.Detect (detectRPC)
+import HBS2.Peer.Notify (NotifyData(RefChanUpdated), NotifyKey(..), RefChanEvents)
+import HBS2.Peer.RPC.API.Peer qualified as Peer
+import HBS2.Peer.RPC.API.RefChan qualified as RefChan
+import HBS2.Peer.RPC.API.Storage qualified as Storage
+import HBS2.Peer.RPC.Client qualified as Client
+import HBS2.Peer.RPC.Client.StorageClient qualified as Client
+import HBS2.Peer.RPC.Client.Unix (runServiceClientMulti, Endpoint(Endpoint))
+
+import Control.Monad.Except (runExceptT)
+import Data.ByteString.Char8 qualified as BS
+import Data.ByteString.Lazy qualified as LBS
+import Data.List qualified as List
+import Data.Map qualified as Map
+import System.Fuse (FuseOperations(..))
+import System.Fuse qualified as Fuse
+import System.Posix.Files qualified as Posix
+import System.Posix.Types qualified as Posix
+import Data.Int (Int64)
+
+type FuseOp a = IO (Either Fuse.Errno a)
+
+type Tree = Map.Map FilePath Entry
+
+data MountEnv =
+  MountEnv
+    { peerAPI :: HBS2.ServiceCaller Peer.PeerAPI UNIX
+    , refChanAPI :: HBS2.ServiceCaller RefChan.RefChanAPI UNIX
+    , storageAPI :: HBS2.ServiceCaller Storage.StorageAPI UNIX
+    , keymanClientEnv :: KeyManClientEnv
+    }
+
+newtype MountApp m a =
+  MountApp { fromMountApp :: ReaderT MountEnv m a }
+  deriving newtype ( Applicative
+                   , Functor
+                   , Monad
+                   , MonadUnliftIO
+                   , MonadIO
+                   , MonadReader MountEnv)
+
+data State =
+  State
+    { refChan :: MyRefChan
+    , tree :: Tree
+    }
+
+instance MonadUnliftIO m => HasKeyManClient (MountApp m) where
+  getKeyManClientEnv = ask <&> keymanClientEnv
+
+instance MonadIO m => Client.HasClientAPI Storage.StorageAPI UNIX (MountApp m) where
+  getClientAPI = ask <&> storageAPI
+
+instance MonadIO m => Client.HasClientAPI RefChan.RefChanAPI UNIX (MountApp m) where
+  getClientAPI = ask <&> refChanAPI
+
+instance MonadIO m => Client.HasClientAPI Peer.PeerAPI UNIX (MountApp m) where
+  getClientAPI = ask <&> peerAPI
+
+instance MonadIO m => HasStorage (MountApp m) where
+  getStorage = do
+    api <- Client.getClientAPI @Storage.StorageAPI @UNIX
+    pure $ AnyStorage (Client.StorageClient api)
+
+withEnv :: MonadUnliftIO m => MountApp IO a -> m a
+withEnv action = do
+  soname <- detectRPC >>= orThrowUser "could not detect RPC"
+  flip runContT pure do
+    client <- newMessagingUnix False 1.0 soname
+    void $ ContT $ withAsync $ runMessagingUnix client
+
+    peerAPI <- HBS2.makeServiceCaller @Peer.PeerAPI (fromString soname)
+    refChanAPI <- HBS2.makeServiceCaller @RefChan.RefChanAPI (fromString soname)
+    storageAPI <- HBS2.makeServiceCaller @Storage.StorageAPI (fromString soname)
+    let endpoints = [ Endpoint @UNIX peerAPI
+                    , Endpoint @UNIX refChanAPI
+                    , Endpoint @UNIX storageAPI
+                    ]
+    void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client
+
+    keymanClientEnv <- liftIO $ KE.newKeymanClientEnv
+
+    let env = MountEnv{..}
+    liftIO $ runReaderT (fromMountApp action) env
+
+rootPath :: FilePath
+rootPath = "/"
+
+buildTree :: [Entry] -> Map.Map FilePath Entry
+buildTree entries =
+  let
+    addDirs entry =
+      if isFile entry then
+        entriesFromFile (getEntryHash entry) (getEntryTimestamp entry) (entryPath entry)
+      else
+        Map.empty
+
+    prependSlash (DirEntry desc path) acc =
+      let
+        newPath = "/" <> path
+      in
+      Map.insert newPath (DirEntry desc newPath) acc
+  in
+  entries
+    & List.sortOn getEntryTimestamp
+    & foldl (\acc entry -> Map.insert (entryPath entry) entry acc) Map.empty
+    & foldr (\entry acc -> Map.unionWith merge (addDirs entry) acc) Map.empty
+    & Map.foldr prependSlash Map.empty
+
+dirStat :: Fuse.FuseContext -> Fuse.FileStat
+dirStat ctx =
+  let
+    statEntryType = Fuse.Directory
+    statFileMode =
+      foldr1 Posix.unionFileModes
+        [ Posix.ownerReadMode
+        , Posix.ownerExecuteMode
+        , Posix.groupReadMode
+        , Posix.groupExecuteMode
+        , Posix.otherReadMode
+        , Posix.otherExecuteMode
+        ]
+    statLinkCount = 2
+    statFileOwner = Fuse.fuseCtxUserID ctx
+    statFileGroup = Fuse.fuseCtxGroupID ctx
+    statSpecialDeviceID = 0
+    statFileSize = 4096
+    statBlocks = 1
+    statAccessTime = 0
+    statModificationTime = 0
+    statStatusChangeTime = 0
+  in
+  Fuse.FileStat { .. }
+
+fileStat :: Int64 -> Fuse.FuseContext -> Fuse.FileStat
+fileStat size ctx =
+  let
+    statEntryType = Fuse.RegularFile
+    statFileMode =
+      foldr1 Posix.unionFileModes
+        [ Posix.ownerReadMode
+        , Posix.groupReadMode
+        , Posix.otherReadMode
+        ]
+    statLinkCount = 1
+    statFileOwner = Fuse.fuseCtxUserID ctx
+    statFileGroup = Fuse.fuseCtxGroupID ctx
+    statSpecialDeviceID = 0
+    statFileSize = fromIntegral size
+    statBlocks = 1
+    statAccessTime = 0
+    statModificationTime = 0
+    statStatusChangeTime = 0
+  in
+  Fuse.FileStat { .. }
+
+onInit :: IORef (Maybe State) -> MyRefChan -> IO ()
+onInit ref refChan = do
+  rpcSockPath' <- detectRPC >>= orThrowUser "could not detect RPC"
+  refChanNotifyClient <- newMessagingUnix False 1.0 rpcSockPath'
+  sink <- newNotifySink
+
+  async1 <- async $ runMessagingUnix refChanNotifyClient
+
+  async2 <- async $ flip runReaderT refChanNotifyClient $ do
+    runProto @UNIX
+      [ makeResponse (makeNotifyClient @(RefChanEvents L4Proto) sink)
+      ]
+
+  async3 <- async $ runNotifySink sink (RefChanNotifyKey refChan) $ \case
+    RefChanUpdated _ _ -> do
+      accepted <- withEnv $ getAccepted refChan
+      let tree = buildTree accepted
+      writeIORef ref $ Just State{..}
+
+    _ -> do
+      return ()
+
+  async4 <- async $ flip runReaderT refChanNotifyClient $ do
+    runNotifyWorkerClient sink
+
+  accepted <- withEnv $ getAccepted refChan
+  let tree = buildTree accepted
+  writeIORef ref $ Just State{..}
+
+  return ()
+
+onGetFileStat :: IORef (Maybe State) -> FilePath -> FuseOp Fuse.FileStat
+onGetFileStat ref path
+  | path == rootPath =
+    Right . dirStat <$> Fuse.getFuseContext
+
+  | otherwise = do
+    Just State{..} <- readIORef ref
+    case Map.lookup path tree of
+      Just (DirEntry (EntryDesc { entryType = Dir }) _) ->
+        Right . dirStat <$> Fuse.getFuseContext
+
+      Just entry@(DirEntry (EntryDesc { entryType = File }) _) ->
+        case getEntryHash entry of
+          Just hash -> do
+            size <- withEnv do
+              storage <- getStorage
+              eitherContent <- runExceptT (getTreeContents storage hash)
+              case eitherContent of
+                Right content ->
+                  return $ (LBS.length content)
+
+            Right . fileStat size <$> Fuse.getFuseContext
+
+          _ ->
+            return $ Left Fuse.eNOENT
+
+      _ ->
+        return $ Left Fuse.eNOENT
+
+onOpen :: IORef (Maybe State) -> FilePath -> Fuse.OpenMode -> Fuse.OpenFileFlags -> FuseOp ()
+onOpen ref path mode _flags = do
+  Just State{..} <- readIORef ref
+  case Map.lookup path tree of
+    Just (DirEntry (EntryDesc { entryType = File }) _) ->
+      case mode of
+        Fuse.ReadOnly ->
+          return $ Right ()
+
+        _ ->
+          return $ Left Fuse.eACCES
+
+    _ ->
+      return $ Left Fuse.eNOENT
+
+
+onRead :: IORef (Maybe State) -> FilePath -> () -> Posix.ByteCount -> Posix.FileOffset -> FuseOp BS.ByteString
+onRead ref path _ byteCount offset = do
+  Just State{..} <- readIORef ref
+  withEnv do
+    case Map.lookup path tree of
+      Just entry@(DirEntry (EntryDesc { entryType = File }) _) ->
+        case getEntryHash entry of
+          Just hash -> do
+            storage <- getStorage
+            eitherContent <- runExceptT (getTreeContents storage hash)
+            case eitherContent of
+              Right content ->
+                content
+                  & LBS.drop (fromIntegral offset)
+                  & LBS.take (fromIntegral byteCount)
+                  & LBS.toStrict
+                  & Right
+                  & return
+
+              _ ->
+                return $ Left Fuse.eNOENT
+
+          _ ->
+            return $ Left Fuse.eNOENT
+
+      _ ->
+        return $ Left Fuse.eNOENT
+
+
+onOpenDirectory :: IORef (Maybe State) -> String -> IO Fuse.Errno
+onOpenDirectory ref path
+  | path == rootPath =
+    return Fuse.eOK
+
+  | otherwise = do
+    Just State{..} <- readIORef ref
+    case Map.lookup path tree of
+      Just (DirEntry (EntryDesc { entryType = Dir }) _) ->
+        return Fuse.eOK
+
+      _ ->
+        return Fuse.eNOENT
+
+stat :: Fuse.FuseContext -> Map.Map FilePath Entry -> FilePath -> FilePath -> [(FilePath, Fuse.FileStat)]
+stat context tree prefix path =
+  case Map.lookup (prefix <> path) tree of
+    Just (DirEntry (EntryDesc { entryType = Dir }) _) ->
+      [(path, dirStat context)]
+
+    Just (DirEntry (EntryDesc { entryType = File }) _) ->
+      [(path, fileStat 4096 context)]
+
+    _ ->
+      []
+
+makeEntries :: Fuse.FuseContext -> Map.Map FilePath Entry -> FilePath -> [(FilePath, Fuse.FileStat)]
+makeEntries context tree prefix =
+  Map.keys tree
+    & filter (List.isPrefixOf prefix)
+    & map (\path -> takeWhile (/= '/') $ fromMaybe path $ List.stripPrefix prefix path)
+    & List.nub
+    & concatMap (stat context tree prefix)
+
+onReadDirectory :: IORef (Maybe State) -> FilePath -> FuseOp [(FilePath, Fuse.FileStat)]
+onReadDirectory ref path =
+  let
+    prefix =
+      if path == rootPath then
+        rootPath
+      else
+        path <> "/"
+  in do
+    Just State{..} <- readIORef ref
+    context <- Fuse.getFuseContext
+    let entries = makeEntries context tree prefix
+
+    return $ Right $
+      [ (".", dirStat context)
+      , ("..", dirStat context)
+      ] <> entries
+
+onGetFileSystemStats :: String -> FuseOp Fuse.FileSystemStats
+onGetFileSystemStats _ =
+  return $ Right $ Fuse.FileSystemStats
+    { fsStatBlockSize = 512
+    , fsStatBlockCount = 1
+    , fsStatBlocksFree = 1
+    , fsStatBlocksAvailable = 1
+    , fsStatFileCount = 5
+    , fsStatFilesFree = 10
+    , fsStatMaxNameLength = 255
+    }
+
+operations :: IORef (Maybe State) -> MyRefChan -> Fuse.FuseOperations ()
+operations ref refChan =
+  Fuse.defaultFuseOps
+    { fuseGetFileStat = onGetFileStat ref
+    , fuseGetFileSystemStats = onGetFileSystemStats
+    , fuseInit = onInit ref refChan
+    , fuseOpen = onOpen ref
+    , fuseOpenDirectory = onOpenDirectory ref
+    , fuseRead = onRead ref
+    , fuseReadDirectory = onReadDirectory ref
+    }
+
+mountPath :: MyRefChan -> FilePath -> IO ()
+mountPath refChan path = do
+  ref <- newIORef Nothing
+  Fuse.fuseRun "sync mount" [path] (operations ref refChan) Fuse.defaultExceptionHandler

hbs2-sync/src/HBS2/Sync/State.hs

@@ -157,6 +157,57 @@ entriesFromFile h ts fn0 = do
     dirEntry p   = DirEntry (EntryDesc Dir ts Nothing) p
     fileEntry p  = DirEntry (EntryDesc File ts h) p
 
+getEntriesFromRefchan ::
+  forall m . ( MonadUnliftIO m, HasStorage m, HasClientAPI RefChanAPI UNIX m )
+  => KeyManClientEnv
+  -> AnyStorage
+  -> MyRefChan
+  -> m [Entry]
+getEntriesFromRefchan keymanEnv storage refchan = do
+  outq <- newTQueueIO
+  tss <- newTVarIO mempty
+
+  let findKey = lift . lift . withKeymanClientRO keymanEnv . findMatchedGroupKeySecret storage
+
+  walkRefChanTx @UNIX (const (pure True)) refchan $ \_ unpacked -> do
+    case unpacked of
+      A (AcceptTran acceptTime _ what) -> do
+        for_ acceptTime $ \timestamp -> do
+          atomically $ modifyTVar tss (HM.insertWith max what (coerce @_ @Word64 timestamp))
+
+      P proposeHash (ProposeTran _ box) -> void $ runMaybeT do
+        (_, unboxed) <- unboxSignedBox0 box & toMPlus
+        AnnotatedHashRef _ href <- deserialiseOrFail @AnnotatedHashRef (LBS.fromStrict unboxed)
+                                    & toMPlus . either (const Nothing) Just
+
+        meta <- runExceptT (extractMetaData @'HBS2Basic findKey storage href) >>= toMPlus
+        atomically $ writeTQueue outq (proposeHash, href, meta)
+
+  trees <- atomically (flushTQueue outq)
+  tsmap <- readTVarIO tss
+
+  pure $ concatMap (makeEntry tsmap) trees
+
+  where
+    makeEntry tsmap (hash, tree, meta) = do
+      let what = parseTop meta & fromRight mempty
+      let location = headDef "" [ l | ListVal [StringLike "location:", StringLike l] <- what ]
+
+      let maybeFileName = headMay [ l | ListVal [StringLike "file-name:", StringLike l] <- what ]
+      let maybeTimestamp = HM.lookup hash tsmap
+      case (maybeFileName, maybeTimestamp) of
+        (Just fileName, Just timestamp) -> do
+          let isTombSet = or [ True | TombLikeOpt <- what ]
+          let fullPath = location </> fileName
+
+          if isTombSet then
+            [makeTomb timestamp fullPath (Just tree)]
+          else
+            [DirEntry (EntryDesc File timestamp (Just tree)) fullPath]
+
+        _ ->
+          []
+
 -- NOTE: getStateFromDir
 --  что бы устранить противоречия в "удалённом" стейте и
 --  локальном, мы должны о них узнать

miscellaneous/hfuse/.gitignore

@@ -0,0 +1,11 @@
+dist
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+.virtualenv
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+cabal.config

miscellaneous/hfuse/CHANGELOG.md

@@ -0,0 +1,19 @@
+Changelog
+=========
+
+v0.2.4.4
+--------
+
+- Fixed handling of exceptions
+
+v0.2.4.3
+--------
+
+- Added documentation
+- Added HelloFS example
+
+v0.2.4.2
+--------
+
+- Updated dependencies to run on latest base
+- Updated cabal for FreeBSD support

miscellaneous/hfuse/CONTRIBUTORS

@@ -0,0 +1,3 @@
+* dsouza <dsouza+hfuse at bitforest.org>
+* m15k <montezf at gmail>
+* Ongy

miscellaneous/hfuse/LICENSE

@@ -0,0 +1,26 @@
+Copyright (c) Jérémy Bobbio
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the University nor the names of its contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.

miscellaneous/hfuse/README.md

@@ -0,0 +1,107 @@
+# Haskell FUSE API
+
+Filesystem in Userspace ("FUSE") makes it possible to implement a filesystem as a userspace program.
+
+This library is the Haskell binding to this library.
+
+## License
+
+[BSD 3-Clause](./LICENSE)
+
+## Information
+
+- Programs using HFuse should be compiled with -threaded.
+- This now works for base 4.6+
+- Added build options support for FreeBSD (contribution by https://github.com/pesco)
+- MacFUSE should also work (https://github.com/mwotton/hfuse)
+- [OSXFuse](https://osxfuse.github.io/) also works (https://github.com/edyu/hfuse)
+
+## Installation
+
+All of the usual methods for installation will be supported.
+For Mac OS X, you must install [OSXFuse](https://osxfuse.github.io/) first.
+
+**Installation via Hackage**
+
+```
+cabal install hfuse
+```
+
+**Installation for development**
+
+Can either be handled via [Hackage](https://hackage.haskell.org/packages/search?terms=hfuse)
+
+```
+cabal unpack hfuse
+cd HFuse-0.2.5.0
+cabal sandbox init
+cabal install --only-dependencies
+cabal install -fdeveloper
+```
+
+Or the library can be installed via Github [repo][2]
+
+```
+git clone git://github.com/m15k/hfuse
+cd hfuse
+cabal sandbox init
+cabal install --only-dependencies
+cabal install -fdeveloper
+```
+
+**NOTE!**
+
+* To use the sandboxes feature in Cabal your version must be higher than 1.18. *highly recommended*
+
+## Development
+
+To get a feel for HFuse, there are a number of example applications.  They can be built by supplying the `-fdeveloper` [configuration flag][3] to Cabal.
+
+> git clone https://github.com/m15k/hfuse
+
+## Examples
+
+[HelloFS](./examples/HelloFS.hs) is as basic as you get.  Haskell version of the canonical [example](https://github.com/libfuse/libfuse/blob/master/example/hello.c) from the FUSE project.  Once compiled here is how you run HelloFS.
+
+```
+$ mkdir ~/fuseTest
+$ ./HelloFS ~/fuseTest
+```
+
+This creates a file in the *fuseTest* directory.  Now to test the application.
+
+```
+$ cat ~/fuseTest/hello
+Hello World, HFuse!
+```
+
+To unmount issue the following command:
+
+```
+$ fusermount -u ~/fuseTest
+```
+
+## Other Samples
+
+There are other projects on hackage which use HFuse as a dependency.  Check [these](https://packdeps.haskellers.com/reverse/HFuse) out for a possibly richer experience than what is included with the [examples](./examples) folder.
+
+If you lack for inspiration the FUSE [Wiki][4] have amassed quite the list of links to downstream projects.
+
+## Contributions
+
+Help is always welcome.  Pull requests are appreciated.
+
+If you run into any problems or bugs, please report the issue on [Github][1]
+
+## RoadMap
+
+I would like to create the following examples:
+
+- MemoryFS.hs := In-memory file system
+- VBoxFS.hs := Mount VirtualBox disks as filesystem
+- SSHFS.hs := SSH file system
+
+[1]: https://github.com/m15k/google-drive-api/issues  "Google-Drive-API Library Issues"
+[2]: https://github.com/m15k/google-drive-api  "Google-Drive-API Library"
+[3]: https://www.haskell.org/cabal/users-guide/developing-packages.html#configurations  "Cabal Configurations"
+[4]: https://github.com/libfuse/libfuse/wiki/Filesystems  "Libfuse-Wiki Examples"

miscellaneous/hfuse/Setup.lhs

@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain

miscellaneous/hfuse/examples/HelloFS.hs

@@ -0,0 +1,113 @@
+module Main where
+
+import qualified Data.ByteString.Char8 as B
+import Foreign.C.Error
+import System.Posix.Types
+import System.Posix.Files
+import System.Posix.IO
+
+import System.Fuse
+
+type HT = ()
+
+main :: IO ()
+main = fuseMain helloFSOps defaultExceptionHandler
+
+helloFSOps :: FuseOperations HT
+helloFSOps = defaultFuseOps { fuseGetFileStat = helloGetFileStat
+                            , fuseOpen        = helloOpen
+                            , fuseRead        = helloRead 
+                            , fuseOpenDirectory = helloOpenDirectory
+                            , fuseReadDirectory = helloReadDirectory
+                            , fuseGetFileSystemStats = helloGetFileSystemStats
+                            }
+helloString :: B.ByteString
+helloString = B.pack "Hello World, HFuse!\n"
+
+helloPath :: FilePath
+helloPath = "/hello"
+dirStat ctx = FileStat { statEntryType = Directory
+                       , statFileMode = foldr1 unionFileModes
+                                          [ ownerReadMode
+                                          , ownerExecuteMode
+                                          , groupReadMode
+                                          , groupExecuteMode
+                                          , otherReadMode
+                                          , otherExecuteMode
+                                          ]
+                       , statLinkCount = 2
+                       , statFileOwner = fuseCtxUserID ctx
+                       , statFileGroup = fuseCtxGroupID ctx
+                       , statSpecialDeviceID = 0
+                       , statFileSize = 4096
+                       , statBlocks = 1
+                       , statAccessTime = 0
+                       , statModificationTime = 0
+                       , statStatusChangeTime = 0
+                       }
+
+fileStat ctx = FileStat { statEntryType = RegularFile
+                        , statFileMode = foldr1 unionFileModes
+                                           [ ownerReadMode
+                                           , groupReadMode
+                                           , otherReadMode
+                                           ]
+                        , statLinkCount = 1
+                        , statFileOwner = fuseCtxUserID ctx
+                        , statFileGroup = fuseCtxGroupID ctx
+                        , statSpecialDeviceID = 0
+                        , statFileSize = fromIntegral $ B.length helloString
+                        , statBlocks = 1
+                        , statAccessTime = 0
+                        , statModificationTime = 0
+                        , statStatusChangeTime = 0
+                        }
+
+helloGetFileStat :: FilePath -> IO (Either Errno FileStat)
+helloGetFileStat "/" = do
+    ctx <- getFuseContext
+    return $ Right $ dirStat ctx
+helloGetFileStat path | path == helloPath = do
+    ctx <- getFuseContext
+    return $ Right $ fileStat ctx
+helloGetFileStat _ =
+    return $ Left eNOENT
+
+helloOpenDirectory "/" = return eOK
+helloOpenDirectory _   = return eNOENT
+
+helloReadDirectory :: FilePath -> IO (Either Errno [(FilePath, FileStat)])
+helloReadDirectory "/" = do
+    ctx <- getFuseContext
+    return $ Right [(".",          dirStat  ctx)
+                   ,("..",         dirStat  ctx)
+                   ,(helloName,    fileStat ctx)
+                   ]
+    where (_:helloName) = helloPath
+helloReadDirectory _ = return (Left (eNOENT))
+
+helloOpen :: FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno HT)
+helloOpen path mode flags
+    | path == helloPath = case mode of
+                            ReadOnly -> return (Right ())
+                            _        -> return (Left eACCES)
+    | otherwise         = return (Left eNOENT)
+
+
+helloRead :: FilePath -> HT -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString)
+helloRead path _ byteCount offset
+    | path == helloPath =
+        return $ Right $ B.take (fromIntegral byteCount) $ B.drop (fromIntegral offset) helloString
+    | otherwise         = return $ Left eNOENT
+
+helloGetFileSystemStats :: String -> IO (Either Errno FileSystemStats)
+helloGetFileSystemStats str =
+  return $ Right $ FileSystemStats
+    { fsStatBlockSize = 512
+    , fsStatBlockCount = 1
+    , fsStatBlocksFree = 1
+    , fsStatBlocksAvailable = 1
+    , fsStatFileCount = 5
+    , fsStatFilesFree = 10
+    , fsStatMaxNameLength = 255
+    }

miscellaneous/hfuse/hfuse.cabal

@@ -0,0 +1,52 @@
+Name:                   hfuse
+Version:                0.2.5.1
+License:                BSD3
+License-File:           LICENSE
+Author:                 Jeremy Bobbio
+Maintainer:             Montez Fitzpatrick <montezf@gmail.com>
+Synopsis:               HFuse is a binding for the Linux FUSE library.
+Description:            Bindings for the FUSE library, compatible with Linux, OSXFUSE and FreeBSD.
+Homepage:               https://github.com/m15k/hfuse
+Category:               System
+Stability:              Experimental
+Cabal-Version:          >= 1.10
+Build-Type:             Simple
+Extra-source-files:
+        CHANGELOG.md
+        README.md
+
+flag developer
+  default: False
+
+Library
+  Build-Depends:          base >= 4 && < 5, unix, bytestring
+  Exposed-Modules:        System.Fuse
+  Default-Extensions:             ForeignFunctionInterface ScopedTypeVariables EmptyDataDecls
+  Includes:               dirent.h, fuse.h, fcntl.h
+  Include-Dirs:           /usr/include, /usr/local/include, .
+  if os(darwin)
+      CC-Options:           "-DMACFUSE"
+      CC-Options:           "-DFUSE_USE_VERSION=26"
+      Include-Dirs:         /usr/local/include/fuse
+  else
+      if os(freebsd)
+         Includes:           sys/param.h, sys/mount.h
+         CC-Options:           "-Df_namelen=f_namemax"
+         CC-Options:           "-DFUSE_USE_VERSION=26"
+      else
+         Includes:               sys/statfs.h
+  Extra-Libraries:        fuse
+  Extra-Lib-Dirs:         /usr/local/lib
+  CC-Options:             "-D_FILE_OFFSET_BITS=64"
+  Default-Language:       Haskell2010
+
+executable HelloFS
+  if flag(developer)
+    buildable: True
+    build-depends:  base >= 4 && < 5, hfuse, unix, bytestring
+  else
+    buildable: False
+  main-is: HelloFS.hs
+  hs-source-dirs: examples
+  ghc-options: -threaded
+  Default-Language: Haskell2010