File.hs

module Network.Salvia.Handlers.File (
    hFile
  , hFileResource

  , hFileFilter
  , hFileResourceFilter

  , hResource
  , hUri
  ) where

import Control.Monad.State
import System.IO

import Network.Salvia.Httpd
import Network.Salvia.Handlers.Error
import Network.Protocol.Http
import Network.Protocol.Uri (mimetype, path, parseURI)
import Network.Protocol.Mime

hFile :: Handler ()
hFile = hResource hFileResource

hFileFilter :: (String -> String) -> Handler ()
hFileFilter = hResource . hFileResourceFilter

{-
Turn a resource handler into a regular handler that utilizes the path part
of the request URI as the resource identifier.
-}

hResource :: ResourceHandler a -> Handler a
hResource rh = gets request >>= rh . path . uri

{-
Turn a URI handler into a regular handler that utilizes the request URI as the
resource identifier.
-}

hUri :: UriHandler a -> Handler a
hUri rh = gets request >>= rh . uri

-------- HTTP deamon implementation -------------------------------------------

-- Create a response message containing the file contents.
-- TODO: what to do with encoding?
hFileResource :: ResourceHandler ()
hFileResource file = do
  let m = maybe defaultMime id $ (parseURI file >>= mimetype)
  safeIO (openBinaryFile file ReadMode)
    $ \fd -> do
      fs <- lift $ hFileSize fd
      modResponse
        $ setContentType m (Just "utf-8")
        . setContentLength fs
        . setStatus OK
      spoolBs id fd

-- TODO: what to do with encoding?
hFileResourceFilter :: (String -> String) -> ResourceHandler ()
hFileResourceFilter fFilter file = do  -- TODO... this should be a more general hFilter
  let m = maybe defaultMime id $ (parseURI file >>= mimetype)
  safeIO (openBinaryFile file ReadMode)
    $ \fd -> do
      modResponse
        $ setContentType m (Just "utf-8")
        . setStatus OK
      spool fFilter fd