fix(users): fix #112 and also add some convenience

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -38,6 +38,7 @@ MenuTermShow: Jahr
 MenuSubmissionDelete: Abgabe löschen
 MenuUsers: Benutzer:in
 MenuUserAdd: Benutzer:in anlegen
+MenuUserEdit: Benutzer:in editieren
 MenuUserNotifications: Benachrichtigungs-Einstellungen
 MenuUserPassword: Passwort
 MenuAdminTest: Admin-Demo

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -38,6 +38,7 @@ MenuTermShow: Semesters
 MenuSubmissionDelete: Delete submission
 MenuUsers: User
 MenuUserAdd: Add user
+MenuUserEdit: Edit user
 MenuUserNotifications: Notification settings
 MenuUserPassword: Password
 MenuAdminTest: Admin-demo

routes

@@ -54,7 +54,7 @@
 /users                        UsersR           GET POST       -- no tags, i.e. admins only
 /users/#CryptoUUIDUser        AdminUserR       GET POST
 /users/#CryptoUUIDUser/delete AdminUserDeleteR     POST
-/users/#CryptoUUIDUser/hijack AdminHijackUserR     POST       !adminANDno-escalation
+/users/#CryptoUUIDUser/hijack AdminHijackUserR GET POST       !adminANDno-escalation
 /users/#CryptoUUIDUser/notifications  UserNotificationR           GET POST   !self
 /users/#CryptoUUIDUser/password       UserPasswordR               GET POST   !selfANDis-pw-hash
 !/users/functionary-invite/new        AdminNewFunctionaryInviteR  GET POST

src/Foundation/Navigation.hs

@@ -1192,6 +1192,13 @@ pageActions (AdminUserR cID) = return
       }
     , navChildren = []
     }
+  , NavPageActionPrimary
+    { navLink = defNavLink MsgMenuUserEdit $ ForProfileR cID
+    , navChildren = []
+    }
+  , NavPageActionSecondary
+    { navLink = (defNavLink MsgUserHijack $ AdminHijackUserR cID){ navType = NavTypeLink { navModal = True }}
+    }
   ]
 pageActions InfoR = return
   [ NavPageActionPrimary

src/Handler/Profile.hs

@@ -376,8 +376,9 @@ validateSettings User{..} = do
   let pinBad     = validCmdArgument =<< userPinPassword'
       pinMinChar = 5
       pinLength  = maybe 0 length userPinPassword'
+  pinOk <- if userPrefersPostal' || pinMinChar <= pinLength then pure True else liftHandler $ hasReadAccessTo AdminR -- admins are allowed to ignore pin requirements
   whenIsJust pinBad (tellValidationError . MsgPDFPasswordInvalid) -- used as CMD argument for pdftk
-  guardValidation (MsgPDFPasswordTooShort pinMinChar) $ userPrefersPostal' || pinMinChar <= pinLength
+  guardValidation (MsgPDFPasswordTooShort pinMinChar) pinOk
 
 
 data ButtonResetTokens = BtnResetTokens
@@ -412,6 +413,7 @@ postProfileR = requireAuthPair >>= serveProfileR
 
 serveProfileR :: (UserId, User) -> Handler Html
 serveProfileR (uid, user@User{..}) = do
+  currentRoute <- fromMaybe ProfileR <$> getCurrentRoute
   (userSchools, userExamOfficeLabels) <- runDB $ do
     userSchools <- fmap (setOf $ folded . _Value) . E.select . E.from $ \school -> do
       E.where_ . E.exists . E.from $ \userSchool ->
@@ -513,7 +515,7 @@ serveProfileR (uid, user@User{..}) = do
           , ExamOfficeLabelPriority =. examOfficeLabelPriority
           ]
     addMessageI Success MsgSettingsUpdate
-    redirect $ ProfileR :#: ProfileSettings
+    redirect $ currentRoute :#: ProfileSettings
 
   ((tokenRes, tokenFormWidget), tokenEnctype) <- runFormPost . identifyForm ProfileResetTokens $ buttonForm
 
@@ -521,7 +523,7 @@ serveProfileR (uid, user@User{..}) = do
     now <- liftIO getCurrentTime
     runDB $ update uid [ UserTokensIssuedAfter =. Just now ]
     addMessageI Info MsgTokensResetSuccess
-    redirect $ ProfileR :#: ProfileResetTokens
+    redirect $ currentRoute :#: ProfileResetTokens
 
   tResetTime <- traverse (formatTime SelFormatDateTime) userTokensIssuedAfter
 
@@ -530,7 +532,7 @@ serveProfileR (uid, user@User{..}) = do
     let settingsForm =
           wrapForm formWidget FormSettings
             { formMethod = POST
-            , formAction = Just . SomeRoute $ ProfileR :#: ProfileSettings
+            , formAction = Just . SomeRoute $ currentRoute :#: ProfileSettings
             , formEncoding = formEnctype
             , formAttrs = []
             , formSubmit = FormSubmit
@@ -539,7 +541,7 @@ serveProfileR (uid, user@User{..}) = do
         tokenForm =
           wrapForm tokenFormWidget FormSettings
             { formMethod = POST
-            , formAction = Just . SomeRoute $ ProfileR :#: ProfileResetTokens
+            , formAction = Just . SomeRoute $ currentRoute :#: ProfileResetTokens
             , formEncoding = tokenEnctype
             , formAttrs = []
             , formSubmit = FormNoSubmit

src/Handler/Users.hs

@@ -413,15 +413,22 @@ hijackUser uid = do
   User{userIdent} <- runDB $ get404 uid
   setCredsRedirect $ Creds apDummy (CI.original userIdent) []
 
+getAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent
+getAdminHijackUserR = postAdminHijackUserR
+
 postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent
 postAdminHijackUserR cID = do
   uid <- decrypt cID
-  ((hijackRes, _), _) <- runFormPost hijackUserForm
-
-  ret <- formResultMaybe hijackRes $ \() -> Just <$> hijackUser uid
-
-  maybe (redirect UsersR) return ret
-
+  ((hijackRes, hijackWgt), hijackEnctype) <- runFormPost hijackUserForm
+  case hijackRes of
+    (FormSuccess ()) -> hijackUser uid
+    _ -> selectRep $ do
+          provideRep . siteLayoutMsg MsgUserHijack $ do
+            setTitleI MsgUserHijack
+            let hjForm = wrapForm hijackWgt def{ formEncoding = hijackEnctype }
+            [whamlet|
+              ^{hjForm}
+            |]
 
 data ButtonAuthMode = BtnAuthLDAP | BtnAuthPWHash | BtnPasswordReset
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)