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