more explicit routing of user enpoints
This commit is contained in:
parent
488c72ff09
commit
0216209c56
4 changed files with 43 additions and 33 deletions
23
src/API.hs
23
src/API.hs
|
|
@ -32,18 +32,19 @@ type UserAPI =
|
|||
Header "Cookie" T.Text :> (Get '[HTML] UserSelectPage
|
||||
:<|> "user" :> Capture "id" Int :> QueryParam "refine" MT.ProductRefine
|
||||
:> Get '[HTML] UserOverviewPage
|
||||
:<|> "user" :> Capture "id" Int :> "manage" :> Get '[HTML] UserManagePage
|
||||
:<|> "user" :> Capture "id" Int :> "manage"
|
||||
:> ReqBody '[FormUrlEncoded] MT.UserDetailsSubmit
|
||||
:> Post '[HTML] UserManagePage
|
||||
:<|> "user" :> Capture "id" Int :> "manage" :> "authcreate"
|
||||
:> ReqBody '[FormUrlEncoded] AuthSubmitReturn
|
||||
:> Post '[HTML] UserManagePage
|
||||
:<|> "user" :> Capture "id" Int :> "manage" :> "authdelete"
|
||||
:> ReqBody '[FormUrlEncoded] AuthDetailId
|
||||
:> Post '[HTML] UserManagePage
|
||||
:<|> "user" :> "create" :> Get '[HTML] UserNewPage
|
||||
:<|> "user" :> "create" :> ReqBody '[FormUrlEncoded] MT.UserSubmit
|
||||
:> Post '[HTML] UserSelectPage
|
||||
:<|> "user" :> "manage" :> Get '[HTML] UserManagePage
|
||||
:<|> "user" :> "manage" :> ReqBody '[FormUrlEncoded] MT.UserDetailsSubmit
|
||||
:> Post '[HTML] UserManagePage
|
||||
:<|> "user" :> "manage" :> "authcreate"
|
||||
:> ReqBody '[FormUrlEncoded] AuthSubmitReturn
|
||||
:> Post '[HTML] UserManagePage
|
||||
:<|> "user" :> "manage" :> "authdelete"
|
||||
:> ReqBody '[FormUrlEncoded] AuthDetailId
|
||||
:> Post '[HTML] UserManagePage
|
||||
:<|> "auth"
|
||||
:> QueryParam "destination" T.Text
|
||||
:> Get '[HTML]
|
||||
|
|
@ -62,12 +63,12 @@ type UserAPI =
|
|||
|
||||
( userSelectLink :<|>
|
||||
userOverviewLink :<|>
|
||||
userNewLink :<|>
|
||||
userNewPostLink :<|>
|
||||
userManageLink :<|>
|
||||
userManageDetailsSubmitLink :<|>
|
||||
userManageAuthCreateLink :<|>
|
||||
userManageAuthDeleteLink :<|>
|
||||
userNewLink :<|>
|
||||
userNewPostLink :<|>
|
||||
authLink :<|>
|
||||
authPostLink :<|>
|
||||
authLogoutLink
|
||||
|
|
|
|||
|
|
@ -134,8 +134,9 @@ userOverviewControl mcookie uid mRefine = do
|
|||
|
||||
userManageControl
|
||||
:: Maybe T.Text
|
||||
-> Int
|
||||
-> UserHandler UserManagePage
|
||||
userManageControl mcookie = do
|
||||
userManageControl mcookie uid = do
|
||||
(ReadState l10n backend _) <- ask
|
||||
let loc = Locale
|
||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||
|
|
@ -154,13 +155,17 @@ userManageControl mcookie = do
|
|||
backend
|
||||
case (eUserDetails, eAuthOverviews) of
|
||||
(Right userDetails, Right authOverviews) ->
|
||||
return $ userManagePage l10n loc userDetails authOverviews
|
||||
if Just uid == fmap read mAuthUser
|
||||
then
|
||||
return $ userManagePage l10n loc userDetails authOverviews
|
||||
else
|
||||
redirectOverAuth (Just uid) (Just $ userManageLink uid) Nothing
|
||||
err -> handleErrors
|
||||
(fmap read mAuthUser)
|
||||
(Just userManageLink)
|
||||
(Just uid)
|
||||
(Just $ userManageLink uid)
|
||||
[leftToMaybe (fst err), leftToMaybe (snd err)]
|
||||
|
||||
userManageDetailsSubmitControl mcookie uds = do
|
||||
userManageDetailsSubmitControl mcookie uid uds = do
|
||||
(ReadState l10n backend _) <- ask
|
||||
let loc = Locale
|
||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||
|
|
@ -173,11 +178,11 @@ userManageDetailsSubmitControl mcookie uds = do
|
|||
(userUpdate (mkAuthenticatedRequest token authenticateReq) uds)
|
||||
backend
|
||||
case eReturn of
|
||||
Right _ -> throwError $ redirect303 userManageLink
|
||||
Right _ -> throwError $ redirect303 (userManageLink uid)
|
||||
Left err ->
|
||||
handleErrors (fmap read mAuthUser) (Just userManageLink) [Just err]
|
||||
handleErrors (fmap read mAuthUser) (Just $ userManageLink uid) [Just err]
|
||||
|
||||
userManageAuthCreateControl mcookie (AuthSubmitReturn comment pass method) = do
|
||||
userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) = do
|
||||
(ReadState l10n backend _) <- ask
|
||||
let loc = Locale
|
||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||
|
|
@ -194,11 +199,11 @@ userManageAuthCreateControl mcookie (AuthSubmitReturn comment pass method) = do
|
|||
)
|
||||
backend
|
||||
case eReturn of
|
||||
Right _ -> throwError $ redirect303 userManageLink
|
||||
Right _ -> throwError $ redirect303 $ userManageLink uid
|
||||
Left err ->
|
||||
handleErrors (fmap read mAuthUser) (Just userManageLink) [Just err]
|
||||
handleErrors (fmap read mAuthUser) (Just $ userManageLink uid) [Just err]
|
||||
|
||||
userManageAuthDeleteControl mcookie (AuthDetailId adid) = do
|
||||
userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
|
||||
(ReadState l10n backend _) <- ask
|
||||
let loc = Locale
|
||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||
|
|
@ -211,12 +216,12 @@ userManageAuthDeleteControl mcookie (AuthDetailId adid) = do
|
|||
(authManageDeleteAuth (mkAuthenticatedRequest token authenticateReq) adid)
|
||||
backend
|
||||
case eReturn of
|
||||
Right _ -> throwError $ redirect303 userManageLink
|
||||
Right _ -> throwError $ redirect303 $ userManageLink uid
|
||||
Left err -> case err of
|
||||
FailureResponse _ resp ->
|
||||
if statusCode (responseStatusCode resp) == 406
|
||||
then
|
||||
throwError $ redirect303 userManageLink
|
||||
throwError $ redirect303 $ userManageLink uid
|
||||
else
|
||||
handleErrors (fmap read mAuthUser) Nothing [Just err]
|
||||
_ -> handleErrors (fmap read mAuthUser) (Just userSelectLink) [Just err]
|
||||
|
|
|
|||
|
|
@ -45,12 +45,12 @@ userApp initState = serveWithContext userApi (EmptyContext) $
|
|||
(`runReaderT` initState)
|
||||
(\mcookie -> userSelectControl mcookie
|
||||
:<|> userOverviewControl mcookie
|
||||
:<|> userNewControl mcookie
|
||||
:<|> userNewPostControl mcookie
|
||||
:<|> userManageControl mcookie
|
||||
:<|> userManageDetailsSubmitControl mcookie
|
||||
:<|> userManageAuthCreateControl mcookie
|
||||
:<|> userManageAuthDeleteControl mcookie
|
||||
:<|> userNewControl mcookie
|
||||
:<|> userNewPostControl mcookie
|
||||
:<|> authControl mcookie
|
||||
:<|> authPostControl mcookie
|
||||
:<|> authLogoutControl mcookie
|
||||
|
|
|
|||
|
|
@ -77,11 +77,11 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
|
|||
$ H.toHtml $ translate "Logout"
|
||||
case method of
|
||||
MT.PrimaryPass ->
|
||||
userSettingsPointer l10n locale
|
||||
userSettingsPointer l10n locale (MT.userDetailsId ud)
|
||||
MT.SecondaryPass ->
|
||||
productList pos
|
||||
MT.ChallengeResponse -> do
|
||||
userSettingsPointer l10n locale
|
||||
userSettingsPointer l10n locale (MT.userDetailsId ud)
|
||||
productList pos
|
||||
where
|
||||
translate = localize l10n locale . gettext
|
||||
|
|
@ -89,9 +89,10 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
|
|||
userSettingsPointer
|
||||
:: L10n
|
||||
-> Locale
|
||||
-> Int
|
||||
-> H.Html
|
||||
userSettingsPointer l10n locale =
|
||||
H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userManageLink)) $
|
||||
userSettingsPointer l10n locale uid =
|
||||
H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userManageLink uid)) $
|
||||
H.toHtml $ translate "Manage user settings"
|
||||
where
|
||||
translate = localize l10n locale . gettext
|
||||
|
|
@ -186,7 +187,8 @@ userManagePage l10n locale userDetails authOverviews =
|
|||
H.p $ H.form
|
||||
H.! HA.method "post"
|
||||
H.! HA.action ("/" <>
|
||||
(fromString $ show $ linkURI $ userManageDetailsSubmitLink))
|
||||
(fromString $ show $ linkURI $
|
||||
userManageDetailsSubmitLink (MT.userDetailsId userDetails)))
|
||||
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
|
||||
H.legend $ H.toHtml $ translate "User details"
|
||||
H.div H.! HA.class_ "form-group required" $ do
|
||||
|
|
@ -220,7 +222,8 @@ userManagePage l10n locale userDetails authOverviews =
|
|||
(\(MT.AuthOverview aoid comment method) -> H.form
|
||||
H.! HA.method "post"
|
||||
H.! HA.action ("/" <>
|
||||
(fromString $ show $ linkURI $ userManageAuthDeleteLink))
|
||||
(fromString $ show $ linkURI $
|
||||
userManageAuthDeleteLink (MT.userDetailsId userDetails)))
|
||||
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
|
||||
H.legend $ H.toHtml $ comment <> " - " <> case method of
|
||||
MT.PrimaryPass ->
|
||||
|
|
@ -246,7 +249,8 @@ userManagePage l10n locale userDetails authOverviews =
|
|||
H.form
|
||||
H.! HA.method "post"
|
||||
H.! HA.action ("/" <>
|
||||
(fromString $ show $ linkURI $ userManageAuthCreateLink))
|
||||
(fromString $ show $ linkURI $
|
||||
userManageAuthCreateLink (MT.userDetailsId userDetails)))
|
||||
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
|
||||
H.legend $ H.toHtml $ translate "Authentication details"
|
||||
H.div H.! HA.class_ "form-group required" $ do
|
||||
|
|
|
|||
Loading…
Reference in a new issue