chore(SAP): add SAP interface direct download

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
+MenuSap: SAP Schnittstelle
-MenuLdap: Schnittstelle LDAP
+
+MenuAvs: AVS Schnittstelle
+MenuLdap: LDAP Schnittstelle
 MenuApc: Druckerei
 MenuPrintSend: Manueller Briefversand
 MenuPrintDownload: Brief herunterladen

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

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                                              QualificationAllR         GET   !free
-/qualification/#SchoolId                                QualificationSchoolR  GET       !free -- TODO
+/qualification/#SchoolId                                    QualificationSchoolR      GET   !free -- TODO
-/qualification/#SchoolId/#QualificationShorthand        QualificationR        GET       -- TODO make !free again after repurpose
+/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

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

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

src/Handler/SAP.hs

@@ -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