{-# LANGUAGE Trustworthy #-} {-# LANGUAGE OverloadedStrings #-} -- | This module defines some convenience functions for creating responses. module Web.Simple.Responses ( ok, okHtml, okJson, okXml , movedTo, redirectTo , badRequest, requireBasicAuth, forbidden , notFound , serverError ) where import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy.Char8 as L8 import Network.HTTP.Types import Network.Wai -- | Type alias for 'S8.ByteString' type ContentType = S8.ByteString -- | Creates a 200 (OK) 'Response' with the given content-type and resposne -- body ok :: ContentType -> L8.ByteString -> Response ok contentType body = responseLBS status200 [(hContentType, contentType)] body -- | Helper to make responses with content-type \"text/html\" mkHtmlResponse :: Status -> [Header] -> L8.ByteString -> Response mkHtmlResponse stat hdrs = responseLBS stat ((hContentType, S8.pack "text/html"):hdrs) -- | Creates a 200 (OK) 'Response' with content-type \"text/html\" and the -- given resposne body okHtml :: L8.ByteString -> Response okHtml body = mkHtmlResponse status200 [] body -- | Creates a 200 (OK) 'Response' with content-type \"application/json\" and the -- given resposne body okJson :: L8.ByteString -> Response okJson = ok (S8.pack "application/json") -- | Creates a 200 (OK) 'Response' with content-type \"application/xml\" and the -- given resposne body okXml :: L8.ByteString -> Response okXml = ok (S8.pack "application/xml") -- | Given a URL returns a 301 (Moved Permanently) 'Response' redirecting to -- that URL. movedTo :: String -> Response movedTo url = mkHtmlResponse status301 [(hLocation, S8.pack url)] html where html = L8.concat [L8.pack "\n\ \\n\ \301 Moved Permanently\n\ \\n\ \

Moved Permanently

\n\ \

The document has moved here\n\ \\n"] -- | Given a URL returns a 303 (See Other) 'Response' redirecting to that URL. redirectTo :: S8.ByteString -> Response redirectTo url = mkHtmlResponse status303 [(hLocation, url)] html where html = L8.concat [L8.pack "\n\ \\n\ \303 See Other\n\ \\n\ \

See Other

\n\ \

The document has moved here\n\ \\n"] -- | Returns a 400 (Bad Request) 'Response'. badRequest :: Response badRequest = mkHtmlResponse status400 [] html where html = L8.concat [L8.pack "\n\ \\n\ \400 Bad Request\n\ \\n\ \

Bad Request

\n\ \

Your request could not be understood.

\n\ \\n"] -- | Returns a 401 (Authorization Required) 'Response' requiring basic -- authentication in the given realm. requireBasicAuth :: String -> Response requireBasicAuth realm = mkHtmlResponse status401 [("WWW-Authenticate", S8.concat ["Basic realm=", S8.pack . show $ realm])] html where html = L8.concat [L8.pack "\n\ \\n\ \401 Authorization Required\n\ \\n\ \

Authorization Required

\n\ \\n"] -- | Returns a 403 (Forbidden) 'Response'. forbidden :: Response forbidden = mkHtmlResponse status403 [] html where html = L8.concat [L8.pack "\n\ \\n\ \403 Forbidden\n\ \\n\ \

Forbidden

\n\ \

You don't have permission to access this page.

\n\ \\n"] -- | Returns a 404 (Not Found) 'Response'. notFound :: Response notFound = mkHtmlResponse status404 [] html where html = L8.concat [L8.pack "\n\ \\n\ \404 Not Found\n\ \\n\ \

Not Found

\n\ \

The requested URL was not found on this server.

\n\ \\n"] -- | Returns a 500 (Server Error) 'Response'. serverError :: L8.ByteString -> Response serverError message = mkHtmlResponse status500 [] html where html = L8.concat [L8.pack "\n\ \\n\ \500 Internal Server Error\n\ \\n\ \

Internal Server Error

\n\ \

", message, "

\n"]