Skip to content

Commit

Permalink
attempt at adding onError to auth typeclass
Browse files Browse the repository at this point in the history
  • Loading branch information
jprider63 committed Dec 20, 2013
1 parent 9dc16da commit e17523b
Showing 1 changed file with 11 additions and 5 deletions.
16 changes: 11 additions & 5 deletions yesod-auth/Yesod/Auth.hs
Original file line number Diff line number Diff line change
Expand Up @@ -165,6 +165,16 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
=> HandlerT master IO (Maybe (AuthId master))
maybeAuthId = defaultMaybeAuthId

-- | Called on login error for HTTP requests. By default, calls
-- @setMessage
onError :: (MonadResourceBase m) => Route master -> Text -> HandlerT master m Html
onError dest msg = do
setMessage $ toHtml msg
fmap asHtml $ redirect dest
where
asHtml :: Html -> Html
asHtml = id

-- | Internal session key used to hold the authentication information.
--
-- Since 1.2.3
Expand Down Expand Up @@ -241,13 +251,9 @@ loginErrorMessage dest msg =
sendResponseStatus unauthorized401 =<< (
selectRep $ do
provideRep $ do
setMessage $ toHtml msg
fmap asHtml $ redirect dest
onError dest msg
provideJsonMessage msg
)
where
asHtml :: Html -> Html
asHtml = id

provideJsonMessage :: Monad m => Text -> Writer.Writer (Endo [ProvidedRep m]) ()
provideJsonMessage msg = provideRep $ return $ object ["message" .= msg]
Expand Down

0 comments on commit e17523b

Please sign in to comment.