{-# LANGUAGE
    DoAndIfThenElse
  , OverloadedStrings
  , UnicodeSyntax
  #-}
-- | Handling static files on the filesystem.
module Network.HTTP.Lucu.StaticFile
    ( staticFile
    , staticDir

    , generateETagFromFile
    )
    where
import qualified Blaze.ByteString.Builder.ByteString as BB
import qualified Blaze.Text.Int as BT
import Control.Monad
import Control.Monad.Unicode
import Control.Monad.Trans
import qualified Data.Ascii as A
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Monoid.Unicode
import qualified Data.Text as T
import Data.Time.Clock.POSIX
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.ETag
import Network.HTTP.Lucu.MIMEType
import Network.HTTP.Lucu.MIMEType.Guess
import Network.HTTP.Lucu.Resource
import Network.HTTP.Lucu.Resource.Tree
import Network.HTTP.Lucu.Response
import Prelude.Unicode
import System.FilePath
import System.Posix.Files

-- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
-- @fpath@ on the filesystem.
staticFile ∷ FilePath → ResourceDef
staticFile path
    = emptyResource {
        resGet  = Just $ handleStaticFile True  path
      , resHead = Just $ handleStaticFile False path
      }

octetStream ∷ MIMEType
octetStream = mkMIMEType "application" "octet-stream"

handleStaticFile ∷ Bool → FilePath → Resource ()
handleStaticFile sendContent path
    = do exists ← liftIO $ fileExist path
         unless exists
             $ foundNoEntity Nothing

         readable ← liftIO $ fileAccess path True False False
         unless readable
             $ abort Forbidden [] Nothing

         stat ← liftIO $ getFileStatus path
         when (isDirectory stat)
             $ abort Forbidden [] Nothing

         tag  ← liftIO $ generateETagFromFile path
         let lastMod = posixSecondsToUTCTime
                       $ fromRational
                       $ toRational
                       $ modificationTime stat
         foundEntity tag lastMod

         conf ← getConfig
         case guessTypeByFileName (cnfExtToMIMEType conf) path of
           Nothing   → setContentType octetStream
           Just mime → setContentType mime

         when sendContent
             $ liftIO (B.readFile path) ≫= output

-- |@'generateETagFromFile' fpath@ generates a strong entity tag from
-- a file. The file doesn't necessarily have to be a regular file; it
-- may be a FIFO or a device file. The tag is made of inode ID, size
-- and modification time.
--
-- Note that the tag is not strictly strong because the file could be
-- modified twice at a second without changing inode ID or size, but
-- it's not really possible to generate a strictly strong ETag from a
-- file as we don't want to simply grab the entire file and use it as
-- an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
-- increase strictness, but it's too inefficient if the file is really
-- large (say, 1 TiB).
generateETagFromFile ∷ FilePath → IO ETag
generateETagFromFile path
    = do stat ← getFileStatus path
         let inode   = fileID   stat
             size    = fileSize stat
             lastMod = fromEnum $ modificationTime stat
             tag     = A.fromAsciiBuilder
                       $ A.unsafeFromBuilder
                       $ BT.integral inode
                       ⊕ BB.fromByteString "-"
                       ⊕ BT.integral size
                       ⊕ BB.fromByteString "-"
                       ⊕ BT.integral lastMod
         return $ strongETag tag

-- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
-- @dir@ and its subdirectories on the filesystem to the 'ResTree'.
--
-- Note that 'staticDir' currently doesn't have a directory-listing
-- capability. Requesting the content of a directory will end up being
-- replied with /403 Forbidden/.
staticDir ∷ FilePath → ResourceDef
staticDir path
    = emptyResource {
        resIsGreedy = True
      , resGet      = Just $ handleStaticDir True  path
      , resHead     = Just $ handleStaticDir False path
      }

handleStaticDir ∷ Bool → FilePath → Resource ()
handleStaticDir sendContent basePath
    = do extraPath ← getPathInfo
         securityCheck extraPath
         let path = basePath </> joinPath (map T.unpack extraPath)

         handleStaticFile sendContent path
    where
      securityCheck pathElems
          = when (any (≡ "..") pathElems)
                $ fail ("security error: " ⧺ show pathElems)
-- TODO: implement directory listing.