chore(SAP): add SAP interface direct download
This commit is contained in:
Steffen Jost
parent
42cd3e7f08
commit
fc513e8251
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
7
routes
7
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
105
src/Handler/SAP.hs
Normal file
105
src/Handler/SAP.hs
Normal file
@ -0,0 +1,105 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
--
|
||||
-- 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
|
||||
Loading…
Reference in New Issue
Block a user