File.hs

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

  , hFileFilter
  , hFileResourceFilter

  , hResource
  , hUri
  ) where

import Control.Monad.State
import Data.Record.Label
import Network.Protocol.Http
import Network.Protocol.Mime
import Network.Protocol.Uri (mimetype, path, parseURI)
import Network.Salvia.Handlers.Error
import Network.Salvia.Httpd
import System.IO

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 = getM (path % uri % request) >>= rh

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

hUri :: UriHandler a -> Handler a
hUri rh = getM (uri % request) >>= rh

-------- 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 . lget path)
  safeIO (openBinaryFile file ReadMode)
    $ \fd -> do
      fs <- lift $ hFileSize fd
      enterM response $ do
        setM contentType (m, Just "utf-8")
        setM contentLength (Just fs)
        setM status 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 . lget path)
  safeIO (openBinaryFile file ReadMode)
    $ \fd -> do
      enterM response $ do
        setM contentType (m, Just "utf-8")
        setM status OK
      spool fFilter fd