ry
/
datarekisteri
6
0
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Always fetch user data for profileForm

This commit is contained in:
Saku Laesvuori 2023-10-31 18:19:16 +02:00
parent 56c15cb7f5
commit 1276ffe020
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
1 changed files with 18 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs
View File

@ -14,7 +14,6 @@ module Datarekisteri.Frontend.Handlers.Profile where
import Relude hiding (id)
import Data.Maybe (fromJust)
import Data.Morpheus.Client (raw, declareLocalTypesInline)
import Yesod hiding (emailField)
@ -62,24 +61,16 @@ mutation UpdatePassword($user: UserID, $password: String!) {
passwordForm :: Form Text
passwordForm = renderDivs $ areq verifiedPasswordField "Uusi salasana" Nothing
profileForm :: (Maybe UserID) -> (Maybe ProfilePageUser) -> Form UpdateProfileArgs
profileForm userID user extraHtml = do
(nameRes, nameView) <- mopt textField "Nimi"
(Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in name) user)
(homeRes, homeView) <- mopt textField "Kotipaikka"
(Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in homeplace) user)
(nicknameRes, nicknameView) <- mopt textField "Kutsumanimi"
(Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in nickname) user)
(emailRes, emailView) <- mopt emailField "Sähköposti"
(maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in email) user)
(phoneNumberRes, phoneNumberView) <- mopt telephoneField "Puhelinnumero"
(Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in phoneNumber) user)
(applicationRes, applicationView) <- mopt textareaField' "Jäsenhakemus"
(Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in application) user)
let profileUpdateRes = UpdateProfileArgs userID <$>
profileForm :: ProfilePageUser -> Form UpdateProfileArgs
profileForm ProfilePageUser {..} extraHtml = do
(nameRes, nameView) <- mopt textField "Nimi" (Just $ Just name)
(homeRes, homeView) <- mopt textField "Kotipaikka" (Just $ Just homeplace)
(nicknameRes, nicknameView) <- mopt textField "Kutsumanimi" (Just $ Just nickname)
(emailRes, emailView) <- mopt emailField "Sähköposti" (Just email)
(phoneNumberRes, phoneNumberView) <- mopt telephoneField "Puhelinnumero" (Just $ Just phoneNumber)
(applicationRes, applicationView) <- mopt textareaField' "Jäsenhakemus" (Just $ Just application)
let profileUpdateRes = UpdateProfileArgs (Just id) <$>
nameRes <*> homeRes <*> nicknameRes <*> emailRes <*> phoneNumberRes <*> applicationRes
maybePendingEmail = user >>= \x -> let ProfilePageUser {..} = x in pendingEmail
canUpdateApplication = maybe False (\x -> let ProfilePageUser {..} = x in not isMember) user
inputField FieldView {..} = [whamlet|
<label for="#{fvId}">
^{fvLabel}
@ -92,12 +83,12 @@ profileForm userID user extraHtml = do
^{inputField nicknameView}
^{inputField phoneNumberView}
^{inputField emailView}
$maybe pendingEmail <- maybePendingEmail
$maybe pending <- pendingEmail
<p>Päivitys osoitteeseen #
<a href="mailto:#{renderEmail pendingEmail}">#{renderEmail pendingEmail}
<a href="mailto:#{renderEmail pending}">#{renderEmail pending}
odottaa vahvistusta. #
<a href="@{VerifyEmailR}">Siirry vahvistamaan
$if canUpdateApplication
$if not isMember
^{inputField applicationView}
|]
return (profileUpdateRes, widget)
@ -127,10 +118,11 @@ getProfile userID = do
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = userID})
passwordForm <- liftHandler $ generateFormPost passwordForm
profileForm <- liftHandler $ generateFormPost $
profileForm ((\x -> let ProfilePageUser {..} = x in id) <$> user) user
profileForm (fromJust user)
defaultLayout $ profile (fromJust user)
profileForm passwordForm
where fromJust = fromMaybe $ error "Tried to access the profile of an inexistent user"
fromJust = fromMaybe $ error "Tried to access the profile of an inexistent user"
getOwnProfileR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
getOwnProfileR = getProfile Nothing
@ -140,12 +132,12 @@ getProfileR = getProfile . Just
postProfileR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => UserID -> Handler Html
postProfileR userID = do
((result, widget), enctype) <- runFormPost $ profileForm (Just userID) Nothing
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID})
((result, widget), enctype) <- runFormPost $ profileForm (fromJust user)
case result of
FormSuccess update -> apiRequest @UpdateProfile True update >> redirect (ProfileR userID)
_ -> do
passwordForm <- liftHandler $ generateFormPost passwordForm
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID})
defaultLayout $ profile (fromJust user) (widget, enctype) passwordForm
--- XXX fromJust explodes if the user no longer exists
@ -156,7 +148,7 @@ postUpdatePasswordR userID = do
FormSuccess new ->
apiRequest @UpdatePassword True (UpdatePasswordArgs {password = new, user = Just userID}) >> redirect (ProfileR userID)
_ -> do
profileForm <- liftHandler $ generateFormPost $ profileForm (Just userID) Nothing
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID})
profileForm <- liftHandler $ generateFormPost $ profileForm (fromJust user)
defaultLayout $ profile (fromJust user) profileForm (widget, enctype)
--- XXX fromJust explodes if the user no longer exists