{-# 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 :: ByteString -> ByteString -> Response
ok ByteString
contentType ByteString
body =
  Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 [(HeaderName
hContentType, ByteString
contentType)] ByteString
body

-- | Helper to make responses with content-type \"text/html\"
mkHtmlResponse :: Status -> [Header] -> L8.ByteString -> Response
mkHtmlResponse :: Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
stat ResponseHeaders
hdrs =
  Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
stat ((HeaderName
hContentType, String -> ByteString
S8.pack String
"text/html")forall a. a -> [a] -> [a]
:ResponseHeaders
hdrs)

-- | Creates a 200 (OK) 'Response' with content-type \"text/html\" and the
-- given resposne body
okHtml :: L8.ByteString -> Response
okHtml :: ByteString -> Response
okHtml ByteString
body =
  Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status200 [] ByteString
body

-- | Creates a 200 (OK) 'Response' with content-type \"application/json\" and the
-- given resposne body
okJson :: L8.ByteString -> Response
okJson :: ByteString -> Response
okJson = ByteString -> ByteString -> Response
ok (String -> ByteString
S8.pack String
"application/json")

-- | Creates a 200 (OK) 'Response' with content-type \"application/xml\" and the
-- given resposne body
okXml :: L8.ByteString -> Response
okXml :: ByteString -> Response
okXml = ByteString -> ByteString -> Response
ok (String -> ByteString
S8.pack String
"application/xml")

-- | Given a URL returns a 301 (Moved Permanently) 'Response' redirecting to
-- that URL.
movedTo :: String -> Response
movedTo :: String -> Response
movedTo String
url = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status301 [(HeaderName
hLocation, String -> ByteString
S8.pack String
url)] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              String
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\
              \<HTML><HEAD>\n\
              \<TITLE>301 Moved Permanently</TITLE>\n\
              \</HEAD><BODY>\n\
              \<H1>Moved Permanently</H1>\n\
              \<P>The document has moved <A HREF=\""
             , String -> ByteString
L8.pack String
url
             , String -> ByteString
L8.pack String
"\">here</A>\n\
                       \</BODY></HTML>\n"]

-- | Given a URL returns a 303 (See Other) 'Response' redirecting to that URL.
redirectTo :: S8.ByteString -> Response
redirectTo :: ByteString -> Response
redirectTo ByteString
url = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status303 [(HeaderName
hLocation, ByteString
url)] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              String
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\
              \<HTML><HEAD>\n\
              \<TITLE>303 See Other</TITLE>\n\
              \</HEAD><BODY>\n\
              \<H1>See Other</H1>\n\
              \<P>The document has moved <A HREF=\""
             , [ByteString] -> ByteString
L8.fromChunks [ByteString
url]
             , String -> ByteString
L8.pack String
"\">here</A>\n\
                       \</BODY></HTML>\n"]

-- | Returns a 400 (Bad Request) 'Response'.
badRequest :: Response
badRequest :: Response
badRequest = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status400 [] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              String
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\
              \<HTML><HEAD>\n\
              \<TITLE>400 Bad Request</TITLE>\n\
              \</HEAD><BODY>\n\
              \<H1>Bad Request</H1>\n\
              \<P>Your request could not be understood.</P>\n\
                       \</BODY></HTML>\n"]

-- | Returns a 401 (Authorization Required) 'Response' requiring basic
-- authentication in the given realm.
requireBasicAuth :: String -> Response
requireBasicAuth :: String -> Response
requireBasicAuth String
realm = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status401
  [(HeaderName
"WWW-Authenticate", [ByteString] -> ByteString
S8.concat [ByteString
"Basic realm=", String -> ByteString
S8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ String
realm])] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              String
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\
              \<HTML><HEAD>\n\
              \<TITLE>401 Authorization Required</TITLE>\n\
              \</HEAD><BODY>\n\
              \<H1>Authorization Required</H1>\n\
                       \</BODY></HTML>\n"]

-- | Returns a 403 (Forbidden) 'Response'.
forbidden :: Response
forbidden :: Response
forbidden = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status403 [] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              String
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\
              \<HTML><HEAD>\n\
              \<TITLE>403 Forbidden</TITLE>\n\
              \</HEAD><BODY>\n\
              \<H1>Forbidden</H1>\n\
              \<P>You don't have permission to access this page.</P>\n\
                       \</BODY></HTML>\n"]

-- | Returns a 404 (Not Found) 'Response'.
notFound :: Response
notFound :: Response
notFound = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status404 [] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              String
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\
              \<HTML><HEAD>\n\
              \<TITLE>404 Not Found</TITLE>\n\
              \</HEAD><BODY>\n\
              \<H1>Not Found</H1>\n\
              \<P>The requested URL was not found on this server.</P>\n\
                       \</BODY></HTML>\n"]

-- | Returns a 500 (Server Error) 'Response'.
serverError :: L8.ByteString -> Response
serverError :: ByteString -> Response
serverError ByteString
message = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status500 [] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              String
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\
              \<HTML><HEAD>\n\
              \<TITLE>500 Internal Server Error</TITLE>\n\
              \</HEAD><BODY>\n\
              \<H1>Internal Server Error</H1>\n\
              \<P>", ByteString
message,
              ByteString
"</P></BODY></HTML>\n"]