fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(qualification): allow admins to see all qualifications

Browse Source
This commit is contained in:
Steffen Jost 2023-02-22 16:54:41 +01:00
parent b2bdfb2ba2
commit 1c41a4991a
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Handler/Qualification.hs
View File

@ -269,12 +269,13 @@ mkQualificationTable ::
( Functor h, ToSortable h ( Functor h, ToSortable h
, AsCornice h p QualificationTableData (DBCell (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData))) cols , AsCornice h p QualificationTableData (DBCell (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData))) cols
) )
=> Entity Qualification => Bool
-> Entity Qualification
-> Map QualificationTableAction (AForm Handler QualificationTableActionData) -> Map QualificationTableAction (AForm Handler QualificationTableActionData)
-> cols -> cols
-> PSValidator (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData)) -> PSValidator (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData))
-> DB (FormResult (QualificationTableActionData, Set UserId), Widget) -> DB (FormResult (QualificationTableActionData, Set UserId), Widget)
mkQualificationTable (Entity qid quali) acts cols psValidator = do mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
svs <- getSupervisees svs <- getSupervisees
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
currentRoute <- fromMaybe (error "mkQualificationTable called from 404-handler") <$> liftHandler getCurrentRoute currentRoute <- fromMaybe (error "mkQualificationTable called from 404-handler") <$> liftHandler getCurrentRoute
@ -284,7 +285,7 @@ mkQualificationTable (Entity qid quali) acts cols psValidator = do
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName) csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
dbtIdent :: Text dbtIdent :: Text
dbtIdent = "qualification" dbtIdent = "qualification"
fltrSvs = \quser -> quser E.^. QualificationUserUser `Ex.in_` E.vals svs fltrSvs = if isAdmin then const E.true else \quser -> quser E.^. QualificationUserUser `Ex.in_` E.vals svs
dbtSQLQuery q = qualificationTableQuery qid fltrSvs q dbtSQLQuery q = qualificationTableQuery qid fltrSvs q
dbtRowKey = queryUser >>> (E.^. UserId) dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjFilteredPostId dbtProj = dbtProjFilteredPostId
@ -379,6 +380,7 @@ getQualificationR, postQualificationR :: SchoolId -> QualificationShorthand ->
getQualificationR = postQualificationR getQualificationR = postQualificationR
postQualificationR sid qsh = do postQualificationR sid qsh = do
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
isAdmin <- hasReadAccessTo AdminR
((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do ((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh
let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData) let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
@ -403,10 +405,9 @@ postQualificationR sid qsh = do
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap lmsStatusPlusCell lu $ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap lmsStatusPlusCell lu
] ]
psValidator = def psValidator = def
tbl <- mkQualificationTable qent acts colChoices psValidator tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
return (tbl, qent) return (tbl, qent)
isAdmin <- hasReadAccessTo AdminR
formResult lmsRes $ \case formResult lmsRes $ \case
_ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page for now _ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page for now
(action, selectedUsers) | isExpiryAct action -> do (action, selectedUsers) | isExpiryAct action -> do