{-# LANGUAGE QuasiQuotes #-}
-- | Stolen from rack:
-- catches all empty responses the app it wraps and replaces them
-- with a site explaining the error.
-- Additional details can be put into hack.showstatus.detail.
-- and will be shown as HTML. If such details exist, the error page
-- is always rendered, even if the reply was not empty.
--
-- Note: it appears that only when content is empty will this
-- message be shown.
module Hack.Contrib.Middleware.ShowStatus (show_status) where
import Hack
import Hack.Contrib.Utils
import Hack.Contrib.Constants
import Hack.Contrib.Request hiding (body)
import Hack.Contrib.Response
import MPSUTF8
import Prelude hiding ((.), (^), (>), head)
import Data.Maybe
show_status :: Middleware
show_status app = \env -> do
response <- app env
let content_length = response.header _ContentLength .fromMaybe "0"
let content_empty = content_length .read .(<= (0 :: Int))
if response.status >= 400 && content_empty
then
let
i = response.status
message = i.show_status_message .fromMaybe (i.show)
detail = env.custom_"hack.showstatus.detail" .fromMaybe message
result = template message detail env response
size = result.bytesize
in
return $
response
.set_body (result.unescape_unicode_xml.u2b)
.set_content_type _TextHtml
.set_content_length size
else return response
template :: String -> String -> Env -> Response -> String
template message detail env response =
let h = escape_html > escape_unicode_xml in [$here|
#{h message } at #{h (env.path.unescape_uri.b2u) }
#{h message } (#{ response.status })
Request Method:
#{ env.request_method }
Request URL:
#{h (env.url.unescape_uri.b2u) }
#{h detail }
You're seeing this error because you use Hack.Contrib.Middleware.ShowStatus.