Merge branch 'master' into test

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/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)

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

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,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
 
 

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