From b4ba0a30dc7c513bb9e3c567ca771d5d75de4343 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 24 Jul 2023 13:40:12 +0000 Subject: [PATCH 1/4] fix(apc): apc cannot distinguish ij from ji, partial fix only. Needs new font --- src/Handler/Utils/LMS.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index 4eeb608fe..f5f91e969 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -141,7 +141,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 From 35096ace01a2bc2a2d666794bb1ff92f52b3edec Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 25 Jul 2023 15:21:28 +0000 Subject: [PATCH 2/4] fix(users): fix #112 and also add some convenience --- .../utils/navigation/menu/de-de-formal.msg | 1 + .../uniworx/utils/navigation/menu/en-eu.msg | 1 + routes | 2 +- src/Foundation/Navigation.hs | 7 +++++++ src/Handler/Profile.hs | 12 +++++++----- src/Handler/Users.hs | 19 +++++++++++++------ 6 files changed, 30 insertions(+), 12 deletions(-) diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index ff8043db6..bd12272a8 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 7dc653c6a..1a7dd4dc0 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 7a80c2012..a0fa1e4ae 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/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 8a4dcbddd..8b74256d6 100644 --- a/src/Foundation/Navigation.hs +++ b/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 diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index a1e0d01ef..e0358449a 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..d697feea6 100644 --- a/src/Handler/Users.hs +++ b/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) From 88bf21c9c5de3755ea6591c97dc1f99a928914d5 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 26 Jul 2023 08:55:12 +0000 Subject: [PATCH 3/4] fix(users): fix #112 working now --- src/Foundation/Navigation.hs | 13 +++++++++++-- src/Handler/Users.hs | 31 ++++++++++++++++++------------- 2 files changed, 29 insertions(+), 15 deletions(-) diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 8b74256d6..9f4ef54bd 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -442,6 +442,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 @@ -1196,8 +1204,9 @@ pageActions (AdminUserR cID) = return { navLink = defNavLink MsgMenuUserEdit $ ForProfileR cID , navChildren = [] } - , NavPageActionSecondary - { navLink = (defNavLink MsgUserHijack $ AdminHijackUserR cID){ navType = NavTypeLink { navModal = True }} + , NavPageActionPrimary + { navLink = defNavLinkModal MsgUserHijack $ AdminHijackUserR cID + , navChildren = [] } ] pageActions InfoR = return diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index d697feea6..23ca1e78d 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -413,22 +413,27 @@ hijackUser uid = do User{userIdent} <- runDB $ get404 uid setCredsRedirect $ Creds apDummy (CI.original userIdent) [] -getAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent -getAdminHijackUserR = postAdminHijackUserR +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 +postAdminHijackUserR cID = do + ((hijackRes, _), _) <- runFormPost hijackUserForm + $logWarnS "HIJACK" $ "Form Result is: " <> tshow hijackRes uid <- decrypt cID - ((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} - |] + ret <- formResultMaybe hijackRes $ \() -> Just <$> hijackUser uid + maybe (redirect UsersR) return ret + data ButtonAuthMode = BtnAuthLDAP | BtnAuthPWHash | BtnPasswordReset deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) From 6cec571341f3200fed29987b4b5a1992f2310655 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 26 Jul 2023 08:55:48 +0000 Subject: [PATCH 4/4] chore(audit): confine audit log messages to a single long line --- src/Audit.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) 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)