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

Merge branch 'master' into fradrive/newletter

Browse Source
This commit is contained in:
Steffen Jost 2024-06-24 09:06:33 +02:00
commit d161c296ad
13 changed files with 95 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
CHANGELOG.md
View File

@ -2,6 +2,29 @@
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.70](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.69...v27.4.70) (2024-06-21)
### Bug Fixes
* **build:** hlint wants a newtype instead ([0766351](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/07663516e520814e26740d671325b7cd10855dd4))
## [27.4.69](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.68...v27.4.69) (2024-06-21)
### Bug Fixes
* **avs:** fix type causing avs surname upate not working ([822c43c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/822c43c8a7db2086954ad187502ec2c4f1811d17))
* **avs:** keep company on unchange address/email only if either is non-empty ([766b858](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/766b8589d6945df21fc6ce90d35a004655ffa471))
* **avs:** synch job deletes used row instead of truncation ([d7acc7a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d7acc7a2d0fe5fc18929a8cb2d9c9f8a259c9944))
## [27.4.68](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.67...v27.4.68) (2024-06-19)
### Bug Fixes
* **letter:** minor ([2ae11dc](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/2ae11dc25c000486af9acc26439a0580f5c687f2))
## [27.4.67](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.66...v27.4.67) (2024-06-17)

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

@ -103,6 +103,7 @@ TableJobLockTime: Bearbeitung seit
TableJobLockInstance: Bearbeiter
TableJobCreationInstance: Ersteller
ActJobDelete: Job entfernen
ActJobDeleteForce n@Int: Auch vor #{pluralDEnN n "Minute"} gesperrte Jobs entfernen
TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt
TableFilterComma: Es können mehrere alternative Suchkriterien mit Komma getrennt angegeben werden, wovon mindestens eines erfüllt werden muss.
TableFilterCommaPlus: Mehrere alternative Suchkriterien mit Komma trennen. Mindestens ein Suchkriterium muss erfüllt werden, zusätzlich zu allen Suchkriterien mit vorangestelltem Plus-Symbol.

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

@ -103,6 +103,7 @@ TableJobLockTime: Lock time
TableJobLockInstance: Worker
TableJobCreationInstance: Creator
ActJobDelete: Delete job
ActJobDeleteForce n: Also delete jobs locked #{pluralENsN n "minute"} ago
TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted
TableFilterComma: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled.
TableFilterCommaPlus: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled in addition to all criteria preceded by a plus symbol.

2
nix/docker/version.json
View File

@ -1,3 +1,3 @@
{
"version": "27.4.67"
"version": "27.4.70"
}

2
package-lock.json generated
View File

@ -1,6 +1,6 @@
{
"name": "uni2work",
"version": "27.4.67",
"version": "27.4.70",
"lockfileVersion": 1,
"requires": true,
"dependencies": {

2
package.json
View File

@ -1,6 +1,6 @@
{
"name": "uni2work",
"version": "27.4.67",
"version": "27.4.70",
"description": "",
"keywords": [],
"author": "",

2
package.yaml
View File

@ -1,5 +1,5 @@
name: uniworx
version: 27.4.67
version: 27.4.70
dependencies:
- base
- yesod

11
src/Database/Esqueleto/Utils.hs
View File

@ -52,7 +52,7 @@ module Database.Esqueleto.Utils
, day, day', dayMaybe, interval, diffDays, diffTimes
, exprLift
, explicitUnsafeCoerceSqlExprValue
, truncateTable
-- , truncateTable
, module Database.Esqueleto.Utils.TH
) where
@ -69,7 +69,7 @@ import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Internal.Internal as E
import Database.Esqueleto.Utils.TH
import qualified Database.Persist.Postgresql as P
-- import qualified Database.Persist.Postgresql as P
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy (Text)
@ -772,6 +772,7 @@ instance (PersistField a1, PersistField a2, PersistField b, Finite a1, Finite a2
(E.else_ $ E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ()))))
truncateTable :: (MonadIO m, BackendCompatible SqlBackend backend, PersistEntity record)
=> record -> ReaderT backend m ()
truncateTable tbl = E.rawExecute ("TRUNCATE TABLE " <> P.tableName tbl <> " RESTART IDENTITY") []
-- Suspected to cause trouble. Needs more testing!
-- truncateTable :: (MonadIO m, BackendCompatible SqlBackend backend, PersistEntity record)
-- => record -> ReaderT backend m ()
-- truncateTable tbl = E.rawExecute ("TRUNCATE TABLE " <> P.tableName tbl <> " RESTART IDENTITY") []

28
src/Foundation/I18n.hs
View File

@ -8,7 +8,7 @@
-- 3. add constructor to list of module exports
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-top-binds #-}
module Foundation.I18n
( appLanguages, appLanguagesOpts
@ -87,21 +87,31 @@ pluralDE num singularForm pluralForm
| num == 1 = singularForm
| otherwise = pluralForm
-- pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text
-- -- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@
-- pluralDEx c n t = pluralDE n t $ t `snoc` c
pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text
-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@
pluralDEx c n t = pluralDE n t $ t `snoc` c
-- -- | like `pluralDEe` but also prefixes with the number
-- pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text
-- pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t)
-- | like `pluralDEe` but also prefixes with the number
pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text
pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t)
pluralDEe :: (Eq a, Num a) => a -> Text -> Text
-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@
pluralDEe n t = pluralDE n t $ t `snoc` 'e'
pluralDEe = pluralDEx 'e'
-- | like `pluralDEe` but also prefixes with the number
pluralDEeN :: (Eq a, Num a, Show a) => a -> Text -> Text
pluralDEeN n t = tshow n <> cons ' ' (pluralDEe n t)
pluralDEeN = pluralDExN 'e'
-- | postfix plural with an 'n'
pluralDEn :: (Eq a, Num a) => a -> Text -> Text
-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@
pluralDEn = pluralDEx 'n'
-- | like `pluralDEn` but also prefixes with the number
pluralDEnN :: (Eq a, Num a, Show a) => a -> Text -> Text
pluralDEnN = pluralDExN 'n'
noneOneMoreDE :: (Eq a, Num a)
=> a -- ^ Count

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

@ -35,6 +35,9 @@ import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
-- import Database.Esqueleto.Utils.TH
-- Number of minutes a job must have been locked already to allow forced deletion
jobDeleteLockMinutes :: Int
jobDeleteLockMinutes = 3
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 1
@ -118,7 +121,9 @@ instance Finite JobTableAction
nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''JobTableAction id
newtype JobTableActionData = ActJobDeleteData
newtype JobTableActionData = ActJobDeleteData
{ jobDeleteLocked :: Bool
}
deriving (Eq, Ord, Read, Show, Generic)
@ -164,7 +169,8 @@ postAdminJobsR = do
]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map JobTableAction (AForm Handler JobTableActionData)
acts = Map.singleton ActJobDelete $ pure ActJobDeleteData
acts = Map.singleton ActJobDelete $ ActJobDeleteData
<$> areq checkBoxField (fslI $ MsgActJobDeleteForce jobDeleteLockMinutes) Nothing
dbtParams = DBParamsForm
{ dbParamsFormAdditional =
renderAForm FormStandard
@ -193,13 +199,22 @@ postAdminJobsR = do
(jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable)
formResult jobActRes $ \case
(ActJobDeleteData, jobIds) -> do
let jobReq = length jobIds
(ActJobDeleteData{jobDeleteLocked}, jobIds) -> do
now <- liftIO getCurrentTime
let cutoff :: UTCTime
cutoff = addUTCTime (nominalMinute * fromIntegral (negate jobDeleteLockMinutes)) now
jobReq = length jobIds
lockCriteria
| jobDeleteLocked =
[ QueuedJobLockTime ==. Nothing ] ||.
[ QueuedJobLockTime <=. Just cutoff ]
| otherwise =
[ QueuedJobLockTime ==. Nothing
, QueuedJobLockInstance ==. Nothing
]
rmvd <- runDB $ fromIntegral <$> deleteWhereCount
[ QueuedJobLockTime ==. Nothing
, QueuedJobLockInstance ==. Nothing
, QueuedJobId <-. Set.toList jobIds
]
((QueuedJobId <-. Set.toList jobIds) : lockCriteria)
addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
reloadKeepGetParams AdminJobsR

6
src/Handler/Utils/Avs.hs
View File

@ -399,8 +399,10 @@ updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMa
usr_up2 <- case oldAvsFirmInfo of
_ | Just newCompanyId == oldCompanyId -- company unchanged entirely
-> return mempty -- => do nothing
(Just oafi) | ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo -- company address unchanged OR
|| ((==) `on` view _avsFirmPrimaryEmail) oafi newAvsFirmInfo -- company primary email unchanged
(Just oafi) | isJust (view _avsFirmPostAddressSimple oafi)
&& ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo -- non-empty company address unchanged OR
|| isJust (view _avsFirmPrimaryEmail oafi)
&& ((==) `on` view _avsFirmPrimaryEmail) oafi newAvsFirmInfo -- non-empty company primary email unchanged
-> do -- => just update user company association, keeping supervision privileges
case oldCompanyId of
Nothing -> void $ insertUnique newUserComp -- it's ok if this already exists

2
src/Handler/Utils/AvsUpdate.hs
View File

@ -65,7 +65,7 @@ instance MkCheckUpdate CU_AvsPersonInfo_User where
type MCU_Rec CU_AvsPersonInfo_User = User
type MCU_Raw CU_AvsPersonInfo_User = AvsPersonInfo
mkCheckUpdate CU_API_UserFirstName = CheckUpdate UserFirstName _avsInfoFirstName
mkCheckUpdate CU_API_UserSurname = CheckUpdate UserFirstName _avsInfoLastName
mkCheckUpdate CU_API_UserSurname = CheckUpdate UserSurname _avsInfoLastName
mkCheckUpdate CU_API_UserDisplayName = CheckUpdate UserDisplayName _avsInfoDisplayName
mkCheckUpdate CU_API_UserBirthday = CheckUpdate UserBirthday _avsInfoDateOfBirth
mkCheckUpdate CU_API_UserMobile = CheckUpdate UserMobile _avsInfoPersonMobilePhoneNo

24
src/Jobs/Handler/SynchroniseAvs.hs
View File

@ -102,27 +102,29 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
dispatchJobSynchroniseAvsQueue :: JobHandler UniWorX
dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
jobs <- runDB $ do
jobs <- E.select (do
E.select (do
(avsSync :& usrAvs) <- E.from $ E.table @AvsSync
`E.leftJoin` E.table @UserAvs
`E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser)
let pause = avsSync E.^. AvsSyncPause
lastSync = usrAvs E.?. UserAvsLastSynch
E.where_ $ E.isNothing pause
E.||. E.isNothing lastSync
E.||. pause E.>. E.dayMaybe lastSync
return (avsSync E.^. AvsSyncUser, usrAvs E.?. UserAvsPersonId)
proceed = E.isNothing pause
E.||. E.isNothing lastSync
E.||. pause E.>. E.dayMaybe lastSync
-- E.where_ proceed -- we still want to delete all paused jobs, rather than to delay them only
return (avsSync E.^. AvsSyncUser, usrAvs E.?. UserAvsPersonId, proceed)
)
now <- liftIO getCurrentTime
E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing
return jobs
-- now <- liftIO getCurrentTime
-- E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing
-- return jobs
let (unlinked, linked) = foldl' discernJob mempty jobs
$logInfoS "SynchronisAvs" [st|AVS synch performing for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
void $ updateAvsUserByIds linked
void $ linktoAvsUserByUIDs unlinked
runDB $ deleteWhere [AvsSyncUser <-. (E.unValue . fst3 <$> jobs)]
$logInfoS "SynchronisAvs" [st|AVS synch performed for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
-- we do not reschedule failed synchs here in order to avoid a loop
where
discernJob (accUid, accApi) ( _ , E.Value (Just api)) = ( accUid, Set.insert api accApi)
discernJob (accUid, accApi) (E.Value uid, E.Value Nothing ) = (Set.insert uid accUid, accApi)
discernJob accs ( _ , E.Value (Just api), E.Value True ) = accs & over _2 (Set.insert api)
discernJob accs (E.Value uid, E.Value Nothing , E.Value True ) = accs & over _1 (Set.insert uid)
discernJob accs ( _ , _ , E.Value False ) = accs