content: {-|
  Module: IHP.ErrorController
  Description:  Provides web-based error screens for runtime errors in IHP
  Copyright: (c) digitally induced GmbH, 2020
  -}
  module IHP.ErrorController
  ( displayException
  , handleNoResponseReturned
  , handleRouterException
  ) where
  
  import IHP.Prelude hiding (displayException)
  import qualified IHP.Controller.Param as Param
  import qualified IHP.Router.Types as Router
  import qualified Network.HTTP.Types.Method as Router
  import qualified Control.Exception as Exception
  import qualified Data.Text as Text
  import IHP.Controller.RequestContext
  import Network.HTTP.Types (status500, status400)
  import Network.Wai
  import Network.HTTP.Types.Header
  
  import qualified Text.Blaze.Html5            as H
  import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
  import qualified Database.PostgreSQL.Simple as PG
  import qualified Data.ByteString.Char8 as ByteString
  
  import IHP.HSX.QQ (hsx)
  import qualified IHP.ModelSupport as ModelSupport
  import IHP.FrameworkConfig
  import qualified IHP.Environment as Environment
  import IHP.Controller.Context
  import IHP.ApplicationContext
  import IHP.Controller.NotFound (handleNotFound)
  import qualified IHP.Log as Log
  
  handleNoResponseReturned :: (Show controller, ?context :: ControllerContext) => controller -> IO ResponseReceived
  handleNoResponseReturned controller = do
      let codeSample :: Text = "render MyView { .. }"
      let errorMessage = [hsx|
              <h2>Possible Solutions</h2>
              <p>You can fix this by calling '{codeSample}' at the end of your action.</p>
  
              <h2>Details</h2>
              <p style="font-size: 16px">No response was returned while running the action {tshow controller}</p>
  
          |]
      let title = [hsx|No response returned in {tshow controller}|]
      let RequestContext { respond } = ?context.requestContext
      respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
  
  displayException :: (Show action, ?context :: ControllerContext, ?applicationContext :: ApplicationContext, ?requestContext :: RequestContext) => SomeException -> action -> Text -> IO ResponseReceived
  displayException exception action additionalInfo = do
      -- Dev handlers display helpful tips on how to resolve the problem
      let devHandlers =
              [ postgresHandler
              , paramNotFoundExceptionHandler
              , patternMatchFailureHandler
              , recordNotFoundExceptionHandlerDev
              ]
  
      -- Prod handlers should not leak any information about the system
      let prodHandlers =
              [ recordNotFoundExceptionHandlerProd
              ]
  
      let allHandlers = if ?context.frameworkConfig.environment == Environment.Development
              then devHandlers
              else prodHandlers
  
      let supportingHandlers = allHandlers |> mapMaybe (\f -> f exception action additionalInfo)
  
      let displayGenericError = genericHandler exception action additionalInfo
  
  
      -- Additionally to rendering the error message to the browser we also send it
      -- to the error tracking service (e.g. sentry). Usually this service also writes
      -- the error message to the stderr output
      --
      when (?context.frameworkConfig.environment == Environment.Production) do
          let exceptionTracker = ?applicationContext.frameworkConfig.exceptionTracker.onException
          let request = ?requestContext.request
  
  
          exceptionTracker (Just request) exception
  
      supportingHandlers
          |> head
          |> fromMaybe displayGenericError
  
  -- | Responds to all exceptions with a generic error message.
  --
  -- In dev mode the action and exception is added to the output.
  -- In production mode nothing is specific is communicated about the exception
  genericHandler :: (Show controller, ?context :: ControllerContext) => Exception.SomeException -> controller -> Text -> IO ResponseReceived
  genericHandler exception controller additionalInfo = do
      let errorMessageText = "An exception was raised while running the action " <> tshow controller <> additionalInfo
      let errorMessageTitle = Exception.displayException exception
  
      let devErrorMessage = [hsx|{errorMessageText}|]
      let devTitle = [hsx|{errorMessageTitle}|]
  
      Log.error (errorMessageText <> ": " <> cs errorMessageTitle)
  
      let prodErrorMessage = [hsx|An exception was raised while running the action|]
      let prodTitle = [hsx|An error happened|]
  
      let (errorMessage, errorTitle) = if ?context.frameworkConfig.environment == Environment.Development
              then (devErrorMessage, devTitle)
              else (prodErrorMessage, prodTitle)
      let RequestContext { respond } = ?context.requestContext
  
      respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError errorTitle errorMessage))
  
  postgresHandler :: (Show controller, ?context :: ControllerContext) => SomeException -> controller -> Text -> Maybe (IO ResponseReceived)
  postgresHandler exception controller additionalInfo = do
      let
          handlePostgresOutdatedError :: Show exception => exception -> H.Html -> IO ResponseReceived
          handlePostgresOutdatedError exception errorText = do
              let ihpIdeBaseUrl = ?context.frameworkConfig.ideBaseUrl
              let title = [hsx|Database looks outdated. {errorText}|]
              let errorMessage = [hsx|
                          <h2>Possible Solutions</h2>
                          <div style="margin-bottom: 2rem; font-weight: 400;">
                              Have you clicked on
                              <form method="POST" action={ihpIdeBaseUrl <> "/NewMigration"} target="_blank" style="display: inline">
                                  <button type="submit">Migrate DB</button>
                              </form>
                              after updating the Schema?
                          </div>
  
                          <h2>Details</h2>
                          <p style="font-size: 16px">The exception was raised while running the action: {tshow controller}{additionalInfo}</p>
                          <p style="font-family: monospace; font-size: 16px">{tshow exception}</p>
                      |]
              let RequestContext { respond } = ?context.requestContext
              respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
  
          handleSqlError :: ModelSupport.EnhancedSqlError -> IO ResponseReceived
          handleSqlError exception = do
              let ihpIdeBaseUrl = ?context.frameworkConfig.ideBaseUrl
              let sqlError = exception.sqlError
              let title = [hsx|{sqlError.sqlErrorMsg}|]
              let errorMessage = [hsx|
                          <h2>While running the following Query:</h2>
                          <div style="margin-bottom: 2rem; font-weight: 400;">
                              <code>{exception.sqlErrorQuery}</code>
                          </div>
  
                          <h2>With Query Parameters:</h2>
                          <div style="margin-bottom: 2rem; font-weight: 400;">
                              <code>{exception.sqlErrorQueryParams}</code>
                          </div>
  
                          <h2>Details:</h2>
                          <p style="font-size: 16px">The exception was raised while running the action: {tshow controller}{additionalInfo}</p>
                          <p style="font-family: monospace; font-size: 16px">{tshow exception}</p>
                      |]
              let RequestContext { respond } = ?context.requestContext
              respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
      case fromException exception of
          Just (exception :: PG.ResultError) -> Just (handlePostgresOutdatedError exception "The database result does not match the expected type.")
          Nothing -> case fromException exception of
              -- Catching  `relation "..." does not exist`
              Just exception@ModelSupport.EnhancedSqlError { sqlError }
                  |  "relation" `ByteString.isPrefixOf` (sqlError.sqlErrorMsg)
                  && "does not exist" `ByteString.isSuffixOf` (sqlError.sqlErrorMsg)
                  -> Just (handlePostgresOutdatedError exception "A table is missing.")
  
              -- Catching  `columns "..." does not exist`
              Just exception@ModelSupport.EnhancedSqlError { sqlError }
                  |  "column" `ByteString.isPrefixOf` (sqlError.sqlErrorMsg)
                  && "does not exist" `ByteString.isSuffixOf` (sqlError.sqlErrorMsg)
                  -> Just (handlePostgresOutdatedError exception "A column is missing.")
              -- Catching other SQL Errors
              Just exception -> Just (handleSqlError exception)
              Nothing -> Nothing
  
  patternMatchFailureHandler :: (Show controller, ?context :: ControllerContext) => SomeException -> controller -> Text -> Maybe (IO ResponseReceived)
  patternMatchFailureHandler exception controller additionalInfo = do
      case fromException exception of
          Just (exception :: Exception.PatternMatchFail) -> Just do
              let (controllerPath, _) = Text.breakOn ":" (tshow exception)
              let errorMessage = [hsx|
                      <h2>Possible Solutions</h2>
                      <p>a) Maybe the action function is missing for {tshow controller}? You can fix this by adding an action handler like this to the controller '{controllerPath}':</p>
                      <pre>{codeSample}</pre>
                      <p style="margin-bottom: 2rem">b) A pattern match like 'let (Just value) = ...' failed. Please see the details section.</p>
  
                      <h2>Details</h2>
                      <p style="font-size: 16px">{exception}</p>
                  |]
                      where
                          codeSample = "    action (" <> tshow controller <> ") = do\n        renderPlain \"Hello World\""
  
              let title = [hsx|Pattern match failed while executing {tshow controller}|]
              let RequestContext { respond } = ?context.requestContext
              respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
          Nothing -> Nothing
  
  -- Handler for 'IHP.Controller.Param.ParamNotFoundException'
  paramNotFoundExceptionHandler :: (Show controller, ?context :: ControllerContext) => SomeException -> controller -> Text -> Maybe (IO ResponseReceived)
  paramNotFoundExceptionHandler exception controller additionalInfo = do
      case fromException exception of
          Just (exception@(Param.ParamNotFoundException paramName)) -> Just do
              let (controllerPath, _) = Text.breakOn ":" (tshow exception)
  
              let renderParam (paramName, paramValue) = [hsx|<li>{paramName}: {paramValue}</li>|]
              let solutionHint =
                      if isEmpty Param.allParams
                          then [hsx|
                                  This action was called without any parameters at all.
                                  You can pass this parameter by appending <code>?{paramName}=someValue</code> to the URL.
                              |]
                          else [hsx|
                              <p>The following parameters are provided by the request:</p>
                              <ul>{forEach Param.allParams renderParam}</ul>
  
                              <p>a) Is there a typo in your call to <code>param {tshow paramName}</code>?</p>
                              <p>b) You can pass this parameter by appending <code>&{paramName}=someValue</code> to the URL.</p>
                              <p>c) You can pass this parameter using a form input like <code>{"<input type=\"text\" name=\"" <> paramName <> "\"/>" :: ByteString}</code>.</p>
                          |]
              let errorMessage = [hsx|
                      <h2>
                          This exception was caused by a call to <code>param {tshow paramName}</code> in {tshow controller}.
                      </h2>
                      <p>
                          A request parameter is just a query parameter like <code>/MyAction?someParameter=someValue&secondParameter=1</code>
                          or a form input when the request was submitted from a html form or via ajax.
                      </p>
                      <h2>Possible Solutions:</h2>
                      {solutionHint}
  
                      <h2>Details</h2>
                      <p style="font-size: 16px">{exception}</p>
                  |]
  
  
  
              let title = [hsx|Parameter <q>{paramName}</q> not found in the request|]
              let RequestContext { respond } = ?context.requestContext
              respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
          Just (exception@(Param.ParamCouldNotBeParsedException { name, parserError })) -> Just do
              let (controllerPath, _) = Text.breakOn ":" (tshow exception)
  
              let renderParam (paramName, paramValue) = [hsx|<li>{paramName}: {paramValue}</li>|]
              let errorMessage = [hsx|
                      <h2>
                          This exception was caused by a call to <code>param {tshow name}</code> in {tshow controller}.
                      </h2>
                      <p>
                          Here's the error output from the parser: {parserError}
                      </p>
  
                      <h2>Details</h2>
                      <p style="font-size: 16px">{exception}</p>
                  |]
  
  
  
              let title = [hsx|Parameter <q>{name}</q> was invalid|]
              let RequestContext { respond } = ?context.requestContext
              respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
          Nothing -> Nothing
  
  -- Handler for 'IHP.ModelSupport.RecordNotFoundException'
  --
  -- Used only in development mode of the app.
  recordNotFoundExceptionHandlerDev :: (Show controller, ?context :: ControllerContext) => SomeException -> controller -> Text -> Maybe (IO ResponseReceived)
  recordNotFoundExceptionHandlerDev exception controller additionalInfo =
      case fromException exception of
          Just (exception@(ModelSupport.RecordNotFoundException { queryAndParams = (query, params) })) -> Just do
              let (controllerPath, _) = Text.breakOn ":" (tshow exception)
              let errorMessage = [hsx|
                      <p>
                          The following SQL was executed:
                          <pre class="ihp-error-code">{query}</pre>
                      </p>
                      <p>
                          These query parameters have been used:
                          <pre class="ihp-error-code">{params}</pre>
                      </p>
  
                      <p>
                          This exception was caused by a call to <code>fetchOne</code> in {tshow controller}.
                      </p>
  
                      <h2>Possible Solutions:</h2>
  
                      <p>
                          a) Use <span class="ihp-error-inline-code">fetchOneOrNothing</span>. This will return a <span class="ihp-error-inline-code">Nothing</span>
                          when no results are returned by the database.
                      </p>
  
                      <p>
                          b) Make sure the the data you are querying is actually there.
                      </p>
  
  
                      <h2>Details</h2>
                      <p style="font-size: 16px">{exception}</p>
                  |]
  
  
  
              let title = [hsx|Call to fetchOne failed. No records returned.|]
              let RequestContext { respond } = ?context.requestContext
              respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
          Nothing -> Nothing
  
  -- Handler for 'IHP.ModelSupport.RecordNotFoundException'
  --
  -- Used only in production mode of the app. The exception is handled by calling 'handleNotFound'
  recordNotFoundExceptionHandlerProd :: (?context :: ControllerContext) => SomeException -> controller -> Text -> Maybe (IO ResponseReceived)
  recordNotFoundExceptionHandlerProd exception controller additionalInfo =
      case fromException exception of
          Just (exception@(ModelSupport.RecordNotFoundException {})) ->
              let requestContext = ?context.requestContext
              in
                  let ?context = requestContext
                  in Just (handleNotFound ?context.request ?context.respond)
          Nothing -> Nothing
  
  handleRouterException :: (?applicationContext :: ApplicationContext) => SomeException -> Application
  handleRouterException exception request respond =
      let ?context = ?applicationContext
      in case fromException exception of
          Just Router.NoConstructorMatched { expectedType, value, field } -> do
              let routingError =  if ?context.frameworkConfig.environment == Environment.Development
                  then [hsx|<p>Routing failed with: {tshow exception}</p>|]
                  else ""
  
              let errorMessage = [hsx|
                      { routingError }
  
                      <h2>Possible Solutions</h2>
                      <p>You can pass this parameter by appending <code>&{field}=someValue</code> to the URL.</p>
                  |]
  
              let title = case value of
                      Just value -> [hsx|Expected <strong>{expectedType}</strong> for field <strong>{field}</strong> but got <q>{value}</q>|]
                      Nothing -> [hsx|The action was called without the required <q>{field}</q> parameter|]
              respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
          Just Router.BadType { expectedType, value = Just value, field } -> do
              let errorMessage = [hsx|
                      <p>Routing failed with: {tshow exception}</p>
                  |]
              let title = [hsx|Query parameter <q>{field}</q> needs to be a <q>{expectedType}</q> but got <q>{value}</q>|]
              respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
          _ -> case fromException exception of
              Just Router.UnexpectedMethodException { allowedMethods = [Router.DELETE], method = Router.GET } -> do
                  let exampleLink :: Text = "<a href={DeleteProjectAction} class=\"js-delete\">Delete Project</a>"
                  let formExample :: Text = cs [plain|
  <form method="POST" action={DeleteProjectAction}>
      <input type="hidden" name="_method" value="DELETE"/>
      <button type="submit">Delete Project</button>
  </form>
                  |]
                  let errorMessage = [hsx|
                          <p>
                              You cannot directly link to Delete Action.
                              GET requests should not have any external side effects, as a user could accidentally trigger it by following a normal link.
                          </p>
  
                          <h2>Possible Solutions</h2>
                          <p>
                              a) Add a <code>js-delete</code> class to your link. IHP's helper.js will intercept link clicks on these links and use a form with a DELETE request to submit the request.
                              <br /><br/>
  
                              Example: <br /><br />
                              <code>{exampleLink}</code>
                          </p>
                          <p>
                              b) Use a form to submit the request as a DELETE request:
                              <br /><br/>
  
                              Example: <br />
                              <pre>{formExample}</pre>
                              HTML forms don't support DELETE requests natively, therefore we use the hidden input field to work around this browser limitation.
                          </p>
                      |]
                  let title = [hsx|Action was called from a GET request, but needs to be called as a DELETE request|]
                  respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
              Just Router.UnexpectedMethodException { allowedMethods = [Router.POST], method = Router.GET } -> do
                  let errorMessage = [hsx|
                          <p>
                              You cannot directly link to Create Action.
                              GET requests should not have any external side effects, as a user could accidentally trigger it by following a normal link.
                          </p>
  
                          <h2>Possible Solutions</h2>
                          <p>
                              <a style="text-decoration: none" href="https://ihp.digitallyinduced.com/Guide/form.html" target="_blank">Make a form with <code>formFor</code> to do the request</a>
                          </p>
                      |]
                  let title = [hsx|Action was called from a GET request, but needs to be called as a POST request|]
                  respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
              Just Router.UnexpectedMethodException { allowedMethods, method } -> do
                  let errorMessage = [hsx|
                          <p>Routing failed with: {tshow exception}</p>
                          <h2>Possible Solutions</h2>
                          <p>
                              <a style="text-decoration: none" href="https://ihp.digitallyinduced.com/Guide/form.html" target="_blank">Make a form with <code>formFor</code> to do the request</a>
                          </p>
                      |]
                  let title = [hsx|Action was called with a {method} request, but needs to be called with one of these request methods: <q>{allowedMethods}</q>|]
                  respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
              _ -> do
                  let errorMessage = [hsx|
                          Routing failed with: {tshow exception}
  
                          <h2>Possible Solutions</h2>
                          <p>Are you trying to do a DELETE action, but your link is missing class="js-delete"?</p>
                      |]
                  let title = H.text "Routing failed"
                  respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
  
  
  renderError :: forall context. (?context :: context, ConfigProvider context) => H.Html -> H.Html -> H.Html
  renderError errorTitle view = [hsx|
  <!DOCTYPE html>
  <html lang="en">
      <head>
          <meta charset="utf-8"/>
          <meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
  
          <title>IHP Error</title>
          <style>
              * { -webkit-font-smoothing: antialiased }
              h2 {
                  color: white;
                  font-size: 1.25rem;
              }
              body {
                  margin: 0;
                  font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", "Roboto", "Helvetica Neue", Arial, sans-serif;
              }
  
              body a {
                  color: hsla(196, 13%, 80%, 1);
              }
  
              .ihp-error-other-solutions {
                  margin-top: 2rem;
                  padding-top: 0.5rem;
                  font-size: 1rem;
                  color: hsla(196, 13%, 80%, 1);
                  border-top: 1px solid hsla(196, 13%, 60%, 0.4);
              }
  
              .ihp-error-other-solutions a {
                  color: hsla(196, 13%, 80%, 0.9);
                  text-decoration: none !important;
                  margin-right: 1rem;
                  font-size: 0.8rem;
              }
              .ihp-error-other-solutions a:hover {
                  color: hsla(196, 13%, 80%, 1);
              }
  
              .ihp-error-inline-code, .ihp-error-code {
                  background-color: rgba(0, 43, 54, 0.5);
                  color: white;
                  border-radius: 3px;
              }
  
              .ihp-error-code {
                  padding: 1rem;
                  overflow-x: auto;
              }
  
              .ihp-error-inline-code {
                  padding: 3px;
                  font-family: monospace;
              }
          </style>
      </head>
      <body>
          <div style="background-color: #657b83; padding-top: 2rem; padding-bottom: 2rem; color:hsla(196, 13%, 96%, 1)">
              <div style="max-width: 800px; margin-left: auto; margin-right: auto">
                  <h1 style="margin-bottom: 2rem; font-size: 2rem; font-weight: 500; border-bottom: 1px solid white; padding-bottom: 0.25rem; border-color: hsla(196, 13%, 60%, 1)">{errorTitle}</h1>
                  <div style="margin-top: 1rem; font-size: 1.25rem; color:hsla(196, 13%, 80%, 1)">
                      {view}
                  </div>
  
                  {when shouldShowHelpFooter helpFooter}
              </div>
          </div>
      </body>
  </html>
      |]
          where
              shouldShowHelpFooter = ?context.frameworkConfig.environment == Environment.Development
              helpFooter = [hsx|
                  <div class="ihp-error-other-solutions">
                      <a href="https://stackoverflow.com/questions/tagged/ihp" target="_blank">Ask the IHP Community on StackOverflow</a>
                      <a href="https://github.com/digitallyinduced/ihp/wiki/Troubleshooting" target="_blank">Check the Troubleshooting</a>
                      <a href="https://github.com/digitallyinduced/ihp/issues/new" target="_blank">Open GitHub Issue</a>
                      <a href="https://ihp.digitallyinduced.com/Slack" target="_blank">Slack</a>
                      <a href="https://www.reddit.com/r/IHPFramework/" target="_blank">Reddit</a>
                      <a href="https://stackshare.io/ihp" target="_blank">StackShare</a>
                  </div>
              |]
  