Fixed some error reporting
This commit is contained in:
parent
0a72e93a61
commit
ab233514e1
@ -28,6 +28,7 @@ module Yesod.Handler
|
|||||||
, redirect
|
, redirect
|
||||||
, notFound
|
, notFound
|
||||||
, permissionDenied
|
, permissionDenied
|
||||||
|
, invalidArgs
|
||||||
-- * Setting headers
|
-- * Setting headers
|
||||||
, addCookie
|
, addCookie
|
||||||
, deleteCookie
|
, deleteCookie
|
||||||
@ -81,8 +82,8 @@ instance Exception e => Failure e (Handler yesod) where
|
|||||||
failure e = Handler $ \_ -> return ([], HCError e)
|
failure e = Handler $ \_ -> return ([], HCError e)
|
||||||
instance MonadRequestReader (Handler yesod) where
|
instance MonadRequestReader (Handler yesod) where
|
||||||
askRawRequest = Handler $ \(rr, _) -> return ([], HCContent rr)
|
askRawRequest = Handler $ \(rr, _) -> return ([], HCContent rr)
|
||||||
invalidParam _pt _pn _pe = error "invalidParam"
|
invalidParam _pt pn pe = invalidArgs [(pn, pe)]
|
||||||
authRequired = error "authRequired"
|
authRequired = permissionDenied
|
||||||
|
|
||||||
getYesod :: Handler yesod yesod
|
getYesod :: Handler yesod yesod
|
||||||
getYesod = Handler $ \(_, yesod) -> return ([], HCContent yesod)
|
getYesod = Handler $ \(_, yesod) -> return ([], HCContent yesod)
|
||||||
@ -210,6 +211,9 @@ notFound = errorResult NotFound
|
|||||||
permissionDenied :: Handler yesod a
|
permissionDenied :: Handler yesod a
|
||||||
permissionDenied = errorResult PermissionDenied
|
permissionDenied = errorResult PermissionDenied
|
||||||
|
|
||||||
|
invalidArgs :: [(ParamName, ParamValue)] -> Handler yesod a
|
||||||
|
invalidArgs = errorResult . InvalidArgs
|
||||||
|
|
||||||
------- Headers
|
------- Headers
|
||||||
-- | Set the cookie on the client.
|
-- | Set the cookie on the client.
|
||||||
addCookie :: Int -- ^ minutes to timeout
|
addCookie :: Int -- ^ minutes to timeout
|
||||||
|
|||||||
43
test/errors.hs
Normal file
43
test/errors.hs
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
import Yesod
|
||||||
|
import Hack
|
||||||
|
import Data.Default
|
||||||
|
import Data.List
|
||||||
|
|
||||||
|
data Errors = Errors
|
||||||
|
instance Yesod Errors where
|
||||||
|
handlers = [$resources|
|
||||||
|
/denied:
|
||||||
|
Get: denied
|
||||||
|
/needs-ident:
|
||||||
|
Get: needsIdent
|
||||||
|
/has-args:
|
||||||
|
Get: hasArgs
|
||||||
|
|]
|
||||||
|
|
||||||
|
denied :: Handler Errors ()
|
||||||
|
denied = permissionDenied
|
||||||
|
|
||||||
|
needsIdent :: Handler Errors HtmlObject
|
||||||
|
needsIdent = do
|
||||||
|
i <- identifier
|
||||||
|
return $ toHtmlObject i
|
||||||
|
|
||||||
|
hasArgs :: Handler Errors HtmlObject
|
||||||
|
hasArgs = do
|
||||||
|
-- FIXME this test needs more work
|
||||||
|
a <- getParam "firstParam"
|
||||||
|
b <- getParam "secondParam"
|
||||||
|
return $ toHtmlObject [a :: String, b]
|
||||||
|
|
||||||
|
main = do
|
||||||
|
let app = toHackApp Errors
|
||||||
|
res <- app $ def { pathInfo = "/denied/" }
|
||||||
|
print res
|
||||||
|
print $ "Permission denied" `isInfixOf` show res
|
||||||
|
res' <- app $ def { pathInfo = "/needs-ident/" }
|
||||||
|
print res'
|
||||||
|
print $ "Permission denied" `isInfixOf` show res'
|
||||||
|
res3 <- app $ def { pathInfo = "/has-args/" }
|
||||||
|
print res3
|
||||||
|
print $ "secondParam" `isInfixOf` show res3
|
||||||
Loading…
Reference in New Issue
Block a user