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

-- | Helper to make responses with content-type \"text/html\"
mkHtmlResponse :: Status -> [Header] -> L8.ByteString -> Response
mkHtmlResponse :: Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse stat :: Status
stat hdrs :: ResponseHeaders
hdrs =
  Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
stat ((HeaderName
hContentType, String -> ContentType
S8.pack "text/html")(HeaderName, ContentType) -> ResponseHeaders -> ResponseHeaders
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 body :: 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 = ContentType -> ByteString -> Response
ok (String -> ContentType
S8.pack "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 = ContentType -> ByteString -> Response
ok (String -> ContentType
S8.pack "application/xml")

-- | Given a URL returns a 301 (Moved Permanently) 'Response' redirecting to
-- that URL.
movedTo :: String -> Response
movedTo :: String -> Response
movedTo url :: String
url = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status301 [(HeaderName
hLocation, String -> ContentType
S8.pack String
url)] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              "<!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 "\">here</A>\n\
                       \</BODY></HTML>\n"]

-- | Given a URL returns a 303 (See Other) 'Response' redirecting to that URL.
redirectTo :: S8.ByteString -> Response
redirectTo :: ContentType -> Response
redirectTo url :: ContentType
url = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status303 [(HeaderName
hLocation, ContentType
url)] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              "<!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=\""
             , [ContentType] -> ByteString
L8.fromChunks [ContentType
url]
             , String -> ByteString
L8.pack "\">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
              "<!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 realm :: String
realm = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status401
  [("WWW-Authenticate", [ContentType] -> ContentType
S8.concat ["Basic realm=", String -> ContentType
S8.pack (String -> ContentType)
-> (String -> String) -> String -> ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show (String -> ContentType) -> String -> ContentType
forall a b. (a -> b) -> a -> b
$ String
realm])] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              "<!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
              "<!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
              "<!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 message :: ByteString
message = Status -> ResponseHeaders -> ByteString -> Response
mkHtmlResponse Status
status500 [] ByteString
html
  where html :: ByteString
html = [ByteString] -> ByteString
L8.concat
             [String -> ByteString
L8.pack
              "<!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,
              "</P></BODY></HTML>\n"]