fraport/fradrive
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.
## [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
* **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)

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
HealthCheckWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
HealthCheckActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen
HealthCheckDoesFlush: Zustandsprüfung läuft durch
HealthCheckDoesFlush: Abgearbeitete Jobs werden aufgeräumt
InstanceIdentification: Instanz-Identifikation
InstanceId: Instanz-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
HealthCheckWidgetMemcached: Memcached server is serving widgets correctly
HealthCheckActiveJobExecutors: Proportion of job workers accepting new jobs
HealthCheckDoesFlush: Health reports flushes
HealthCheckDoesFlush: Executed jobs are removed
InstanceIdentification: Instance identification
InstanceId: Instance id
ClusterId: Cluster id

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

@ -81,3 +81,8 @@ TableSupervisor: Ansprechpartner
TableCreationTime: Erstellungszeit
TableJob !ident-ok: Job
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
TableCreationTime: Creation
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))
atomically $ do
results <- readTVar $ foundation ^. _appHealthReport
guard $ activeChecks == Set.map (classifyHealthReport . snd) results
guard . (== Min HealthSuccess) $ foldMap (Min . healthReportStatus . snd) results
guard $ activeChecks `Set.isSubsetOf` Set.map (classifyHealthReport . snd) results
guard . (/= Min HealthFailure) $ foldMap (Min . healthReportStatus . snd) results
notifyReady
| otherwise
-> notifyReady
@ -679,7 +679,7 @@ appMain = runResourceT $ do
interval <- mInterval
let lastSuccess = maybeMonoid mResults
& Set.filter (\(_, rep) -> classifyHealthReport rep == hc)
& Set.filter (\(_, rep) -> healthReportStatus rep >= HealthSuccess)
& Set.filter (\(_, rep) -> healthReportStatus rep > HealthFailure)
& Set.mapMonotonic (view _1)
& 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.Lazy.Builder as Text.Builder
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HashMap
import qualified Data.UUID as UUID
import Database.Persist.Sql (deleteWhereCount)
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
-- 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
postAdminJobsR = do
@ -117,18 +132,28 @@ postAdminJobsR = do
resultJob :: Lens' (DBRow (Entity QueuedJob)) (Entity QueuedJob)
resultJob = _dbrOutput
dbtIdent :: Text
dbtIdent = "queued-jobs"
dbtSQLQuery = return
dbtRowKey = (E.^. QueuedJobId)
dbtProj = dbtProjId
dbtColonnade = dbColonnade $ mconcat -- remove call to dbColonnade if table actions are added
[ sortable (Just "job") (i18nCell MsgTableJob) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe textCell $ getJobName queuedJobContent
, 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)
dbtColonnade = mconcat
[ dbSelect (applying _2) id (return . view (resultJob . _entityKey))
, sortable (Just "job") (i18nCell MsgTableJob) $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe textCell $ getJobName queuedJobContent
, 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
[ ("creation-time", SortColumnNullsInv (E.^. QueuedJobCreationTime))
, ("job" , SortColumn (\v -> v E.^. QueuedJobContent E.->>. "job"))
, ("content" , SortColumn (E.^. QueuedJobContent))
[ ("creation-time" , SortColumnNullsInv (E.^. QueuedJobCreationTime))
, ("job" , SortColumn (\v -> v E.^. QueuedJobContent E.->>. "job"))
, ("content" , SortColumn (E.^. QueuedJobContent))
, ("lock-time" , SortColumnNullsInv (E.^. QueuedJobLockTime))
, ("lock-instance" , SortColumn (E.^. QueuedJobLockInstance))
, ("creation-instance", SortColumn (E.^. QueuedJobCreationInstance))
]
dbtFilter = Map.fromList
[
@ -139,15 +164,46 @@ postAdminJobsR = do
prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob)
]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtParams = def
dbtIdent :: Text
dbtIdent = "queued-jobs"
acts :: Map JobTableAction (AForm Handler JobTableAction)
acts = Map.singleton ActJobDelete $ pure ActJobDelete
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
dbtCsvDecode = Nothing
dbtExtraReps = []
-- jobsDBTableValidator :: PSValidator (MForm Handler) (FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))))
jobsDBTableValidator = def
& 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
setTitleI MsgMenuAdminJobs

1
src/Handler/LMS.hs
View File

@ -326,7 +326,6 @@ instance Finite LmsTableAction
nullaryPathPiece ''LmsTableAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''LmsTableAction id
-- Not yet needed, since there is no additional data for now:
data LmsTableActionData = LmsActNotifyData
| LmsActRenewNotifyData
| 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
$logInfoS logIdent [st|#{tshow kind}: #{toPathPiece newStatus}|]
unless (newStatus == HealthSuccess) $ do
unless (newStatus > HealthFailure) $ do
$logErrorS logIdent [st|#{tshow kind}: #{tshow newReport}|]
liftIO $ do

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

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