FileSystem.hs

module Network.Salvia.Handlers.FileSystem (
    hFileSystem
  , hFileSystemNoIndexes
  , hFileTypeDispatcher
  ) where

import Control.Monad.State
import Data.Record.Label
import Misc.Misc (bool)
import Network.Protocol.Http
import Network.Protocol.Uri (jail, path)
import Network.Salvia.Handlers.Directory
import Network.Salvia.Handlers.Error
import Network.Salvia.Handlers.File
import Network.Salvia.Httpd
import System.Directory (doesDirectoryExist)

-- Show file contents and show directory indexes.
hFileSystem :: ResourceHandler ()
hFileSystem dir = hFileTypeDispatcher dir hDirectoryResource hFileResource

-- Show file contents, do not show directory indexes.
hFileSystemNoIndexes :: ResourceHandler ()
hFileSystemNoIndexes dir = hFileTypeDispatcher dir (const $ hError Forbidden) hFileResource

-- Dispatch based on file type, regular files or directories.
hFileTypeDispatcher :: FilePath -> ResourceHandler () -> ResourceHandler () -> Handler () 
hFileTypeDispatcher dir hdir hfile =
  getM (path % uri % request) >>=
  hJailedDispatch dir hdir hfile . (dir ++)

hJailedDispatch :: FilePath -> ResourceHandler () -> ResourceHandler () -> ResourceHandler () 
hJailedDispatch dir hdir hfile file = do
  case jail dir file of
    Nothing -> hError Forbidden
    Just f  -> bool (hdir file) (hfile file)
           =<< lift (doesDirectoryExist f)