diff --git a/messages/uniworx/categories/authorization/de-de-formal.msg b/messages/uniworx/categories/authorization/de-de-formal.msg
index 15d5204e6..676809a3d 100644
--- a/messages/uniworx/categories/authorization/de-de-formal.msg
+++ b/messages/uniworx/categories/authorization/de-de-formal.msg
@@ -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.
diff --git a/messages/uniworx/categories/authorization/en-eu.msg b/messages/uniworx/categories/authorization/en-eu.msg
index 79a050879..6258809ae 100644
--- a/messages/uniworx/categories/authorization/en-eu.msg
+++ b/messages/uniworx/categories/authorization/en-eu.msg
@@ -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.
diff --git a/messages/uniworx/categories/model_types/de-de-formal.msg b/messages/uniworx/categories/model_types/de-de-formal.msg
index e35979178..be3831b8a 100644
--- a/messages/uniworx/categories/model_types/de-de-formal.msg
+++ b/messages/uniworx/categories/model_types/de-de-formal.msg
@@ -19,3 +19,4 @@ SystemExamOffice: Prüfungsverwaltung
SystemFaculty: Fakultätsmitglied
SystemStudent: Student:in
SystemPrinter: Drucker:in
+SystemSap: SAP Verwalter:in
diff --git a/messages/uniworx/categories/model_types/en-eu.msg b/messages/uniworx/categories/model_types/en-eu.msg
index fe2c2418f..eafba769a 100644
--- a/messages/uniworx/categories/model_types/en-eu.msg
+++ b/messages/uniworx/categories/model_types/en-eu.msg
@@ -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
\ No newline at end of file
+SystemPrinter: Printing staff
+SystemSap: SAP Administrator
\ No newline at end of file
diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg
index 66318e9ef..90bae767b 100644
--- a/messages/uniworx/categories/qualification/de-de-formal.msg
+++ b/messages/uniworx/categories/qualification/de-de-formal.msg
@@ -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
diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg
index 88410dd8e..e08692dc9 100644
--- a/messages/uniworx/categories/qualification/en-eu.msg
+++ b/messages/uniworx/categories/qualification/en-eu.msg
@@ -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
diff --git a/messages/uniworx/categories/settings/auth_settings/de-de-formal.msg b/messages/uniworx/categories/settings/auth_settings/de-de-formal.msg
index bc0ccf58e..2def8f846 100644
--- a/messages/uniworx/categories/settings/auth_settings/de-de-formal.msg
+++ b/messages/uniworx/categories/settings/auth_settings/de-de-formal.msg
@@ -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
diff --git a/messages/uniworx/categories/settings/auth_settings/en-eu.msg b/messages/uniworx/categories/settings/auth_settings/en-eu.msg
index 5f61881c0..241b7dfa1 100644
--- a/messages/uniworx/categories/settings/auth_settings/en-eu.msg
+++ b/messages/uniworx/categories/settings/auth_settings/en-eu.msg
@@ -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
diff --git a/models/lms.model b/models/lms.model
index a245e3dc2..cd34de744 100644
--- a/models/lms.model
+++ b/models/lms.model
@@ -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
diff --git a/routes b/routes
index a2ebbe640..435ca94d3 100644
--- a/routes
+++ b/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
diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs
index e792dcbde..e94fdefa4 100644
--- a/src/Foundation/Authorization.hs
+++ b/src/Foundation/Authorization.hs
@@ -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
diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs
index ed2f7634d..b17708671 100644
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@@ -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
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index 858a26e9a..5c5c7a191 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -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
diff --git a/src/Handler/SAP.hs b/src/Handler/SAP.hs
index 567e7fd21..513070a82 100644
--- a/src/Handler/SAP.hs
+++ b/src/Handler/SAP.hs
@@ -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
diff --git a/src/Handler/Utils/LdapSystemFunctions.hs b/src/Handler/Utils/LdapSystemFunctions.hs
index ada89b1b8..7cb61a503 100644
--- a/src/Handler/Utils/LdapSystemFunctions.hs
+++ b/src/Handler/Utils/LdapSystemFunctions.hs
@@ -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
diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs
index 1cb81cbb3..e6811c8ed 100644
--- a/src/Model/Types/Security.hs
+++ b/src/Model/Types/Security.hs
@@ -81,6 +81,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
| AuthExamOffice
| AuthSystemExamOffice
| AuthSystemPrinter
+ | AuthSystemSap
| AuthEvaluation
| AuthAllocationAdmin
| AuthAllocationRegistered
diff --git a/src/Model/Types/User.hs b/src/Model/Types/User.hs
index a94e81fce..d39016797 100644
--- a/src/Model/Types/User.hs
+++ b/src/Model/Types/User.hs
@@ -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)
diff --git a/src/Utils.hs b/src/Utils.hs
index f3eb3f693..775304a4d 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -623,6 +623,10 @@ mTuple = liftA2 (,)
-- Lists --
-----------
+<<<<<<< HEAD
+=======
+-- avoids some parenthesis within guards
+>>>>>>> master
notNull :: MonoFoldable mono => mono -> Bool
notNull = not . null
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index 832176b31..0706aaa29 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
- 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!