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

Merge branch 'master' into test

Browse Source
This commit is contained in:
Sarah Vaupel 2023-07-17 14:15:23 +00:00
commit f72e020dfe
11 changed files with 98 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
CHANGELOG.md
View File

@ -2,20 +2,21 @@
All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
## [27.4.18](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.17...t27.4.18) (2023-07-16) ## [27.4.18](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.14...v27.4.18) (2023-07-17)
## [27.4.17](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.16...t27.4.17) (2023-07-16) ## [27.4.17](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.14...v27.4.17) (2023-07-17)
## [27.4.16](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.15...t27.4.16) (2023-07-16) ## [27.4.16](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.14...v27.4.16) (2023-07-17)
## [27.4.15](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t0.4.0...t27.4.15) (2023-07-16) ## [27.4.15](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.14...v27.4.15) (2023-07-17)
## [27.4.14](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.13...v27.4.14) (2023-07-15) ## [27.4.14](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.13...v27.4.14) (2023-07-14)
### Bug Fixes ### Bug Fixes
* **avs:** eliminate call to undefined in Esqueleto.Internals ([240c6f8](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/240c6f81f81d1872317da01411fa67ec97e3b16d)) * **avs:** eliminate call to undefined in Esqueleto.Internals ([240c6f8](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/240c6f81f81d1872317da01411fa67ec97e3b16d))
* **job:** fix [#95](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/95) by implementing queued job deletion for admins ([5b9a554](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5b9a5545457dbe506d20f7362fb6e0d6bae4f7f4))
## [27.4.13](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.12...v27.4.13) (2023-07-12) ## [27.4.13](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.12...v27.4.13) (2023-07-12)

2
messages/uniworx/categories/health/de-de-formal.msg
View File

@ -9,7 +9,7 @@ HealthCheckLDAPAdmins: Anteil der Administrator:innen mit LDAP Authentifizierung
HealthCheckSMTPConnect: SMTP-Server kann erreicht werden HealthCheckSMTPConnect: SMTP-Server kann erreicht werden
HealthCheckWidgetMemcached: Memcached-Server liefert Widgets korrekt aus HealthCheckWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
HealthCheckActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen HealthCheckActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen
HealthCheckDoesFlush: Zustandsprüfung läuft durch HealthCheckDoesFlush: Abgearbeitete Jobs werden aufgeräumt
InstanceIdentification: Instanz-Identifikation InstanceIdentification: Instanz-Identifikation
InstanceId: Instanz-Nummer InstanceId: Instanz-Nummer
ClusterId: Cluster-Nummer ClusterId: Cluster-Nummer

2
messages/uniworx/categories/health/en-eu.msg
View File

@ -9,7 +9,7 @@ HealthCheckLDAPAdmins: Proportion of administrators with LDAP authentication tha
HealthCheckSMTPConnect: SMTP server is reachable HealthCheckSMTPConnect: SMTP server is reachable
HealthCheckWidgetMemcached: Memcached server is serving widgets correctly HealthCheckWidgetMemcached: Memcached server is serving widgets correctly
HealthCheckActiveJobExecutors: Proportion of job workers accepting new jobs HealthCheckActiveJobExecutors: Proportion of job workers accepting new jobs
HealthCheckDoesFlush: Health reports flushes HealthCheckDoesFlush: Executed jobs are removed
InstanceIdentification: Instance identification InstanceIdentification: Instance identification
InstanceId: Instance id InstanceId: Instance id
ClusterId: Cluster id ClusterId: Cluster id

5
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -81,3 +81,8 @@ TableSupervisor: Ansprechpartner
TableCreationTime: Erstellungszeit TableCreationTime: Erstellungszeit
TableJob !ident-ok: Job TableJob !ident-ok: Job
TableJobContent !ident-ok: Parameter TableJobContent !ident-ok: Parameter
TableJobLockTime: Bearbeitung seit
TableJobLockInstance: Bearbeiter
TableJobCreationInstance: Ersteller
ActJobDelete: Job entfernen
TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt

7
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -80,4 +80,9 @@ TableCompanyNos: Company numbers
TableSupervisor: Supervisor TableSupervisor: Supervisor
TableCreationTime: Creation TableCreationTime: Creation
TableJob !ident-ok: Job TableJob !ident-ok: Job
TableJobContent !ident-ok: Parameters TableJobContent !ident-ok: Parameters
TableJobLockTime: Lock time
TableJobLockInstance: Worker
TableJobCreationInstance: Creator
ActJobDelete: Delete job
TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted

2
nix/docker/test-version.json
View File

@ -1,3 +1,3 @@
{ {
"version": "0.1.0" "version": "27.4.18"
} }

6
src/Application.hs
View File

@ -550,8 +550,8 @@ warpSettings foundation = defaultSettings
& Set.filter (is _Just . (foundation ^. _appHealthCheckInterval)) & Set.filter (is _Just . (foundation ^. _appHealthCheckInterval))
atomically $ do atomically $ do
results <- readTVar $ foundation ^. _appHealthReport results <- readTVar $ foundation ^. _appHealthReport
guard $ activeChecks == Set.map (classifyHealthReport . snd) results guard $ activeChecks `Set.isSubsetOf` Set.map (classifyHealthReport . snd) results
guard . (== Min HealthSuccess) $ foldMap (Min . healthReportStatus . snd) results guard . (/= Min HealthFailure) $ foldMap (Min . healthReportStatus . snd) results
notifyReady notifyReady
| otherwise | otherwise
-> notifyReady -> notifyReady
@ -679,7 +679,7 @@ appMain = runResourceT $ do
interval <- mInterval interval <- mInterval
let lastSuccess = maybeMonoid mResults let lastSuccess = maybeMonoid mResults
& Set.filter (\(_, rep) -> classifyHealthReport rep == hc) & Set.filter (\(_, rep) -> classifyHealthReport rep == hc)
& Set.filter (\(_, rep) -> healthReportStatus rep >= HealthSuccess) & Set.filter (\(_, rep) -> healthReportStatus rep > HealthFailure)
& Set.mapMonotonic (view _1) & Set.mapMonotonic (view _1)
& Set.lookupMax & Set.lookupMax

78
src/Handler/Admin/Crontab.hs
View File

@ -23,12 +23,14 @@ import qualified Data.Aeson.Encode.Pretty as Pretty
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as Text.Builder import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Set as Set
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import qualified Data.UUID as UUID import qualified Data.UUID as UUID
import Database.Persist.Sql (deleteWhereCount)
import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E import qualified Database.Esqueleto.Utils as E
-- import Database.Esqueleto.Utils.TH -- import Database.Esqueleto.Utils.TH
@ -108,6 +110,19 @@ getAdminCrontabR = do
} }
data JobTableAction = ActJobDelete
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
instance Universe JobTableAction
instance Finite JobTableAction
nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''JobTableAction id
-- Not yet needed, since there is no additional data for now (also, postprocess did not type somehow)
-- data JobTableActionData = ActJobDeleteData
-- deriving (Eq, Ord, Read, Show, Generic)
getAdminJobsR, postAdminJobsR :: Handler Html getAdminJobsR, postAdminJobsR :: Handler Html
getAdminJobsR = postAdminJobsR getAdminJobsR = postAdminJobsR
postAdminJobsR = do postAdminJobsR = do
@ -117,18 +132,28 @@ postAdminJobsR = do
resultJob :: Lens' (DBRow (Entity QueuedJob)) (Entity QueuedJob) resultJob :: Lens' (DBRow (Entity QueuedJob)) (Entity QueuedJob)
resultJob = _dbrOutput resultJob = _dbrOutput
dbtIdent :: Text
dbtIdent = "queued-jobs"
dbtSQLQuery = return dbtSQLQuery = return
dbtRowKey = (E.^. QueuedJobId) dbtRowKey = (E.^. QueuedJobId)
dbtProj = dbtProjId dbtProj = dbtProjId
dbtColonnade = dbColonnade $ mconcat -- remove call to dbColonnade if table actions are added dbtColonnade = mconcat
[ sortable (Just "job") (i18nCell MsgTableJob) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe textCell $ getJobName queuedJobContent [ dbSelect (applying _2) id (return . view (resultJob . _entityKey))
, sortable (Just "creation-time") (i18nCell MsgTableCreationTime) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> dateTimeCell queuedJobCreationTime , sortable (Just "job") (i18nCell MsgTableJob) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe textCell $ getJobName queuedJobContent
, sortable (Just "content") (i18nCell MsgTableJobContent) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cell [whamlet|#{doEnc queuedJobContent}|] & addCellClass ("json"::Text) , sortable (Just "creation-time") (i18nCell MsgTableCreationTime) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> dateTimeCell queuedJobCreationTime
, sortable (Just "content") (i18nCell MsgTableJobContent) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cell [whamlet|#{doEnc queuedJobContent}|] & addCellClass ("json"::Text)
, sortable (Just "lock-time") (i18nCell MsgTableJobLockTime) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe dateTimeCell queuedJobLockTime
, sortable (Just "lock-instance") (i18nCell MsgTableJobLockInstance) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe (stringCell . show) queuedJobLockInstance
, sortable (Just "creation-instance") (i18nCell MsgTableJobCreationInstance) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> stringCell $ show queuedJobCreationInstance
] ]
dbtSorting = Map.fromList dbtSorting = Map.fromList
[ ("creation-time", SortColumnNullsInv (E.^. QueuedJobCreationTime)) [ ("creation-time" , SortColumnNullsInv (E.^. QueuedJobCreationTime))
, ("job" , SortColumn (\v -> v E.^. QueuedJobContent E.->>. "job")) , ("job" , SortColumn (\v -> v E.^. QueuedJobContent E.->>. "job"))
, ("content" , SortColumn (E.^. QueuedJobContent)) , ("content" , SortColumn (E.^. QueuedJobContent))
, ("lock-time" , SortColumnNullsInv (E.^. QueuedJobLockTime))
, ("lock-instance" , SortColumn (E.^. QueuedJobLockInstance))
, ("creation-instance", SortColumn (E.^. QueuedJobCreationInstance))
] ]
dbtFilter = Map.fromList dbtFilter = Map.fromList
[ [
@ -139,15 +164,46 @@ postAdminJobsR = do
prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob) prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob)
] ]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtParams = def acts :: Map JobTableAction (AForm Handler JobTableAction)
dbtIdent :: Text acts = Map.singleton ActJobDelete $ pure ActJobDelete
dbtIdent = "queued-jobs" dbtParams = DBParamsForm
{ dbParamsFormAdditional =
renderAForm FormStandard
$ (, mempty) . First . Just
<$> multiActionA acts (fslI MsgTableAction) Nothing
, dbParamsFormMethod = POST
, dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
, dbParamsFormAttrs = []
, dbParamsFormSubmit = FormSubmit
, dbParamsFormEvaluate = liftHandler . runFormPost
, dbParamsFormResult = id
, dbParamsFormIdent = def
}
dbtCsvEncode = noCsvEncode dbtCsvEncode = noCsvEncode
dbtCsvDecode = Nothing dbtCsvDecode = Nothing
dbtExtraReps = [] dbtExtraReps = []
-- jobsDBTableValidator :: PSValidator (MForm Handler) (FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))))
jobsDBTableValidator = def jobsDBTableValidator = def
& defaultSorting [SortDescBy "creation-time"] & defaultSorting [SortDescBy "creation-time"]
((), jobsTable) <- runDB $ dbTable jobsDBTableValidator jobsDBTable -- postprocess :: FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob)))
-- -> FormResult (JobTableAction, Set QueuedJobId)
postprocess inp = do
(First (Just act), jobMap) <- inp
let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
return (act, jobSet)
(jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable)
formResult jobActRes $ \case
(ActJobDelete, jobIds) -> do
let jobReq = length jobIds
rmvd <- fromIntegral <$> runDB (deleteWhereCount
[ QueuedJobLockTime ==. Nothing
, QueuedJobLockInstance ==. Nothing
, QueuedJobId <-. Set.toList jobIds
])
addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
reloadKeepGetParams AdminJobsR
siteLayoutMsg MsgMenuAdminJobs $ do siteLayoutMsg MsgMenuAdminJobs $ do
setTitleI MsgMenuAdminJobs setTitleI MsgMenuAdminJobs

1
src/Handler/LMS.hs
View File

@ -326,7 +326,6 @@ instance Finite LmsTableAction
nullaryPathPiece ''LmsTableAction $ camelToPathPiece' 2 nullaryPathPiece ''LmsTableAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''LmsTableAction id embedRenderMessage ''UniWorX ''LmsTableAction id
-- Not yet needed, since there is no additional data for now:
data LmsTableActionData = LmsActNotifyData data LmsTableActionData = LmsActNotifyData
| LmsActRenewNotifyData | LmsActRenewNotifyData
| LmsActRenewPinData -- no longer used | LmsActRenewPinData -- no longer used

2
src/Jobs.hs
View File

@ -593,7 +593,7 @@ handleJobs' wNum = C.mapM_ $ \jctl -> hoist delimitInternalState . withJobWorker
newReport@(healthReportStatus -> newStatus) <- lift $ generateHealthReport kind newReport@(healthReportStatus -> newStatus) <- lift $ generateHealthReport kind
$logInfoS logIdent [st|#{tshow kind}: #{toPathPiece newStatus}|] $logInfoS logIdent [st|#{tshow kind}: #{toPathPiece newStatus}|]
unless (newStatus == HealthSuccess) $ do unless (newStatus > HealthFailure) $ do
$logErrorS logIdent [st|#{tshow kind}: #{tshow newReport}|] $logErrorS logIdent [st|#{tshow kind}: #{tshow newReport}|]
liftIO $ do liftIO $ do

13
src/Model/Types/Health.hs
View File

@ -67,10 +67,10 @@ classifyHealthReport :: HealthReport -> HealthCheck
classifyHealthReport HealthMatchingClusterConfig{} = HealthCheckMatchingClusterConfig classifyHealthReport HealthMatchingClusterConfig{} = HealthCheckMatchingClusterConfig
classifyHealthReport HealthLDAPAdmins{} = HealthCheckLDAPAdmins classifyHealthReport HealthLDAPAdmins{} = HealthCheckLDAPAdmins
classifyHealthReport HealthHTTPReachable{} = HealthCheckHTTPReachable classifyHealthReport HealthHTTPReachable{} = HealthCheckHTTPReachable
classifyHealthReport HealthSMTPConnect{} = HealthCheckSMTPConnect classifyHealthReport HealthSMTPConnect{} = HealthCheckSMTPConnect
classifyHealthReport HealthWidgetMemcached{} = HealthCheckWidgetMemcached classifyHealthReport HealthWidgetMemcached{} = HealthCheckWidgetMemcached -- kein Neustart notwendig
classifyHealthReport HealthActiveJobExecutors{} = HealthCheckActiveJobExecutors classifyHealthReport HealthActiveJobExecutors{} = HealthCheckActiveJobExecutors
classifyHealthReport HealthDoesFlush{} = HealthCheckDoesFlush classifyHealthReport HealthDoesFlush{} = HealthCheckDoesFlush -- evtl. kein Neustart notwendig
-- | `HealthReport` classified (`classifyHealthReport`) by badness -- | `HealthReport` classified (`classifyHealthReport`) by badness
-- --
@ -111,7 +111,8 @@ healthReportStatus = \case
HealthActiveJobExecutors Nothing -> HealthInactive HealthActiveJobExecutors Nothing -> HealthInactive
HealthActiveJobExecutors (Just prop ) HealthActiveJobExecutors (Just prop )
| prop > 0 -> HealthSuccess | prop > 0 -> HealthSuccess
HealthDoesFlush mProp HealthDoesFlush Nothing -> HealthInactive
| maybe True (>= 2) mProp -> HealthFailure -- Looks buggy to me? HealthDoesFlush (Just prop )
| prop >= 2 -> HealthFailure
| otherwise -> HealthSuccess | otherwise -> HealthSuccess
_other -> HealthFailure _other -> HealthFailure