Merge branch 'master' into fradrive/api-avs

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.

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.

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

messages/uniworx/categories/model_types/en-eu.msg

@@ -19,3 +19,4 @@ SystemExamOffice: Exam office
 SystemFaculty: Faculty member
 SystemStudent: Student
 SystemPrinter: Printing staff
+SystemSap: SAP Administrator

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

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

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

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

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

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

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

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

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

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
+-- | 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)
-sapRes2csv qsh  ( Ex.unValue -> Just persNo
+--   TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
-                , Ex.unValue -> firstHeld
+sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
-                , Ex.unValue -> validUntil
+sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l 
-                --  , Ex.unValue -> blocked
+               , let res = SapUserTableCsv
-                ) = 
+                            { csvSUTpersonalNummer = persNo
-  SapUserTableCsv -- for csv export only
+                            , csvSUTqualifikation  = sapId
-    { csvSUTpersonalNummer = persNo
+                            , csvSUTgültigVon      = firstHeld
-    , csvSUTqualifikation  = qsh
+                            , csvSUTgültigBis      = validUntil
-    , csvSUTgültigVon      = firstHeld
+                            -- , csvSUTsupendiertBis  = blocked
-    , csvSUTgültigBis      = validUntil
+                            , csvSUTausprägung     = "J"
-    -- , csvSUTsupendiertBis  = blocked
+                            }
-    , csvSUTausprägung     = "J"
+               ]
-    }
-sapRes2csv _  _ = error "SAP CSV export failed: filtered query returned user without internal personal number."
 
-getQualificationSAPDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
+getQualificationSAPDirectR :: Handler TypedContent
-getQualificationSAPDirectR sid qsh = do
+getQualificationSAPDirectR = do
-  qualUsers <- runDB $ do
+  qualUsers <- runDB $ Ex.select $ do
-    qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
+    (qual Ex.:& qualUser Ex.:& user) <- 
-    Ex.select $ do
+      Ex.from $ Ex.table @Qualification 
-      (qualUser Ex.:& user) <- 
+      `Ex.innerJoin` Ex.table @QualificationUser
-        Ex.from $ Ex.table @QualificationUser `Ex.innerJoin` Ex.table @User
+      `Ex.on` (\(qual Ex.:& qualUser) -> qual Ex.^. QualificationId Ex.==. qualUser Ex.^. QualificationUserQualification)
-        `Ex.on` (\(qualUser Ex.:& user) -> qualUser Ex.^. QualificationUserUser Ex.==. user Ex.^. UserId)
+      `Ex.innerJoin` Ex.table @User
-      Ex.where_ $ (Ex.val qid Ex.==. qualUser Ex.^. QualificationUserQualification)
+      `Ex.on` (\(_ Ex.:& qualUser Ex.:& user) -> qualUser Ex.^. QualificationUserUser Ex.==. user Ex.^. UserId)
-          Ex.&&. E.isJust (user Ex.^. UserCompanyPersonalNumber)
+    Ex.where_ $ E.isJust (qual Ex.^. QualificationSapId)
-      return 
+        Ex.&&.  E.isJust (user Ex.^. UserCompanyPersonalNumber)
-        ( user      Ex.^. UserCompanyPersonalNumber
+    return 
-        , qualUser  Ex.^. QualificationUserFirstHeld
+      ( user      Ex.^. UserCompanyPersonalNumber
-        , qualUser  Ex.^. QualificationUserValidUntil
+      , qualUser  Ex.^. QualificationUserFirstHeld
-        -- , qualUser  Ex.^. QualificationUserBlockedDue
+      , 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
+  let csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qualUsers
-      sidOrg = CI.original $ unSchoolKey sid
-      csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qshOrg <$> 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

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

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

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)
 

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
 

test/Database/Fill.hs

@@ -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_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
+  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
+  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!