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

fix(avs): avs update on company shorthands working now

Browse Source
This commit is contained in:
Steffen Jost 2024-05-17 18:06:16 +02:00
parent ccf9340449
commit ff2347b1c9
11 changed files with 46 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -51,7 +51,7 @@ AvsInterfaceUnavailable: AVS Schnittstelle nicht richtig konfiguriert oder antwo
AvsUserUnassociated user@UserDisplayName: AVS Id unbekannt für Nutzer #{user}
AvsUserUnknownByAvs api@AvsPersonId: AVS kennt Id #{tshow api} nicht (mehr)
AvsUserAmbiguous api@AvsPersonId: AVS Id #{tshow api} ist nicht eindeutig
AvsSatusSearchEmpty: AVS lieferte keine Ausweisinformationen
AvsStatusSearchEmpty: AVS lieferte keine Ausweisinformationen
AvsPersonSearchEmpty: AVS Suche lieferte leeres Ergebnis
AvsPersonSearchAmbiguous: AVS Suche lieferte mehrere uneindeutige Ergebnisse
AvsSetLicencesFailed reason@Text: Setzen der Fahrlizenz im AVS fehlgeschlagen. Grund: #{reason}

2
models/avs.model
View File

@ -31,4 +31,4 @@ AvsSync
creationTime UTCTime
pause Day Maybe -- Don't synch if last synch after this day, otherwise synch
UniqueAvsSyncUser user
deriving Generic
deriving Generic Show

12
models/company.model
View File

@ -17,9 +17,9 @@ Company
Primary shorthand -- newtype Key Company = CompanyKey { unCompanyKey :: CompanyShorthand }
deriving Ord Eq Show Generic Binary
-- TODO: a way to populate this table (manually)
CompanySynonym
synonym CompanyName
canonical CompanyShorthand OnDeleteCascade OnUpdateCascade -- DEPRECATED: should be CompanyId
UniqueCompanySynonym synonym
deriving Ord Eq Show Generic
-- -- TODO: a way to populate this table (manually)
-- CompanySynonym
-- synonym CompanyName
-- canonical CompanyShorthand OnDeleteCascade OnUpdateCascade -- DEPRECATED: should be CompanyId
-- UniqueCompanySynonym synonym
-- deriving Ord Eq Show Generic

4
models/jobs.model
View File

@ -20,11 +20,11 @@ CronLastExec
time UTCTime -- When was the job executed
instance InstanceId -- Which uni2work-instance did the work
UniqueCronLastExec job
deriving Generic
deriving Generic Show
TokenBucket
ident TokenBucketIdent
lastValue Int64
lastAccess UTCTime
Primary ident
deriving Generic
deriving Generic Show

14
models/lms.model
View File

@ -22,7 +22,7 @@ Qualification
-- across all schools, only one qualification may be a driving licence:
UniqueQualificationAvsLicence avsLicence !force -- either empty or unique
-- NOTE: two NULL values are not equal for the purpose of Uniqueness constraints!
deriving Eq Generic
deriving Show Eq Generic
-- TODOs:
-- - Enstehen Kosten, wenn Teilnehmer für KnowHow eingereiht werden, aber nicht am Kurs teilnehmen?
@ -44,7 +44,7 @@ QualificationPrecondition -- NOTE: this can only be enforc
qualification QualificationId OnDeleteCascade OnUpdateCascade -- AND: not unique, ie. qualification can have multiple required preconditions
required [QualificationId] -- OR : alternatives, any one will suffice
continuous Bool -- expiring precondition blocks qualification
deriving Generic
deriving Generic Show
-- Maybe an alternative for online qualification validity checking, transitivity through recursive CTEs? (already available in our version)
-- QualificationRequirement
@ -60,7 +60,7 @@ QualificationEdit
user UserId
time UTCTime
qualification QualificationId OnDeleteCascade OnUpdateCascade
deriving Generic
deriving Generic Show
QualificationUser
user UserId OnDeleteCascade OnUpdateCascade
@ -73,7 +73,7 @@ QualificationUser
-- Reasons and temporary revocations are implemented through QualificationUserBlock
-- TODO: adjust SAP interface to transmit end dates
UniqueQualificationUser qualification user
deriving Generic
deriving Generic Show
QualificationUserBlock
qualificationUser QualificationUserId OnDeleteCascade OnUpdateCascade
@ -130,7 +130,7 @@ LmsUser
-- Primary ident -- newtype Key LmsUserId = LmsUserKey { unLmsUser :: Text } -- change LmsIdent -> Text. Do we want this? No.
UniqueLmsIdent ident -- idents must be unique accross all qualifications, since idents are global within LMS!
UniqueLmsQualificationUser qualification user -- each user may be enrolled at most once per course
deriving Generic
deriving Generic Show
-- LmsUserStatus
-- lmsUser LmsUserId OnDeleteCascade OnUpdateCascade
@ -148,7 +148,7 @@ LmsReport
lock Bool -- (0|1)
timestamp UTCTime default=now()
UniqueLmsReport qualification ident -- required by DBTable
deriving Generic
deriving Generic Show
-- LmsAudit removed by commit 71cde92a
-- due to frequent transmit errors, a separate lms tranmission log is necessary again
@ -160,4 +160,4 @@ LmsReportLog
lock Bool -- (0|1)
timestamp UTCTime default=now()
missing Bool default=false
deriving Generic
deriving Generic Show

6
models/print.model
View File

@ -16,16 +16,16 @@ PrintJob
lmsUser LmsIdent Maybe OnDeleteSetNull OnUpdateCascade -- allows tracking if recipient has been notified; must be unique
-- UniquePrintJobLmsUser lmsUser -- Note that in fact multiple print jobs per LMS user are possible!
-- UniquePrintJobApcIdent apcIdent -- TODO: not yet enforced, since LmsIdent is currently used
deriving Generic
deriving Generic Show
PrintAcknowledge -- just to store acknowledging requests to be evaluated by a background job later on
apcIdent Text
timestamp UTCTime default=now()
processed Bool
deriving Generic
deriving Generic Show
PrintAckIdAlias
needle Text
replacement Text
priority Int
deriving Generic
deriving Generic Show

14
models/users.model
View File

@ -61,31 +61,31 @@ UserFunction -- Administratively assigned functions (lecturer, admin, evaluation
function SchoolFunction
UniqueUserFunction user school function
deriving Generic
UserSystemFunction
UserSystemFunction Show
user UserId
function SystemFunction -- Defined in Model.Types.User
manual Bool -- Inserted manually by Admin or automatic from LDAP
isOptOut Bool -- User has currently deactivate the role for themselves
UniqueUserSystemFunction user function
deriving Generic
deriving Generic Show
UserExamOffice
user UserId
field StudyTermsId
UniqueUserExamOffice user field
deriving Generic
deriving Generic Show
UserSchool -- Managed by users themselves, encodes "schools of interest"
user UserId
school SchoolId
isOptOut Bool -- true if this a marker, that the user manually deleted this entry; it should not be recreated automatically
UniqueUserSchool user school
deriving Generic
deriving Generic Show
UserGroupMember
group UserGroupName
user UserId
primary Checkmark nullable
UniquePrimaryUserGroupMember group primary !force
UniqueUserGroupMember group user
deriving Generic
deriving Generic Show
UserCompany
user UserId
company CompanyId OnDeleteCascade OnUpdateCascade
@ -94,7 +94,7 @@ UserCompany
priority Int default=0 -- higher number, higher priority
useCompanyAddress Bool default=true -- if true, CompanyPostalAddress and CompanyEmail are used if UserPostalAddress/UserDisplayEmail are Nothing, respects priority
UniqueUserCompany user company -- a user may belong to multiple companies, but to each one only once
deriving Generic
deriving Generic Show
UserSupervisor
supervisor UserId -- multiple supervisor per trainee possible
user UserId
@ -102,5 +102,5 @@ UserSupervisor
company CompanyId Maybe OnDeleteCascade OnUpdateCascade -- this supervisor was company default supervisor at time of entry
reason Text Maybe -- miscellaneous reason, e.g. Winterservice supervisision
UniqueUserSupervisor supervisor user -- each supervisor/user combination is unique (same supervisor can superviser the same user only once)
deriving Generic
deriving Generic Show

4
src/Application.hs
View File

@ -746,8 +746,8 @@ shutdownApp app = do
-- | Run a handler
handler, handler' :: Handler a -> IO a
handler h = runResourceT $ getAppDevSettings >>= makeFoundation >>= liftIO . flip unsafeHandler h
handler' h = runResourceT $ getAppSettings >>= makeFoundation >>= liftIO . flip unsafeHandler h
handler h = runResourceT $ getAppDevSettings >>= makeFoundation >>= liftIO . flip unsafeHandler h
handler' h = runResourceT $ getAppSettings >>= makeFoundation >>= liftIO . flip unsafeHandler h
-- | Run DB queries
db, db' :: DB a -> IO a

2
src/Handler/Admin/Avs.hs
View File

@ -759,7 +759,7 @@ postAdminAvsUserR uuid = do
Left err -> exceptionWgt err
Right (AvsResponseStatus asts) ->
if null asts
then [whamlet|_{MsgAvsPersonSearchEmpty}|]
then [whamlet|_{MsgAvsStatusSearchEmpty}|]
else
let cs = mkCardsWgt compDict . avsStatusPersonCardStatus <$> toList asts
in mconcat cs

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

@ -584,19 +584,28 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
, companyPostAddress = newAvsFirmInfo ^. _avsFirmPostAddress
, companyEmail = newAvsFirmInfo ^? _avsFirmPrimaryEmail . _Just . from _CI
}
newCmp <- insertEntity $ foldl' upd dmy firmInfo2company
newCmp <- insertEntity $ foldl' upd dmy $ firmInfo2key : firmInfo2company
reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp
return newCmp
(Just Entity{entityKey=firmid, entityVal=firm}, oldAvsFirmInfo) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and changed occurred
let cmp_ups = mapMaybe (mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company
Entity firmid <$> updateGet firmid cmp_ups
key_ups = mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2key
res_cmp <- updateGetEntity firmid cmp_ups
case key_ups of
Nothing -> return res_cmp
Just key_up -> do
let uniq_cmp = UniqueCompanyAvsId $ res_cmp ^. _entityVal . _companyAvsId
updateBy uniq_cmp [key_up] -- this is ok, since we have OnUpdateCascade on all CompanyId entries
maybeM (return res_cmp) return $ getBy uniq_cmp
where
firmInfo2key =
CheckUpdate CompanyShorthand $ _avsFirmAbbreviation . from _CI -- Updating primary key works in principle thanks to OnUpdateCascade, but fails due to update get
firmInfo2company =
[ CheckUpdate CompanyName $ _avsFirmFirm . from _CI
, CheckUpdate CompanyShorthand $ _avsFirmAbbreviation . from _CI
, CheckUpdate CompanyAvsId _avsFirmFirmNo -- Updating primary keys is always tricky, but should be okay thanks to OnUpdateCascade
[ CheckUpdate CompanyName $ _avsFirmFirm . from _CI
, CheckUpdate CompanyAvsId _avsFirmFirmNo -- Updating unique might be problematic
-- , CheckUpdate CompanyPrefersPostal _avsFirmPrefersPostal -- Guessing here is not useful, since postal preference is ignored anyway when there is only one option available
, CheckUpdate CompanyPostAddress _avsFirmPostAddress
, CheckUpdate CompanyEmail $ _avsFirmPrimaryEmail . _Just . from _CI . re _Just

1
src/Utils/DB.hs
View File

@ -129,6 +129,7 @@ updateBy uniq updates = do
key <- getKeyBy uniq
for_ key $ flip update updates
-- | update and retrieve an entity. Will throw an error if the key is updaded
updateGetEntity :: (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend) => Key record -> [Update record] -> ReaderT backend m (Entity record)
updateGetEntity k = fmap (Entity k) . updateGet k