diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index c97fea7df..fa2594f03 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -117,8 +117,9 @@ MenuLanguage: Sprache MenuQualifications: Qualifikationen MenuLms !ident-ok: E‑Learning MenuLmsEdit: Bearbeiten E‑Learning -MenuLmsUser: Benutzer Qualifikationen -MenuLmsUserAll: Alle Benutzer Qualifikationen +MenuLmsUser: Benutzerqualifikationen +MenuLmsUserSchool: Bereichs Benutzerqualifikationen +MenuLmsUserAll: Alle Benutzerqualifikationen MenuLmsUsers: Export E‑Learning Benutzer MenuLmsUserlist: Melden E‑Learning Benutzer MenuLmsResult: Melden Ergebnisse E‑Learning diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 987fff8a5..15242f860 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -119,6 +119,7 @@ MenuQualifications: Qualifications MenuLms: E‑Learning MenuLmsEdit: Edit E‑Learning MenuLmsUser: User Qualifications +MenuLmsUserSchool: Institute User Qualifications MenuLmsUserAll: All User Qualifications MenuLmsUsers: Download E‑Learning Users MenuLmsUserlist: Upload E‑Learning Users diff --git a/routes b/routes index 7259c468a..1932a90ac 100644 --- a/routes +++ b/routes @@ -283,6 +283,7 @@ /lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent LmsIdentR GET -- redirect to LmsR with filter-parameter /lms/#SchoolId/#QualificationShorthand/user/#CryptoUUIDUser LmsUserR GET /lmsuser/#CryptoUUIDUser LmsUserAllR GET +/lmsuser/#CryptoUUIDUser/#SchoolId LmsUserSchoolR GET /api ApiDocsR GET !free /swagger SwaggerR GET !free diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 5e6fe6463..047d17312 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -186,8 +186,9 @@ breadcrumb (LmsResultR ssh qsh) = i18nCrumb MsgMenuLmsResult $ Jus breadcrumb (LmsResultUploadR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh breadcrumb (LmsResultDirectR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh -- never displayed breadcrumb (LmsIdentR ssh qsh _ ) = breadcrumb $ LmsR ssh qsh -- just a redirect -breadcrumb (LmsUserR _ssh _qsh u ) = i18nCrumb MsgMenuLmsUser $ Just $ LmsUserAllR u -breadcrumb (LmsUserAllR _ ) = i18nCrumb MsgMenuLmsUserAll $ Just LmsAllR +breadcrumb (LmsUserR ssh _qsh u ) = i18nCrumb MsgMenuLmsUser $ Just $ LmsUserSchoolR u ssh +breadcrumb (LmsUserSchoolR u _ ) = i18nCrumb MsgMenuLmsUserSchool $ Just $ LmsUserAllR u +breadcrumb (LmsUserAllR _ ) = i18nCrumb MsgMenuLmsUserAll $ Just LmsAllR -- breadcrumb (LmsFakeR ssh qsh) = i18nCrumb MsgMenuLmsFake $ Just $ LmsR ssh qsh -- TODO: remove in production breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 504733028..4246073a4 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -561,29 +561,29 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do icnSuper = text2markup " " <> icon IconSupervisor pure $ toWgt $ mconcat companies , sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q - -- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) $ \row -> - -- cellMaybe (qualificationValidIconCell nowaday (row ^? resultQualBlock)) (row ^? resultQualUser) , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d - , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d + -- , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d + , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \row -> + cellMaybe (qualificationValidUntilCell nowaday (row ^? resultQualBlock)) (row ^? resultQualUser) , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltip) $ \row -> - cellMaybe (qualificationValidReasonCell True nowaday (row ^? resultQualBlock)) (row ^? resultQualUser) + cellMaybe (qualificationValidReasonCell' Nothing True nowaday (row ^? resultQualBlock)) (row ^? resultQualUser) , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip ) $ \(preview $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> cellMaybe (flip ifIconCell IconNoNotification . not) b , sortable Nothing (i18nCell MsgTableAvsActiveCards) $ \(view $ resultUserAvs . _userAvsPersonId -> apid) -> foldMap avsPersonCardCell $ Map.lookup apid apidStatus ] dbtSorting = mconcat [ single $ sortUserNameLink queryUser - , single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson)) - , single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand)) + , single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson)) + , single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand)) , single $ sortUserCompany queryUser - , single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil)) - , single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh)) - , single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld)) - , single ("blocked" , SortColumnNeverNull $ queryQualBlock >>> (E.?. QualificationUserBlockFrom)) - , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal)) - , single ("validity" , SortColumn $ queryQualUser >>> validQualification' now) - ] + , single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil)) + , single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh)) + , single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld)) + , single ("blocked" , SortColumnNeverNull $ queryQualBlock >>> (E.?. QualificationUserBlockFrom)) + , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal)) + -- , single ("validity" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil)) + ] dbtFilter = mconcat [ single $ fltrUserNameEmail queryUser diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index adf58b292..c2056d6c8 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -187,13 +187,13 @@ colUserSheets shns = cap (Sortable Nothing caption) $ foldMap userSheetCol shns colUserQualifications :: forall m c. IsDBTable m c => Day -> Colonnade Sortable UserTableData (DBCell m c) colUserQualifications cutoff = sortable (Just "qualifications") (i18nCell MsgTableQualifications) $ - let qualNamedValidCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidIconCell cutoff qb qu <> spacerCell <> dayCell (qu ^. _qualificationUserValidUntil) + let qualNamedValidCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidUntilCell cutoff qb qu in \(view _userCourseQualifications -> qualis) -> (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualNamedValidCell colUserQualificationBlocked :: forall m c. IsDBTable m c => Bool -> Day -> Colonnade Sortable UserTableData (DBCell m c) - colUserQualificationBlocked isAdmin cutoff = sortable (Just "qualification-block") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ - let qualNamedReasonCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidReasonCell isAdmin cutoff qb qu +colUserQualificationBlocked isAdmin cutoff = sortable (Just "qualification-block") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ + let qualNamedReasonCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidReasonCell' Nothing isAdmin cutoff qb qu in \(view _userCourseQualifications -> qualis) -> (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualNamedReasonCell diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 84753e2a9..398835d8a 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -603,7 +603,7 @@ postLmsR sid qsh = do , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltip) $ \row -> - qualificationValidReasonCell isAdmin nowaday (row ^? resultQualBlock) row + qualificationValidReasonCell' (Just $ LmsUserR sid qsh) isAdmin nowaday (row ^? resultQualBlock) row , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification , sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> textCell lid @@ -724,6 +724,9 @@ getLmsIdentR sid qid ident = redirect (LmsR sid qid, [("lms-ident", toPathPiece getLmsUserAllR :: CryptoUUIDUser -> Handler Html getLmsUserAllR = viewLmsUserR Nothing Nothing +getLmsUserSchoolR :: CryptoUUIDUser -> SchoolId -> Handler Html +getLmsUserSchoolR uuid sid = viewLmsUserR (Just sid) Nothing uuid + getLmsUserR :: SchoolId -> QualificationShorthand -> CryptoUUIDUser -> Handler Html getLmsUserR sid qsh = viewLmsUserR (Just sid) (Just qsh) diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 16fdc38ca..411bb89f8 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -584,11 +584,11 @@ postQualificationR sid qsh = do in wgtCell companies , guardMonoid isAdmin colUserMatriclenr -- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser) - , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil)) - , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d + , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d + , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil)) , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row -> - qualificationValidReasonCell isAdmin nowaday (row ^? resultQualBlock) row + qualificationValidReasonCell' (Just $ LmsUserR sid qsh) isAdmin nowaday (row ^? resultQualBlock) row , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification , sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths)) diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index ef9cd3d17..2757a9574 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -165,16 +165,16 @@ markupCellLargeModal mup ----------------- -- Datatype cells timeCell :: IsDBTable m a => UTCTime -> DBCell m a -timeCell t = cell $ formatTime SelFormatTime t >>= toWidget +timeCell t = cell $ formatTimeW SelFormatTime t dateTimeCell :: IsDBTable m a => UTCTime -> DBCell m a -dateTimeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget +dateTimeCell t = cell $ formatTimeW SelFormatDateTime t dateCell :: IsDBTable m a => UTCTime -> DBCell m a -dateCell t = cell $ formatTime SelFormatDate t >>= toWidget +dateCell t = cell $ formatTimeW SelFormatDate t dayCell :: IsDBTable m a => Day -> DBCell m a -dayCell utctDay = cell $ formatTime SelFormatDate UTCTime{..} >>= toWidget +dayCell utctDay = cell $ formatTimeW SelFormatDate UTCTime{..} where utctDayTime = 0 -- | Show a date, and highlight date earlier than given watershed with an icon and cell class Warning @@ -326,28 +326,45 @@ qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualific Nothing -> mempty (Just descr) -> spacerCell <> markupCellLargeModal descr --- DEPRECATED --- qualificationValidUntilCell :: (IsDBTable m c, HasQualification a, HasQualificationUser a) => a -> DBCell m c --- qualificationValidUntilCell q = textCell (qsh <> ": ") <> dayCell vtd --- where --- qsh = q ^. hasQualification . _qualificationShorthand . _CI --- vtd = q ^. hasQualificationUser . _qualificationUserValidUntil - qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c qualificationValidIconCell d qb qu = do blockIcon $ isValidQualification d qu qb where blockIcon = cell . toWidget . iconQualificationBlock +qualificationValidUntilCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c +qualificationValidUntilCell = qualificationValidUntilCell' (Just LmsUserAllR) + +qualificationValidUntilCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Day -> Maybe b -> a -> DBCell m c +qualificationValidUntilCell' mbToLink d qb qu = cell $ case mbToLink of + Nothing -> headWgt <> dateWgt + Just toLink -> do + uuid <- liftHandler $ encrypt $ qu ^. hasQualificationUser . _qualificationUserUser + let modalWgt = modal blockWgt (Left $ SomeRoute $ toLink uuid) + headWgt <> modalWgt + where + dateWgt = formatTimeW SelFormatDate (qu ^. hasQualificationUser . _qualificationUserValidUntil) + iconWgt = toWidget $ iconQualificationBlock $ isValidQualification d qu qb + headWgt = iconWgt <> [whamlet| |] + qualificationValidReasonCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Bool -> Day -> Maybe b -> a -> DBCell m c -qualificationValidReasonCell showReason d qb qu = ic <> foldMap blc qb +qualificationValidReasonCell = qualificationValidReasonCell' (Just LmsUserAllR) + +qualificationValidReasonCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Bool -> Day -> Maybe b -> a -> DBCell m c +qualificationValidReasonCell' mbToLink showReason d qb qu = ic <> foldMap blc qb where ic = cell . toWidget . iconQualificationBlock $ isValidQualification d qu qb blc (view hasQualificationUserBlock -> QualificationUserBlock{..}) - | showReason = spacerCell <> dateCell qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason - -- TODO: add anchorLink to block history, if user is allowed + | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason | qualificationUserBlockUnblock = mempty | otherwise = spacerCell <> dateCell qualificationUserBlockFrom + dc tstamp + | Just toLink <- mbToLink = cell $ do + uuid <- liftHandler $ encrypt uid + modal (formatTimeW SelFormatDate tstamp) (Left $ SomeRoute $ toLink uuid) + -- anchorCellM (toLink <$> encrypt uid) + | otherwise = dateCell tstamp + uid = qu ^. hasQualificationUser . _qualificationUserUser lmsShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c lmsShortCell (view hasQualification -> Qualification{..}) = anchorCell link name