fix redirectson errors

This commit is contained in:
nek0 2019-10-14 21:41:28 +02:00
parent 2854aa0021
commit 5cab55fe9e
2 changed files with 18 additions and 12 deletions

View File

@ -99,12 +99,12 @@ userOverviewControl mcookie uid mRefine = do
Just method ->
return $ userOverviewPage l10n loc (toEnum $ read method) ud prods
Nothing ->
redirectOverAuth (Just uid) mRefine
redirectOverAuth (Just uid) Nothing mRefine
(Left uerr, Right _) -> case uerr of
FailureResponse _ resp ->
if statusCode (responseStatusCode resp) == 401
then
redirectOverAuth (Just uid) mRefine
redirectOverAuth (Just uid) Nothing mRefine
else
throwError $ err500
{ errBody = fromString (show uerr)
@ -147,6 +147,7 @@ userManageControl mcookie = do
return $ userManagePage l10n loc userDetails authOverviews
err -> handleErrors
(fmap read mAuthUser)
(Just userManageLink)
[leftToMaybe (fst err), leftToMaybe (snd err)]
userManageDetailsSubmitControl mcookie uds = do
@ -163,7 +164,8 @@ userManageDetailsSubmitControl mcookie uds = do
backend
case eReturn of
Right _ -> throwError $ redirect303 userManageLink
Left err -> handleErrors (fmap read mAuthUser) [Just err]
Left err ->
handleErrors (fmap read mAuthUser) (Just userManageLink) [Just err]
userManageAuthCreateControl mcookie (AuthSubmitReturn comment pass method) = do
(ReadState l10n backend _) <- ask
@ -183,7 +185,8 @@ userManageAuthCreateControl mcookie (AuthSubmitReturn comment pass method) = do
backend
case eReturn of
Right _ -> throwError $ redirect303 userManageLink
Left err -> handleErrors (fmap read mAuthUser) [Just err]
Left err ->
handleErrors (fmap read mAuthUser) (Just userManageLink) [Just err]
userManageAuthDeleteControl mcookie (AuthDetailId adid) = do
(ReadState l10n backend _) <- ask
@ -205,5 +208,5 @@ userManageAuthDeleteControl mcookie (AuthDetailId adid) = do
then
throwError $ redirect303 userManageLink
else
handleErrors (fmap read mAuthUser) [Just err]
_ -> handleErrors (fmap read mAuthUser) [Just err]
handleErrors (fmap read mAuthUser) Nothing [Just err]
_ -> handleErrors (fmap read mAuthUser) (Just userSelectLink) [Just err]

View File

@ -72,9 +72,10 @@ parseCookieText = map
handleErrors
:: (Traversable t, Show (t (Maybe ClientError)))
=> Maybe Int
-> Maybe Link
-> t (Maybe ClientError)
-> UserHandler UserOverviewPage
handleErrors mAuthUser merrs = do
handleErrors mAuthUser mLink merrs = do
codes <- mapM
(\eerr -> case eerr of
Just (FailureResponse _ resp) ->
@ -89,7 +90,7 @@ handleErrors mAuthUser merrs = do
merrs
if (any (== 401) codes)
then
redirectOverAuth mAuthUser Nothing
redirectOverAuth mAuthUser mLink Nothing
else
throwError $ err500
{ errBody = fromString (show merrs)
@ -97,14 +98,16 @@ handleErrors mAuthUser merrs = do
redirectOverAuth
:: Maybe Int
-> Maybe Link
-> Maybe (MT.ProductRefine)
-> UserHandler UserOverviewPage
redirectOverAuth muid mRefine = do
redirectOverAuth muid mLink mRefine = do
let redirectHeaders = errHeaders $
redirect303 (authLink (Just $ "/" <>
fromString (show $ linkURI (case muid of
Just uid -> userOverviewLink uid mRefine
Nothing -> userSelectLink
fromString (show $ linkURI (case (mLink, muid) of
(Just link, _) -> link
(Nothing, Just uid) -> userOverviewLink uid Nothing
_ -> userSelectLink
))))
throwError
(err303