Remove OwnProfileR

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)

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
+getProfileR :: UserID -> Handler Html
-getProfile userID = do
+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

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)
 

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