From 1276ffe020f9f826e02b7a338a5f79fe25d55d23 Mon Sep 17 00:00:00 2001
From: Saku Laesvuori <saku@laesvuori.fi>
Date: Tue, 31 Oct 2023 18:19:16 +0200
Subject: [PATCH] Always fetch user data for profileForm

---
 .../Frontend/Handlers/Profile.hs              | 44 ++++++++-----------
 1 file changed, 18 insertions(+), 26 deletions(-)

diff --git a/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs b/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs
index fb9e8b4..3d7c2ff 100644
--- a/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs
+++ b/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs
@@ -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