Improved error messages when a mandatory AutoRoute request parameter …

…is missing. Fixes #932

IHP/ErrorController.hs

@@ -91,13 +91,11 @@ displayException exception action additionalInfo = do
             , paramNotFoundExceptionHandler
             , patternMatchFailureHandler
             , recordNotFoundExceptionHandlerDev
-            , handleInvalidActionArgumentExceptionDev
             ]
 
     -- Prod handlers should not leak any information about the system
     let prodHandlers =
             [ recordNotFoundExceptionHandlerProd
-            , handleInvalidActionArgumentExceptionProd
             ]
 
     let allHandlers = if fromConfig environment == Environment.Development
@@ -325,43 +323,39 @@ recordNotFoundExceptionHandlerProd exception controller additionalInfo =
         Nothing -> Nothing
 
 handleRouterException :: (?context :: RequestContext) => SomeException -> IO ResponseReceived
-handleRouterException exception = do
-    let errorMessage = [hsx|
-            Routing failed with: {tshow exception}
+handleRouterException exception =
+    case fromException exception of
+        Just Router.NoConstructorMatched { expectedType, value, field } -> do
+            let errorMessage = [hsx|
+                    <p>Routing failed with: {tshow exception}</p>
 
-            <h2>Possible Solutions</h2>
-            <p>Are you using AutoRoute but some of your fields are not UUID? In that case <a href="https://ihp.digitallyinduced.com/Guide/routing.html#parameter-types" target="_blank">please see the documentation on Parameter Types</a></p>
-            <p>Are you trying to do a DELETE action, but your link is missing class="js-delete"?</p>
-        |]
-    let title = H.text "Routing failed"
-    let RequestContext { respond } = ?context
-    respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
+                    <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|]
+            let RequestContext { respond } = ?context
+            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>|]
+            let RequestContext { respond } = ?context
+            respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
 
--- | Renders a helpful error when e.g. an UUID value is expected as an action argument, but something else is given
-handleInvalidActionArgumentExceptionDev :: (?context :: ControllerContext) => SomeException -> controller -> Text -> Maybe (IO ResponseReceived)
-handleInvalidActionArgumentExceptionDev exception controller additionalInfo = do
-    case fromException exception of
-        Just Router.InvalidActionArgumentException { expectedType, value, field } -> do
+        _ -> do
             let errorMessage = [hsx|
                     Routing failed with: {tshow exception}
 
                     <h2>Possible Solutions</h2>
-                    <p>Are you using AutoRoute but some of your fields are not UUID? In that case <a href="https://ihp.digitallyinduced.com/Guide/routing.html#parameter-types" target="_blank">please see the documentation on Parameter Types</a></p>
                     <p>Are you trying to do a DELETE action, but your link is missing class="js-delete"?</p>
                 |]
-            let title = [hsx|Expected <strong>{expectedType}</strong> for field <strong>{field}</strong> but got <q>{value}</q>|]
-            let RequestContext { respond } = get #requestContext ?context
-            Just $ respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
-        Nothing -> Nothing
+            let title = H.text "Routing failed"
+            let RequestContext { respond } = ?context
+            respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
 
-handleInvalidActionArgumentExceptionProd :: (?context :: ControllerContext) => SomeException -> controller -> Text -> Maybe (IO ResponseReceived)
-handleInvalidActionArgumentExceptionProd exception controller additionalInfo = do
-    case fromException exception of
-        Just Router.InvalidActionArgumentException { expectedType, value, field } -> do
-            let title = [hsx|Expected <strong>{expectedType}</strong> for field <strong>{field}</strong>|]
-            let RequestContext { respond } = get #requestContext ?context
-            Just $ respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title mempty))
-        Nothing -> Nothing
 
 renderError :: forall context. (?context :: context, ConfigProvider context) => H.Html -> H.Html -> H.Html
 renderError errorTitle view = H.docTypeHtml ! A.lang "en" $ [hsx|

IHP/Router/Types.hs

@@ -1,21 +1,30 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-|
 Module: IHP.Router.Types
 Copyright: (c) digitally induced GmbH, 2020
 -}
 module IHP.Router.Types where
 
 import IHP.Prelude
+import Control.Exception
 
--- | Thrown when 'IHP.RouterSupport.parseUUIDArgument', 'IHP.RouterSupport.parseIntArgument', etc. get passed an invalid value
---
--- Let's say we have a @ShowProjectAction { id :: Id Project }@.
---
--- When opening @/ShowProject?projectId=ab55d579-80cd-4608-9a8f-c76dea6c2332@ everything is fine.
--- But when opening @/ShowProject?projectId=not-an-uuid@ this exception will be thrown.
-data InvalidActionArgumentException = InvalidActionArgumentException
+data TypedAutoRouteError
+    = BadType
         { expectedType :: !ByteString
-        , value :: !ByteString
+        , value :: !(Maybe ByteString)
         , field :: !ByteString
-        } deriving (Eq, Show)
-
-instance Exception InvalidActionArgumentException
+        }
+    | TooFewArguments
+    | NotMatched
+    -- | Thrown when 'IHP.RouterSupport.parseUUIDArgument', 'IHP.RouterSupport.parseIntArgument', etc. get passed an invalid value
+    --
+    -- Let's say we have a @ShowProjectAction { id :: Id Project }@.
+    --
+    -- When opening @/ShowProject?projectId=ab55d579-80cd-4608-9a8f-c76dea6c2332@ everything is fine.
+    -- But when opening @/ShowProject?projectId=not-an-uuid@ this exception will be thrown.
+    | NoConstructorMatched
+        { expectedType :: !ByteString
+        , value :: !(Maybe ByteString)
+        , field :: !ByteString
+        }
+    deriving (Show, Exception)

IHP/RouterSupport.hs

@@ -117,7 +117,7 @@ parseFuncs parseIdType = [
                     Just Refl -> readMay (cs queryValue :: String)
                         |> \case
                             Just int -> Right int
-                            Nothing -> Left BadType
+                            Nothing -> Left BadType { field = "", value = Just queryValue, expectedType = "Int" }
                     Nothing -> case eqT :: Maybe (d :~: Maybe Int) of
                         Just Refl -> Right $ readMay (cs queryValue :: String)
                         Nothing -> Left NotMatched
@@ -130,7 +130,7 @@ parseFuncs parseIdType = [
                     Just Refl -> readMay (cs queryValue :: String)
                         |> \case
                             Just int -> Right int
-                            Nothing -> Left BadType
+                            Nothing -> Left BadType { field = "", value = Just queryValue, expectedType = "Integer" }
                     Nothing -> case eqT :: Maybe (d :~: Maybe Integer) of
                         Just Refl -> Right $ readMay (cs queryValue :: String)
                         Nothing -> Left NotMatched
@@ -165,7 +165,7 @@ parseFuncs parseIdType = [
                         |> fromASCIIBytes
                         |> \case
                             Just uuid -> uuid |> unsafeCoerce |> Right
-                            Nothing -> Left NotMatched
+                            Nothing -> Left BadType { field = "", value = Just queryValue, expectedType = "UUID" }
                     Nothing -> Left NotMatched
                 Nothing -> Left NotMatched,
 
@@ -212,13 +212,6 @@ querySortedByFields query constructor = constrFields constructor
         |> map cs
         |> map (\field -> (field, join $ List.lookup field query))
 
-data TypedAutoRouteError
-    = BadType
-    | TooFewArguments
-    | NotMatched
-    | NoConstructorMatched
-    deriving (Show)
-
 -- | Given a constructor and a parsed query string, attempt to construct a value of the constructor's type.
 -- For example, given the controller
 --
@@ -235,11 +228,15 @@ applyConstr parseIdType constructor query = let
     -- | Given some query item (key, optional value), try to parse into the current expected type
     -- by iterating through the available parse functions.
     attemptToParseArg :: forall d. (Data d) => (ByteString, Maybe ByteString) -> [Maybe ByteString -> Either TypedAutoRouteError d] -> State.StateT Query (Either TypedAutoRouteError) d
-    attemptToParseArg _ [] = State.lift (Left NoConstructorMatched)
+    attemptToParseArg queryParam@(queryName, queryValue) [] = State.lift (Left NoConstructorMatched
+                { field = queryName
+                , value = queryValue
+                , expectedType = (dataTypeOf (undefined :: d)) |> dataTypeName |> cs
+                })
     attemptToParseArg queryParam@(k, v) (parseFunc:restFuncs) = case parseFunc v of
             Right result -> pure result
             -- BadType will be returned if, for example, a text is passed to a query parameter typed as int.
-            Left BadType -> State.lift (Left BadType)
+            Left badType@BadType{} -> State.lift (Left badType { field = k })
             -- otherwise, safe to assume the match just failed, so recurse on the rest of the functions and try to find one that matches.
             Left _ -> attemptToParseArg queryParam restFuncs
 
@@ -294,15 +291,12 @@ class Data controller => AutoRoute controller where
                             unless (allowedMethods |> includes method) (error ("Invalid method, expected one of: " <> show allowedMethods))
                             pure action
 
-                    action :: Maybe controller
                     action = case applyConstr parseIdFunc constr query of
                         Right parsedAction -> pure parsedAction
-                        Left e -> Nothing
+                        Left e -> Exception.throw e
 
                 in do
-                    parsedAction <- string prefix >> (string actionPath <* endOfInput) *> (case action of
-                        Just a -> pure a
-                        Nothing -> fail "Failed to parse action")
+                    parsedAction <- string prefix >> (string actionPath <* endOfInput) *> action
                     checkRequestMethod parsedAction
 
         in choice (map parseAction allConstructors)