Status.hs

{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Application.Classic.Status (getStatusInfo) where

import Control.Arrow
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Lazy.Char8 ()
import qualified Data.StaticHash as M
import Network.HTTP.Types
import Network.Wai.Application.Classic.MaybeIter
import Network.Wai.Application.Classic.Types
import Network.Wai.Application.Classic.Utils

----------------------------------------------------------------

getStatusInfo :: ClassicAppSpec -> FileAppSpec -> [Lang] -> Status -> IO StatusInfo
getStatusInfo cspec spec langs st = runAny [
    getStatusFile getF dir code langs
  , return (getStatusBS code)
  , return (Just StatusNone)
  ]
  where
    dir = statusFileDir cspec
    getF = getFileInfo spec
    code = statusCode st

----------------------------------------------------------------

statusList :: [Status]
statusList = [
    statusNotAllowed  -- 405 File
  , statusNotFound    -- 404 File
  , statusServerError -- 500 CGI
  , statusBadGateway  -- 502 RevProxy
  ]

----------------------------------------------------------------

statusBSMap :: M.StaticHash Int StatusInfo
statusBSMap = M.fromList $ map (statusCode &&& toRspBody) statusList
  where
    toRspBody s = StatusByteString $ BL.fromChunks [statusMessage s, "\r\n"]

getStatusBS :: Int -> Maybe StatusInfo
getStatusBS code = M.lookup code statusBSMap

----------------------------------------------------------------

statusFileMap :: M.StaticHash Int Path
statusFileMap = M.fromList $ map (statusCode &&& toPath) statusList
  where
    toPath s = fromString $ show (statusCode s) ++ ".html"

getStatusFile :: (Path -> IO (Maybe FileInfo)) -> Path -> Int -> [Lang] -> IO (Maybe StatusInfo)
getStatusFile getF dir code langs = try mfiles
  where
    mfiles = case M.lookup code statusFileMap of
        Nothing   -> []
        Just file -> map ($ (dir </> file)) langs
    try [] = return Nothing
    try (f:fs) = do
        mfi <- getF f
        case mfi of
            Nothing -> try fs
            Just fi -> return . Just $ StatusFile f (fileInfoSize fi)

----------------------------------------------------------------