Merge branch 'master' into fradrive/api-avs
This commit is contained in:
Steffen Jost
commit
afa1ceff20
@ -28,6 +28,7 @@ UnauthorizedExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer:
|
||||
UnauthorizedSchoolExamOffice: Sie sind nicht mit Prüfungsverwaltung für dieses Institut beauftragt.
|
||||
UnauthorizedSystemExamOffice: Sie sind nicht mit systemweiter Prüfungsverwaltung beauftragt.
|
||||
UnauthorizedSystemPrinter: Sie sind nicht mit systemweitem Druck und Briefversand beauftragt.
|
||||
UnauthorizedSystemSap: Sie sind nicht mit der systemweitem SAP Schnittstellenverwaltung beauftragt.
|
||||
UnauthorizedExternalExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer:innen, für die Sie mit der Prüfungsverwaltung beauftragt sind.
|
||||
UnauthorizedEvaluation: Sie sind nicht mit der Kursumfragenverwaltung beauftragt.
|
||||
UnauthorizedAllocationAdmin: Sie sind nicht mit der Administration von Zentralanmeldungen beauftragt.
|
||||
|
||||
@ -30,6 +30,7 @@ UnauthorizedExamExamOffice: You are not part of the appropriate exam office for
|
||||
UnauthorizedSchoolExamOffice: You are not part of an exam office for this school.
|
||||
UnauthorizedSystemExamOffice: You are not charged with system wide exam administration.
|
||||
UnauthorizedSystemPrinter: You are not charged with system wide letter printing.
|
||||
UnauthorizedSystemSap: You are not charged with system wide SAP administration.
|
||||
UnauthorizedExternalExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
|
||||
UnauthorizedSchoolLecturer: You are no lecturer for this department.
|
||||
UnauthorizedLecturer: You are no administrator for this course.
|
||||
|
||||
@ -19,3 +19,4 @@ SystemExamOffice: Prüfungsverwaltung
|
||||
SystemFaculty: Fakultätsmitglied
|
||||
SystemStudent: Student:in
|
||||
SystemPrinter: Drucker:in
|
||||
SystemSap: SAP Verwalter:in
|
||||
|
||||
@ -18,4 +18,5 @@ BothSubmissions: Submission either directly in Uni2work or externally via pseudo
|
||||
SystemExamOffice: Exam office
|
||||
SystemFaculty: Faculty member
|
||||
SystemStudent: Student
|
||||
SystemPrinter: Printing staff
|
||||
SystemPrinter: Printing staff
|
||||
SystemSap: SAP Administrator
|
||||
@ -13,6 +13,7 @@ QualificationElearningStart: E-Learning automatisch starten
|
||||
TableQualificationCountActive: Aktive
|
||||
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
|
||||
TableQualificationCountTotal: Gesamt
|
||||
TableQualificationSapExport: Übermittlung SAP
|
||||
LmsQualificationValidUntil: Gültig bis
|
||||
TableQualificationLastRefresh: Zuletzt erneuert
|
||||
TableQualificationFirstHeld: Erstmalig
|
||||
|
||||
@ -13,6 +13,7 @@ QualificationElearningStart: Start e-learning automatically
|
||||
TableQualificationCountActive: Active
|
||||
TableQualificationCountActiveTooltip: Number of currently valid qualification holders
|
||||
TableQualificationCountTotal: Total
|
||||
TableQualificationSapExport: Sent to SAP
|
||||
LmsQualificationValidUntil: Valid until
|
||||
TableQualificationLastRefresh: Last renewed
|
||||
TableQualificationFirstHeld: First held
|
||||
|
||||
@ -14,6 +14,7 @@ AuthTagAdmin: Nutzer:in ist Administrator:in
|
||||
AuthTagExamOffice: Nutzer:in ist mit Prüfungsverwaltung beauftragt
|
||||
AuthTagSystemExamOffice: Nutzer:in ist mit systemweiter Prüfungsverwaltung beauftragt
|
||||
AuthTagSystemPrinter: Nutzer:in ist mit systemweiten Druck von Briefen beauftragt
|
||||
AuthTagSystemSap: Nutzer:in ist mit systemweiter SAP Schnittstellen-Administration beauftragt
|
||||
AuthTagEvaluation: Nutzer:in ist mit Kursumfragenverwaltung beauftragt
|
||||
AuthTagAllocationAdmin: Nutzer:in ist mit der Administration von Zentralanmeldungen beauftragt
|
||||
AuthTagToken: Nutzer:in präsentiert Authorisierungs-Token
|
||||
|
||||
@ -14,6 +14,7 @@ AuthTagAdmin: User is administrator
|
||||
AuthTagExamOffice: User is part of an exam office
|
||||
AuthTagSystemExamOffice: User is charged with system wide exam administration
|
||||
AuthTagSystemPrinter: User is responsible for system wide letter printing
|
||||
AuthTagSystemSap: User is responsible for system wide SAP interface administration
|
||||
AuthTagEvaluation: User is charged with course evaluation
|
||||
AuthTagAllocationAdmin: User is charged with administration of central allocations
|
||||
AuthTagToken: User is presenting an authorisation-token
|
||||
|
||||
@ -15,6 +15,7 @@ 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!
|
||||
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
|
||||
deriving Generic
|
||||
@ -56,7 +57,7 @@ QualificationUser
|
||||
lastRefresh Day -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
|
||||
firstHeld Day -- first time the qualification was earned, should never change
|
||||
blockedDue QualificationBlocked Maybe -- isJust means that the qualification is currently revoked
|
||||
-- temporärer Entzug vorsehen
|
||||
-- temporärer Entzug vorsehen -- SAP Schnittstelle muss dann angepasst werden
|
||||
-- Begründungsfeld vorsehen
|
||||
UniqueQualificationUser qualification user
|
||||
deriving Generic
|
||||
|
||||
6
routes
6
routes
@ -283,11 +283,13 @@
|
||||
/qualification QualificationAllR GET !free -- TODO repurpose
|
||||
/qualification/#SchoolId QualificationSchoolR GET !free -- TODO repurpose
|
||||
/qualification/#SchoolId/#QualificationShorthand QualificationR GET -- TODO repurpose
|
||||
/qualification/#SchoolId/#QualificationShorthand/sap/direct QualificationSAPDirectR GET !free -- TODO should not be free!
|
||||
|
||||
-- SAP export
|
||||
/qualifications/sap/direct QualificationSAPDirectR GET !system-sap
|
||||
-- OSIS CSV Export Demo
|
||||
/lms LmsAllR GET POST !free -- TODO verify that this is ok
|
||||
/lms/#SchoolId LmsSchoolR GET !free -- TODO verify that this is ok
|
||||
/lms/#SchoolId/#QualificationShorthand LmsR GET POST !free -- TODO verify that this is ok
|
||||
/lms/#SchoolId/#QualificationShorthand LmsR GET POST !free -- TODO Filtering does not work!
|
||||
/lms/#SchoolId/#QualificationShorthand/edit LmsEditR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET
|
||||
/lms/#SchoolId/#QualificationShorthand/users/direct LmsUsersDirectR GET -- development
|
||||
|
||||
@ -581,6 +581,15 @@ tagAccessPredicate AuthSystemPrinter = cacheAPSystemFunction SystemPrinter (Just
|
||||
isPrinter <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemPrinter, UserSystemFunctionIsOptOut ==. False]
|
||||
guardMExceptT isPrinter $ unauthorizedI MsgUnauthorizedSystemPrinter
|
||||
return Authorized
|
||||
tagAccessPredicate AuthSystemSap = cacheAPSystemFunction SystemSap (Just $ Right diffHour) $ \mAuthId' _ _ sapList -> if
|
||||
| maybe True (`Set.notMember` sapList) mAuthId' -> Right $ if
|
||||
| is _Nothing mAuthId' -> return AuthenticationRequired
|
||||
| otherwise -> unauthorizedI MsgUnauthorizedSystemSap
|
||||
| otherwise -> Left $ APDB $ \_ _ mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isPrinter <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemSap, UserSystemFunctionIsOptOut ==. False]
|
||||
guardMExceptT isPrinter $ unauthorizedI MsgUnauthorizedSystemSap
|
||||
return Authorized
|
||||
tagAccessPredicate AuthStudent = cacheAPSystemFunction SystemStudent (Just $ Right diffHour) $ \mAuthId' _ _ studentList -> if
|
||||
| maybe True (`Set.notMember` studentList) mAuthId' -> Right $ if
|
||||
| is _Nothing mAuthId' -> return AuthenticationRequired
|
||||
|
||||
@ -162,7 +162,7 @@ breadcrumb (QualificationSchoolR ssh ) = useRunDB . maybeT (i18nCru
|
||||
breadcrumb (QualificationR ssh qsh) =useRunDB . maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ QualificationSchoolR ssh) $ do
|
||||
guardM . lift . existsBy $ SchoolQualificationShort ssh qsh
|
||||
return (CI.original qsh, Just $ QualificationSchoolR ssh)
|
||||
breadcrumb (QualificationSAPDirectR ssh qsh) = i18nCrumb MsgMenuSap $ Just $ QualificationR ssh qsh
|
||||
breadcrumb QualificationSAPDirectR = i18nCrumb MsgMenuSap $ Just QualificationAllR -- never displayed
|
||||
|
||||
breadcrumb LmsAllR = i18nCrumb MsgMenuLms Nothing
|
||||
breadcrumb (LmsSchoolR ssh ) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool . Just $ SchoolListR) $ do -- redirect only, used in other breadcrumbs
|
||||
|
||||
@ -136,6 +136,7 @@ mkLmsAllTable = do
|
||||
-- , sortable Nothing (i18nCell MsgQualificationRefreshWithin) $ foldMap textCell . view (resultAllQualification . _qualificationRefreshWithin . to formatCalendarDiffDays) -- does not work, since there is a maybe in between
|
||||
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
|
||||
, sortable Nothing (i18nCell MsgTableQualificationSapExport) $ \(view (resultAllQualification . _qualificationSapId) -> sapid) -> tickmarkCell $ isJust sapid
|
||||
, sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
|
||||
$ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
|
||||
, sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal
|
||||
|
||||
@ -14,7 +14,7 @@ import Import
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Csv
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
-- import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Csv as Csv
|
||||
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
|
||||
-- import qualified Database.Esqueleto.Legacy as E
|
||||
@ -52,49 +52,47 @@ instance ToNamedRecord SapUserTableCsv where
|
||||
, "Ausprägung" Csv..= csvSUTausprägung
|
||||
]
|
||||
|
||||
sapRes2csv :: Text -> (Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day) -> SapUserTableCsv
|
||||
sapRes2csv qsh ( Ex.unValue -> Just persNo
|
||||
, Ex.unValue -> firstHeld
|
||||
, Ex.unValue -> validUntil
|
||||
-- , Ex.unValue -> blocked
|
||||
) =
|
||||
SapUserTableCsv -- for csv export only
|
||||
{ csvSUTpersonalNummer = persNo
|
||||
, csvSUTqualifikation = qsh
|
||||
, csvSUTgültigVon = firstHeld
|
||||
, csvSUTgültigBis = validUntil
|
||||
-- , csvSUTsupendiertBis = blocked
|
||||
, csvSUTausprägung = "J"
|
||||
}
|
||||
sapRes2csv _ _ = error "SAP CSV export failed: filtered query returned user without internal personal number."
|
||||
-- | Removes all elements containing Nothing, which should not be returend by the query anyway (only qualfications with sap id and users with internal personal number must be transmitted)
|
||||
-- TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
|
||||
sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
|
||||
sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l
|
||||
, let res = SapUserTableCsv
|
||||
{ csvSUTpersonalNummer = persNo
|
||||
, csvSUTqualifikation = sapId
|
||||
, csvSUTgültigVon = firstHeld
|
||||
, csvSUTgültigBis = validUntil
|
||||
-- , csvSUTsupendiertBis = blocked
|
||||
, csvSUTausprägung = "J"
|
||||
}
|
||||
]
|
||||
|
||||
getQualificationSAPDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
|
||||
getQualificationSAPDirectR sid qsh = do
|
||||
qualUsers <- runDB $ do
|
||||
qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
|
||||
Ex.select $ do
|
||||
(qualUser Ex.:& user) <-
|
||||
Ex.from $ Ex.table @QualificationUser `Ex.innerJoin` Ex.table @User
|
||||
`Ex.on` (\(qualUser Ex.:& user) -> qualUser Ex.^. QualificationUserUser Ex.==. user Ex.^. UserId)
|
||||
Ex.where_ $ (Ex.val qid Ex.==. qualUser Ex.^. QualificationUserQualification)
|
||||
Ex.&&. E.isJust (user Ex.^. UserCompanyPersonalNumber)
|
||||
return
|
||||
( user Ex.^. UserCompanyPersonalNumber
|
||||
, qualUser Ex.^. QualificationUserFirstHeld
|
||||
, qualUser Ex.^. QualificationUserValidUntil
|
||||
-- , qualUser Ex.^. QualificationUserBlockedDue
|
||||
)
|
||||
getQualificationSAPDirectR :: Handler TypedContent
|
||||
getQualificationSAPDirectR = do
|
||||
qualUsers <- runDB $ Ex.select $ do
|
||||
(qual Ex.:& qualUser Ex.:& user) <-
|
||||
Ex.from $ Ex.table @Qualification
|
||||
`Ex.innerJoin` Ex.table @QualificationUser
|
||||
`Ex.on` (\(qual Ex.:& qualUser) -> qual Ex.^. QualificationId Ex.==. qualUser Ex.^. QualificationUserQualification)
|
||||
`Ex.innerJoin` Ex.table @User
|
||||
`Ex.on` (\(_ Ex.:& qualUser Ex.:& user) -> qualUser Ex.^. QualificationUserUser Ex.==. user Ex.^. UserId)
|
||||
Ex.where_ $ E.isJust (qual Ex.^. QualificationSapId)
|
||||
Ex.&&. E.isJust (user Ex.^. UserCompanyPersonalNumber)
|
||||
return
|
||||
( user Ex.^. UserCompanyPersonalNumber
|
||||
, qualUser Ex.^. QualificationUserFirstHeld
|
||||
, qualUser Ex.^. QualificationUserValidUntil
|
||||
-- , qualUser Ex.^. QualificationUserBlockedDue
|
||||
, qual Ex.^. QualificationSapId
|
||||
)
|
||||
now <- liftIO getCurrentTime
|
||||
fdate <- formatTime' "%Y%m%d_%H-%M" now
|
||||
let qshOrg = CI.original qsh
|
||||
sidOrg = CI.original $ unSchoolKey sid
|
||||
csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qshOrg <$> qualUsers
|
||||
let csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qualUsers
|
||||
fmtOpts = def { csvIncludeHeader = True
|
||||
, csvDelimiter = ','
|
||||
, csvUseCrLf = True
|
||||
}
|
||||
csvOpts = def { csvFormat = fmtOpts }
|
||||
csvSheetName = "fradrive_" <> sidOrg <> "_" <> qshOrg <> "_" <> fdate <> ".csv"
|
||||
csvSheetName = "fradrive_sap_" <> fdate <> ".csv"
|
||||
nr = length qualUsers
|
||||
msg = "Qualification download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"
|
||||
$logInfoS "SAP" msg
|
||||
|
||||
@ -18,3 +18,4 @@ determineSystemFunctions ldapFuncs = \case
|
||||
-- SJ: not sure this LDAP-specific key belongs here?
|
||||
SystemStudent -> False -- "student" `Set.member` ldapFuncs -- no such key identified at FraPort
|
||||
SystemPrinter -> False -- "department=IFM-IS2" zu viele Mitglieder
|
||||
SystemSap -> False
|
||||
|
||||
@ -81,6 +81,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
|
||||
| AuthExamOffice
|
||||
| AuthSystemExamOffice
|
||||
| AuthSystemPrinter
|
||||
| AuthSystemSap
|
||||
| AuthEvaluation
|
||||
| AuthAllocationAdmin
|
||||
| AuthAllocationRegistered
|
||||
|
||||
@ -16,6 +16,7 @@ data SystemFunction
|
||||
| SystemFaculty
|
||||
| SystemStudent
|
||||
| SystemPrinter
|
||||
| SystemSap
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite, Hashable, NFData)
|
||||
|
||||
|
||||
@ -623,6 +623,10 @@ mTuple = liftA2 (,)
|
||||
-- Lists --
|
||||
-----------
|
||||
|
||||
<<<<<<< HEAD
|
||||
=======
|
||||
-- avoids some parenthesis within guards
|
||||
>>>>>>> master
|
||||
notNull :: MonoFoldable mono => mono -> Bool
|
||||
notNull = not . null
|
||||
|
||||
|
||||
@ -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
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 2 3) False
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True
|
||||
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
|
||||
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!
|
||||
|
||||
Loading…
Reference in New Issue
Block a user