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

chore(userlist): allow sorting by admin role or system function

Browse Source
This commit is contained in:
Steffen Jost 2023-03-24 16:11:48 +00:00
parent 2622d24f03
commit 9c8b09a633
2 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Handler/Users.hs
View File

@ -132,7 +132,7 @@ postUsersR = do
, sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication , sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication
, sortable (Just "ldap-sync") (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation , sortable (Just "ldap-sync") (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation
, flip foldMap universeF $ \function -> , flip foldMap universeF $ \function ->
sortable Nothing (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do sortable (Just $ SortingKey $ CI.mk $ toPathPiece function) (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
schools <- liftHandler . runDB . E.select . E.from $ \(school `E.InnerJoin` userFunction) -> do schools <- liftHandler . runDB . E.select . E.from $ \(school `E.InnerJoin` userFunction) -> do
E.on $ school E.^. SchoolId E.==. userFunction E.^. UserFunctionSchool E.on $ school E.^. SchoolId E.==. userFunction E.^. UserFunctionSchool
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
@ -145,7 +145,7 @@ postUsersR = do
$forall (E.Value sh) <- schools $forall (E.Value sh) <- schools
<li>#{sh} <li>#{sh}
|] |]
, sortable Nothing (i18nCell MsgUserSystemFunctions) $ \DBRow{ dbrOutput = Entity uid _ } -> , sortable (Just "system-function") (i18nCell MsgUserSystemFunctions) $ \DBRow{ dbrOutput = Entity uid _ } ->
let getFunctions = fmap (map $ userSystemFunctionFunction . entityVal) . liftHandler . runDB $ selectList [ UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False ] [ Asc UserSystemFunctionFunction ] let getFunctions = fmap (map $ userSystemFunctionFunction . entityVal) . liftHandler . runDB $ selectList [ UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False ] [ Asc UserSystemFunctionFunction ]
in listCell' getFunctions i18nCell in listCell' getFunctions i18nCell
, sortable Nothing (mempty & cellAttrs <>~ pure ("hide-columns--hider-label", mr MsgTableActionsHead)) $ \inp@DBRow{ dbrOutput = Entity uid _ } -> FormCell , sortable Nothing (mempty & cellAttrs <>~ pure ("hide-columns--hider-label", mr MsgTableActionsHead)) $ \inp@DBRow{ dbrOutput = Entity uid _ } -> FormCell
@ -201,7 +201,14 @@ postUsersR = do
, dbtRowKey = (E.^. UserId) , dbtRowKey = (E.^. UserId)
, dbtColonnade , dbtColonnade
, dbtProj = dbtProjId , dbtProj = dbtProjId
, dbtSorting = Map.fromList , dbtSorting = Map.fromList $
[ ( SortingKey $ CI.mk $ toPathPiece function
, SortColumn $ \user -> E.subSelect $ E.from $ \uf -> do
E.where_ $ uf E.^. UserFunctionUser E.==. user E.^. UserId
E.&&. uf E.^. UserFunctionFunction E.==. E.val function
return (uf E.^. UserFunctionSchool)
) | function <- universeF
] ++
[ ( "name" [ ( "name"
, SortColumn $ \user -> user E.^. UserSurname , SortColumn $ \user -> user E.^. UserSurname
) )
@ -234,6 +241,11 @@ postUsersR = do
E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)] E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
return (usrSpvr E.^. UserDisplayName) return (usrSpvr E.^. UserDisplayName)
) )
, ( "system-function"
, SortColumn $ \user -> E.subSelect $ E.from $ \usf -> do
E.where_ $ usf E.^. UserSystemFunctionUser E.==. user E.^. UserId
return $ usf E.^. UserSystemFunctionFunction
)
] ]
, dbtFilter = Map.fromList -- OverloadedLists does not work with the templates , dbtFilter = Map.fromList -- OverloadedLists does not work with the templates
[ ( "user-search", FilterColumn $ \user (criteria :: Set.Set Text) -> [ ( "user-search", FilterColumn $ \user (criteria :: Set.Set Text) ->

9
src/Jobs.hs
View File

@ -246,10 +246,11 @@ manageJobPool foundation@UniWorX{..} unmask = shutdownOnException $ \routeExc ->
{ jobWorkers = jobWorkers oldState `Map.withoutKeys` Map.keysSet deadWorkers { jobWorkers = jobWorkers oldState `Map.withoutKeys` Map.keysSet deadWorkers
} }
guard . not $ Map.null deadWorkers guard . not $ Map.null deadWorkers
return . forM_ (Map.toList deadWorkers) $ \(jobAsync, result) -> do return . forM_ (Map.toList deadWorkers) $ \(jobAsync, _result) -> do
case result of -- TOO MUCH LOGGING
Right () -> $logInfoS "JobPoolManager" [st|Job-Executor #{showWorkerId (jobWorkerName oldState jobAsync)} terminated|] -- case result of
Left e -> $logErrorS "JobPoolManager" [st|Job-Executer #{showWorkerId (jobWorkerName oldState jobAsync)} crashed: #{tshow e}|] -- Right () -> $logInfoS "JobPoolManager" [st|Job-Executor #{showWorkerId (jobWorkerName oldState jobAsync)} terminated|]
-- Left e -> $logErrorS "JobPoolManager" [st|Job-Executer #{showWorkerId (jobWorkerName oldState jobAsync)} crashed: #{tshow e}|]
void . lift . allocateLinkedAsync $ void . lift . allocateLinkedAsync $
let go = do let go = do
next <- evalRandTIO . mapRandT (liftIO . atomically) . runMaybeT $ do next <- evalRandTIO . mapRandT (liftIO . atomically) . runMaybeT $ do