diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 06916dd81..4406bcbd7 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 0c8086373..5ee656d7d 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/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 diff --git a/routes b/routes index 675f15ed4..c9ee0f6ba 100644 --- a/routes +++ b/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 diff --git a/src/Audit.hs b/src/Audit.hs index c6b7c7dfd..b6b8012a0 100644 --- a/src/Audit.hs +++ b/src/Audit.hs @@ -17,6 +17,7 @@ import Model import Database.Persist.Sql import Audit.Types +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Utils.Lens @@ -110,4 +111,4 @@ audit transaction@(toJSON -> transactionLogInfo) = do insert_ TransactionLog{..} - $logInfoS "Audit" $ tshow (transaction, transactionLogInitiator, transactionLogRemote) <> "\n" <> pack (prettyCallStack callStack) + $logInfoS "Audit" $ Text.filter (/= '\n') $ tshow (transaction, transactionLogInitiator, transactionLogRemote) <> " - " <> pack (prettyCallStack callStack) diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 61889afd1..ca3bf3e1b 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -444,6 +444,14 @@ defNavLink navLabel navRoute = NavLink {..} navQuick' = mempty navForceActive = False +defNavLinkModal :: (RenderMessage UniWorX msg, HasRoute UniWorX route) => msg -> route -> NavLink +defNavLinkModal navLabel navRoute = NavLink {..} + where + navAccess' = NavAccessTrue + navType = NavTypeLink { navModal = True} + navQuick' = mempty + navForceActive = False + navBaseRoute :: NavLink -> Route UniWorX navBaseRoute NavLink{navRoute} = urlRoute navRoute @@ -1194,6 +1202,14 @@ pageActions (AdminUserR cID) = return } , navChildren = [] } + , NavPageActionPrimary + { navLink = defNavLink MsgMenuUserEdit $ ForProfileR cID + , navChildren = [] + } + , NavPageActionPrimary + { navLink = defNavLinkModal MsgUserHijack $ AdminHijackUserR cID + , navChildren = [] + } ] pageActions InfoR = return [ NavPageActionPrimary diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index bd1762c95..5c2acdd0a 100644 --- a/src/Handler/Profile.hs +++ b/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 diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 92f9c4803..23ca1e78d 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -413,13 +413,25 @@ hijackUser uid = do User{userIdent} <- runDB $ get404 uid setCredsRedirect $ Creds apDummy (CI.original userIdent) [] +getAdminHijackUserR :: CryptoUUIDUser -> Handler Html +getAdminHijackUserR cID = do + (hijackWgt, hijackEnctype) <- generateFormPost hijackUserForm + let hjForm = wrapForm hijackWgt def{ formSubmit = FormNoSubmit, formEncoding = hijackEnctype, formAction = Just . SomeRoute $ AdminHijackUserR cID } + uid :: UserId <- decrypt cID + usr <- runDB $ get404 uid + siteLayoutMsg MsgUserHijack $ do + setTitleI MsgUserHijack + [whamlet| + ^{userWidget usr} + ^{hjForm} + |] + postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent -postAdminHijackUserR cID = do - uid <- decrypt cID +postAdminHijackUserR cID = do ((hijackRes, _), _) <- runFormPost hijackUserForm - + $logWarnS "HIJACK" $ "Form Result is: " <> tshow hijackRes + uid <- decrypt cID ret <- formResultMaybe hijackRes $ \() -> Just <$> hijackUser uid - maybe (redirect UsersR) return ret diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index e832af3dc..6c2df7340 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -142,7 +142,7 @@ maxLmsUserIdentRetries = 27 randomText :: MonadIO m => String -> Int -> m Text randomText extra n = fmap pack . evalRandTIO . replicateM n $ uniform range where - num_letters = ['2'..'9'] ++ ['a'..'k'] ++ ['m'..'z'] -- users have trouble distinguishing 1/l and 0/O so we eliminate these + num_letters = ['2'..'9'] ++ ['a'..'h'] ++ ['j','k'] ++ ['m'..'z'] -- users have trouble distinguishing 1/l and 0/O so we eliminate these; apc has trouble distinguishing i/j range = extra ++ num_letters --TODO: consider using package elocrypt for user-friendly passwords here, licence requires mentioning of author, etc. though