From 33de595b9fcfc2b59ddcf12bea05243ef96c3f86 Mon Sep 17 00:00:00 2001 From: Saku Laesvuori Date: Wed, 21 Feb 2024 14:06:20 +0200 Subject: [PATCH] Remove OwnProfileR --- frontend/src/Datarekisteri/Frontend/Handlers.hs | 2 +- .../Datarekisteri/Frontend/Handlers/Profile.hs | 16 +++++----------- .../Frontend/Handlers/VerifyEmail.hs | 5 ++++- frontend/src/Datarekisteri/Frontend/Types.hs | 6 +++--- 4 files changed, 13 insertions(+), 16 deletions(-) diff --git a/frontend/src/Datarekisteri/Frontend/Handlers.hs b/frontend/src/Datarekisteri/Frontend/Handlers.hs index 3421762..f0e2b26 100644 --- a/frontend/src/Datarekisteri/Frontend/Handlers.hs +++ b/frontend/src/Datarekisteri/Frontend/Handlers.hs @@ -30,4 +30,4 @@ import Datarekisteri.Frontend.Handlers.Members import Datarekisteri.Frontend.Types getHomeR :: Handler Html -getHomeR = ifM (isJust <$> maybeAuthId) (redirect OwnProfileR) (redirect $ AuthR LoginR) +getHomeR = maybeAuthId >>= maybe (redirect $ AuthR LoginR) (redirect . ProfileR . userID) diff --git a/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs b/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs index 505572b..5132e45 100644 --- a/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs +++ b/frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs @@ -26,7 +26,7 @@ import Datarekisteri.Frontend.FormFields import Datarekisteri.Frontend.Widgets declareLocalTypesInline "schema.gql" [raw| -query ProfilePage($id: UserID) { +query ProfilePage($id: UserID!) { user(id: $id) { id name @@ -119,8 +119,8 @@ profile user (profileWidget, profileEnctype) (passwordWidget, passwordEnctype) = ^{form route passwordEnctype passwordFormContent} |] -getProfile :: (Maybe UserID) -> Handler Html -getProfile userID = do +getProfileR :: UserID -> Handler Html +getProfileR userID = do ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = userID}) passwordForm <- liftHandler $ generateFormPost passwordForm profileForm <- liftHandler $ generateFormPost $ @@ -130,15 +130,9 @@ getProfile userID = do fromJust = fromMaybe $ error "Tried to access the profile of an inexistent user" -getOwnProfileR :: Handler Html -getOwnProfileR = getProfile Nothing - -getProfileR :: UserID -> Handler Html -getProfileR = getProfile . Just - postProfileR :: UserID -> Handler Html postProfileR userID = do - ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID}) + ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = userID}) ((result, widget), enctype) <- runFormPost $ profileForm (fromJust user) case result of FormSuccess update -> apiRequest @UpdateProfile True update >> redirect (ProfileR userID) @@ -154,7 +148,7 @@ postUpdatePasswordR userID = do FormSuccess new -> apiRequest @UpdatePassword True (UpdatePasswordArgs {password = new, user = Just userID}) >> redirect (ProfileR userID) _ -> do - ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID}) + ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = userID}) profileForm <- liftHandler $ generateFormPost $ profileForm (fromJust user) defaultLayout $ profile (fromJust user) profileForm (widget, enctype) --- XXX fromJust explodes if the user no longer exists diff --git a/frontend/src/Datarekisteri/Frontend/Handlers/VerifyEmail.hs b/frontend/src/Datarekisteri/Frontend/Handlers/VerifyEmail.hs index ca4a302..0086f07 100644 --- a/frontend/src/Datarekisteri/Frontend/Handlers/VerifyEmail.hs +++ b/frontend/src/Datarekisteri/Frontend/Handlers/VerifyEmail.hs @@ -40,7 +40,10 @@ postVerifyEmailR = do FormSuccess verify -> do success <- apiRequest @VerifyEmail False verify case success of - VerifyEmail True -> setMessage "Sähköpostiosoite vahvistettu" >> redirect OwnProfileR + VerifyEmail True -> do + setMessage "Sähköpostiosoite vahvistettu" + user <- userID <$> requireAuthId + redirect $ ProfileR user VerifyEmail False -> setMessage "Virheellinen vahvistuskoodi" >> redirect VerifyEmailR _ -> defaultLayout $ verifyEmailW (widget, enctype) diff --git a/frontend/src/Datarekisteri/Frontend/Types.hs b/frontend/src/Datarekisteri/Frontend/Types.hs index 0687f91..19b9d64 100644 --- a/frontend/src/Datarekisteri/Frontend/Types.hs +++ b/frontend/src/Datarekisteri/Frontend/Types.hs @@ -54,7 +54,6 @@ instance PathPiece UserID where mkYesodData "DataIdClient" [parseRoutes| / HomeR GET -/profile OwnProfileR GET /profile/#UserID ProfileR GET POST /update-password/#UserID UpdatePasswordR POST /verify-email VerifyEmailR GET POST @@ -152,7 +151,6 @@ instance Yesod DataIdClient where isAuthorized HomeR _ = pure Authorized isAuthorized ApplyR _ = pure Authorized isAuthorized VerifyEmailR _ = pure Authorized - isAuthorized OwnProfileR isWrite = withAuthenticated $ \UserToken {..} -> isAuthorized (ProfileR userID) isWrite isAuthorized (ProfileR user) isWrite = withAuthenticated $ const $ authorizedHelper (Profile user) isWrite isAuthorized (UpdatePasswordR user) isWrite = withAuthenticated $ const $ authorizedHelper (Profile user) isWrite @@ -204,8 +202,10 @@ instance Yesod DataIdClient where |] navigationBar :: Widget navigationBar = do + maybeUser <- fmap userID <$> maybeAuthId applicationsRoute <- handlerToWidget $ maybeAuthorized ApplicationsR False - profileRoute <- handlerToWidget $ maybeAuthorized OwnProfileR False + profileRoute <- handlerToWidget $ maybe (pure Nothing) + (\user -> maybeAuthorized (ProfileR user) False) maybeUser membersRoute <- handlerToWidget $ maybeAuthorized MembersR False currentRoute <- getCurrentRoute loggedIn <- isJust <$> maybeAuthId