module Network.Salvia.Handler.FileSystem
( hFileSystem
, hFileSystemNoIndexes
, hFileTypeDispatcher
)
where
import Control.Category
import Control.Monad.State
import Data.Record.Label
import Network.Protocol.Http
import Network.Protocol.Uri
import Network.Salvia.Interface
import Network.Salvia.Handler.Directory
import Network.Salvia.Handler.Error
import Network.Salvia.Handler.File
import Prelude hiding ((.), id)
import System.Directory
hFileTypeDispatcher
:: (MonadIO m, HttpM' m, SendM m)
=> (FilePath -> m ())
-> (FilePath -> m ())
-> FilePath
-> m ()
hFileTypeDispatcher hdir hfile dir =
do p <- request $ getM (path . asUri)
hJailedDispatch dir hdir hfile (dir /+ p)
hFileSystem
:: (MonadIO m, HttpM' m, SendM m)
=> FilePath
-> m ()
hFileSystem = hFileTypeDispatcher hDirectoryResource hFileResource
hFileSystemNoIndexes
:: (MonadIO m, HttpM' m, SendM m)
=> FilePath
-> m ()
hFileSystemNoIndexes = hFileTypeDispatcher (const $ hError Forbidden) hFileResource
hJailedDispatch
:: (MonadIO m, HttpM' m, SendM m)
=> FilePath -> (FilePath -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
hJailedDispatch dir hdir hfile file =
do case jail dir file of
Nothing -> hError Forbidden
Just f -> (\b -> (if b then hdir else hfile) file)
=<< liftIO (doesDirectoryExist f)