Error.hs

module Network.Salvia.Handlers.Error (
    hError
  , hCustomError
  , hIOError
  , safeIO
  ) where

import System.IO.Error

import Control.Monad.State
import Network.Salvia.Httpd
import Network.Protocol.Http

{- |
The 'hError' handler enables the creation of a default style of error responses
for the specified HTTP status code.
-}

hError ::
     Status     -- ^ The HTTP status code.
  -> Handler ()
hError e = hCustomError e
  (concat ["[", show (codeFromStatus e), "] ", show e, "\n"])

hCustomError ::
     Status     -- ^ The HTTP status code.
  -> String     -- ^ Custom error message.
  -> Handler ()
hCustomError e m = do
  modResponse
    $ setStatus e
    . setContentType "text/plain" Nothing
  sendStr m

-- | Map IO errors to a default style error response.
hIOError :: IOError -> Handler ()
hIOError e
  | isDoesNotExistError e = hError NotFound
  | isAlreadyInUseError e = hError ServiceUnavailable
  | isPermissionError   e = hError Forbidden
  | True                  = hError InternalServerError

-- | Execute an handler with the result of an IO action. When the IO actions
-- fails a default error handler will be executed.
safeIO :: IO a -> (a -> Handler ()) -> Handler ()
safeIO io h = lift (try io) >>= either hIOError h