diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index e5aee3da3..803e46860 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -139,8 +139,10 @@ MenuLmsDirectUpload: Direkter Upload MenuLmsDirectDownload: Direkter Download MenuLmsFake: Testnutzer generieren -MenuAvs: Schnittstelle AVS -MenuLdap: Schnittstelle LDAP +MenuSap: SAP Schnittstelle + +MenuAvs: AVS Schnittstelle +MenuLdap: LDAP Schnittstelle MenuApc: Druckerei MenuPrintSend: Manueller Briefversand MenuPrintDownload: Brief herunterladen diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index b70a400fd..73f58d1f3 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -140,6 +140,8 @@ MenuLmsDirectUpload: Direct Upload MenuLmsDirectDownload: Direct Download MenuLmsFake: Generate test users +MenuSap: SAP Interface + MenuAvs: AVS Interface MenuLdap: LDAP Interface MenuApc: Printing diff --git a/routes b/routes index 7a61a1665..e39abb130 100644 --- a/routes +++ b/routes @@ -275,9 +275,10 @@ -- !/*{CI FilePath} CryptoFileNameDispatchR GET !free -- Disabled until preliminary check for valid cID exists -- for users -/qualification QualificationAllR GET !free -/qualification/#SchoolId QualificationSchoolR GET !free -- TODO -/qualification/#SchoolId/#QualificationShorthand QualificationR GET -- TODO make !free again after repurpose +/qualification QualificationAllR GET !free +/qualification/#SchoolId QualificationSchoolR GET !free -- TODO +/qualification/#SchoolId/#QualificationShorthand QualificationR GET -- TODO make !free again after repurpose +/qualification/#SchoolId/#QualificationShorthand/sap/direct QualificationSAPDirectR GET !free -- TODO should not be free! -- OSIS CSV Export Demo /lms LmsAllR GET POST /lms/#SchoolId LmsSchoolR GET diff --git a/src/Application.hs b/src/Application.hs index 6ae224457..8858ecf9c 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -155,6 +155,7 @@ import Handler.Error import Handler.Upload import Handler.Qualification import Handler.LMS +import Handler.SAP import Handler.PrintCenter import Handler.ApiDocs import Handler.Swagger diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 9778226d2..7d7aae36c 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -162,6 +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 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/SAP.hs b/src/Handler/SAP.hs new file mode 100644 index 000000000..567e7fd21 --- /dev/null +++ b/src/Handler/SAP.hs @@ -0,0 +1,105 @@ +-- SPDX-FileCopyrightText: 2022 Steffen Jost +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +{-# LANGUAGE TypeApplications #-} + +module Handler.SAP + ( getQualificationSAPDirectR + ) + where + +import Import + +import Handler.Utils +import Handler.Utils.Csv + +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 +import qualified Database.Esqueleto.Utils as E + + +data SapUserTableCsv = SapUserTableCsv -- for csv export only + { csvSUTpersonalNummer :: Text + , csvSUTqualifikation :: Text + , csvSUTgültigVon :: Day + , csvSUTgültigBis :: Day + -- , csvSUTsupendiertBis :: Maybe Day + , csvSUTausprägung :: Text + } + deriving (Show, Generic) +makeLenses_ ''SapUserTableCsv + +sapUserTableCsvHeader :: Csv.Header +sapUserTableCsvHeader = Csv.header + [ "PersonalNummer" + , "Qualifikation" + , "GültigVon" + , "GültigBis" + -- , "SupendiertBis" + , "Ausprägung" + ] + +instance ToNamedRecord SapUserTableCsv where + toNamedRecord SapUserTableCsv{..} = Csv.namedRecord + [ "PersonalNummer" Csv..= csvSUTpersonalNummer + , "Qualifikation" Csv..= csvSUTqualifikation + , "GültigVon" Csv..= csvSUTgültigVon + , "GültigBis" Csv..= csvSUTgültigBis + -- , "SupendiertBis" Csv..= csvSUTsupendiertBis + , "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." + +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 + ) + 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 + fmtOpts = def { csvIncludeHeader = True + , csvDelimiter = ',' + , csvUseCrLf = True + } + csvOpts = def { csvFormat = fmtOpts } + csvSheetName = "fradrive_" <> sidOrg <> "_" <> qshOrg <> "_" <> fdate <> ".csv" + nr = length qualUsers + msg = "Qualification download file " <> csvSheetName <> " containing " <> tshow nr <> " rows" + $logInfoS "SAP" msg + addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\"" + csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered + +-- direct Download see: +-- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod \ No newline at end of file