Error.hs

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

import Control.Monad.State
import Data.Record.Label
import Network.Protocol.Http
import Network.Salvia.Httpd
import System.IO.Error

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

hError :: Status -> Handler ()
hError e = hCustomError e
  (concat ["[", show (codeFromStatus e), "] ", show e, "\n"])

{- | Like `hError` but with a custom error message. -}

hCustomError :: Status -> String -> Handler ()
hCustomError e m = do
  enterM response $ do
    setM status e
    setM contentLength (Just $ length m)
    setM contentType ("text/plain", Nothing)
  sendStr m

{- |
Map an `IOError` to a default style error response.

The mapping from an IO error to an error response is rather straightforward:

>  | isDoesNotExistError e = hError NotFound
>  | isAlreadyInUseError e = hError ServiceUnavailable
>  | isPermissionError   e = hError Forbidden
>  | True                  = hError InternalServerError
-}

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