From c627d6203724893ea9daf97053f643af34bc5f03 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 23 Nov 2022 19:28:21 +0100 Subject: [PATCH] chore(avs): improve avs interface, check licences (WIP) --- models/lms.model | 2 ++ src/Handler/Utils/Avs.hs | 33 ++++++++++++++++++++++++++++----- src/Model/Types/Avs.hs | 2 +- test/Database/Fill.hs | 6 +++--- 4 files changed, 34 insertions(+), 9 deletions(-) diff --git a/models/lms.model b/models/lms.model index cd34de744..fe7213bdd 100644 --- a/models/lms.model +++ b/models/lms.model @@ -15,9 +15,11 @@ Qualification -- elearningOnly Bool -- successful E-learing automatically increases validity. NO! -- refreshInvitation StoredMarkup -- hard-coded I18N-MSGs used instead, but displayed on qualification page NO! -- expiryNotification StoredMarkup Maybe -- configurable user-profile-notifcations are used instead NO! + avsLicence AvsLicence Maybe -- if set, is synchronized to Avs as a driving licence sapId Text Maybe -- if set, all QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id SchoolQualificationShort school shorthand -- must be unique per school and shorthand SchoolQualificationName school name -- must be unique per school and name + UniqueQualificationAvsLicence avsLicence -- across all schools, only one qualification may be a driving licence deriving Generic -- TODOs: diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 4e1ab4ad5..12654469d 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -29,8 +29,9 @@ import Foundation.Yesod.Auth (upsertCampusUserByCn,CampusUserConversionException import Handler.Utils.Company import Handler.Users.Add ---import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma ---import qualified Database.Esqueleto.Utils as E +import Database.Esqueleto.Experimental ((:&)) +import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma +import qualified Database.Esqueleto.Utils as E -------------------- @@ -115,7 +116,7 @@ setLicencesAvs pls = do -- Only react to changes as compared to last seen status in avs.model -- TODO: turn into a job, once the interface is actually available checkLicences :: Handler () -checkLicences = do +checkLicences = do {- AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsResponseGetLicences licences <- throwLeftM avsQueryGetAllLicences @@ -124,17 +125,39 @@ checkLicences = do -- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld let (noOrVorfeld, rollfeld) = Set.spanAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) licences (_nolicence , vorfeld) = Set.spanAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) noOrVorfeld - now <- liftIO getCurrentTime + idsRollfeld = avsLicencePersonId <$> Set.toList rollfeld + idsVorfeld = avsLicencePersonId <$> Set.toList vorfeld + -- let licenceMap Map.map avsLicencePersonID $ avsMap.fromSet avsLicenceRampLicence licences + -- idsRollfeld = concat $ Map.lookup AvsLicenceRollfeld licenceMap + -- idsVorfeld = concat $ Map.lookup AvsLicenceVorfeld + + now <- liftIO getCurrentTime runDB $ do E.select $ do - -} + (qauli E.:& qualUser E.:& usrAvs) <- + E.from $ E.table @Qualification + `E.innerJoin` E.table @QualificationUser + `E.on` (\(quali E.:& qualUser) -> qual E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification) + `E.innerJoin` E.table @UserAvs + `E.on` (\(_ E.:& qualUser E.:& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser) + E.where_ $ E.isJust (quali E.^. QualificationAvsLicence) + E.&&. (usrAvs E.^. QualificationAvsLicence `E.notIn` E.valList + -- WAS WILL ICH HIER WIRKLICH: + -- Liefere alle avsIds, welche die falsche Qualifikation zugewiesen bekommen haben? + -- Wie erhalte ich alle IDs, welche es KEINE Qualifikation haben? FROM valList scheint es nicht zu geben! + + return + ( userAvs E.^. UserAvsPersonId + , quali E.^. QualificationAvsLicence + ) --TODO this must be chunked into separate jobs/tasks --forM licences $ \AvsPersonLicence{..} -> do + -} error "CONTINUE HERE" -- TODO STUB diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index f35ee6c96..e62771ad4 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -356,7 +356,7 @@ instance ToJSON AvsDataPerson where , "personCards" .= avsPersonPersonCards -- starts with lower case letter! ] -{- Dervied instance decodes empty Texts to Just "", which is annoying +{- Derived instance decodes empty Texts to Just "", which is annoying deriveJSON defaultOptions { fieldLabelModifier = \case { "avsPersonPersonCards" -> "personCards"; others -> dropCamel 2 others } , omitNothingFields = True diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 0706aaa29..eb636861d 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -511,9 +511,9 @@ fillDb = do let f_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|] let r_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] let l_descr = Just $ htmlToStoredMarkup [shamlet|

für unhabilitierte|] - qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True $ Just "F4466" - qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 2 3) False $ Just "R2801" - qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True Nothing + qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True (Just AvsLicenceVorfeld) $ Just "F4466" + qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 2 3) False (Just AvsLicenceRollfeld) $ Just "R2801" + qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True Nothing Nothing void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) Nothing -- TODO: better dates! void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) (Just $ QualificationBlockedLms $ n_day $ -5)-- TODO: better dates! void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing -- TODO: better dates!