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

chore(avs): improve avs interface, check licences (WIP)

Browse Source
This commit is contained in:
Steffen Jost 2022-11-23 19:28:21 +01:00
parent d125bcdc9c
commit c627d62037
4 changed files with 34 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
models/lms.model
View File

@ -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:

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

@ -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

2
src/Model/Types/Avs.hs
View File

@ -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

6
test/Database/Fill.hs
View File

@ -511,9 +511,9 @@ fillDb = do
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>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!