{-# 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 Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Monoid.Unicode
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding 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.Internal
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
             $ mkAbortion Forbidden [] Nothing

         stat ← liftIO $ getFileStatus path
         when (isDirectory stat)
             $ abort
             $ mkAbortion 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 (LBS.readFile path) ≫= putChunks

-- |@'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
-- 'Network.HTTP.Lucu.Resource.Tree.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
      }

-- TODO: implement directory listing.
handleStaticDir ∷ Bool → FilePath → Resource ()
handleStaticDir sendContent basePath
    = do extraPath ← getPathInfo
         securityCheck extraPath
         let path = basePath </> joinPath (map dec8 extraPath)
         handleStaticFile sendContent path
    where
      dec8 ∷ ByteString → String
      dec8 = T.unpack ∘ T.decodeUtf8

securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
securityCheck pathElems
    = when (any (≡ "..") pathElems)
          $ fail ("security error: " ⧺ show pathElems)