Merge branch 'master' into fradrive/api-avs

2022-11-18 20:03:43 +01:00 · 2022-11-18 20:03:43 +01:00 · 0b2fa2c197
commit 0b2fa2c197
parent 494f86a5f7 58014c3a32
20 changed files with 165 additions and 15 deletions
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -2,6 +2,14 @@

 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.

+## [26.6.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.5.14...v26.6.0) (2022-11-18)
+
+
+### Features
+
+* **footer:** add link to source code ([5a88d5c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5a88d5c41f39a45147b049985d2f59cf70daddec))
+* **implementation:** add paragraph about license (AGPL-3.0-or-later) ([d4b341b](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d4b341ba259e710a142d813ede83c209fe2fe45a))
+
 ## [26.5.14](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.5.13...v26.5.14) (2022-11-06)

 ## [26.5.13](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.5.12...v26.5.13) (2022-11-03)
--- 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
--- 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
--- a/messages/uniworx/utils/site_layout/de-de-formal.msg
+++ b/messages/uniworx/utils/site_layout/de-de-formal.msg
@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later

@ -56,3 +56,4 @@ ErrorResponseTitleInvalidArgs invalidArgs@Texts: Anfrage-Nachricht enthielt ung
 ErrorResponseTitleNotAuthenticated: Anfrage benötigt Authentifizierung
 ErrorResponseTitlePermissionDenied permissionDenied@Text: Mangelnde Authorisierung
 ErrorResponseTitleBadMethod requestMethod@Method: HTTP-Methode nicht unterstützt
+Uni2workSource: Quellcode
--- a/messages/uniworx/utils/site_layout/en-eu.msg
+++ b/messages/uniworx/utils/site_layout/en-eu.msg
@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+# SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later

@ -56,3 +56,4 @@ ErrorResponseTitleInvalidArgs invalidArgs: Request contained invalid arguments
 ErrorResponseTitleNotAuthenticated: Request requires authentication
 ErrorResponseTitlePermissionDenied permissionDenied: Permission denied
 ErrorResponseTitleBadMethod requestMethod: HTTP-method not supported
+Uni2workSource: Source code
--- a/nix/docker/demo-version.json
+++ b/nix/docker/demo-version.json
@ -1,3 +1,3 @@
 {
-  "version": "26.5.14"
+  "version": "26.6.0"
 }
--- a/nix/docker/version.json
+++ b/nix/docker/version.json
@ -1,3 +1,3 @@
 {
-  "version": "26.5.14"
+  "version": "26.6.0"
 }
--- a/package-lock.json
+++ b/package-lock.json
@ -1,6 +1,6 @@
 {
  "name": "uni2work",
-  "version": "26.5.14",
+  "version": "26.6.0",
  "lockfileVersion": 1,
  "requires": true,
  "dependencies": {
--- a/package.json
+++ b/package.json
@ -1,6 +1,6 @@
 {
  "name": "uni2work",
-  "version": "26.5.14",
+  "version": "26.6.0",
  "description": "",
  "keywords": [],
  "author": "",
--- a/package.yaml
+++ b/package.yaml
@ -1,5 +1,5 @@
 name: uniworx
-version: 26.5.14
+version: 26.6.0
 dependencies:
  - base
  - yesod
--- a/7
+++ b/7
@ -280,9 +280,10 @@
 -- !/*{CI FilePath} CryptoFileNameDispatchR GET                  !free -- Disabled until preliminary check for valid cID exists

 -- for users
-/qualification                                          QualificationAllR     GET       !free -- TODO repurpose
-/qualification/#SchoolId                                QualificationSchoolR  GET       !free -- TODO repurpose
-/qualification/#SchoolId/#QualificationShorthand        QualificationR        GET       !free -- TODO repurpose
+/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!
 -- 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
--- 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
--- 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
--- a/src/Handler/LMS/Result.hs
+++ b/src/Handler/LMS/Result.hs
@ -277,7 +277,7 @@ postLmsResultDirectR sid qsh = do
            $logWarnS "LMS" $ "Result upload failed parsing: " <> tshow e
            return (badRequest400, "Exception: " <> tshow e)
          Right nr -> do
-            let msg = "Success. LMS Result upload file " <> fileName file <> " containing " <> tshow nr <> " rows for file " <> fhead
+            let msg = "Success. LMS Result upload file " <> fileName file <> " containing " <> tshow nr <> " rows for " <> fhead <> ".  "
            $logInfoS "LMS" msg
            when (nr > 0) $ queueDBJob $ JobLmsResults qid
            return (ok200, msg)
--- a/src/Handler/LMS/Userlist.hs
+++ b/src/Handler/LMS/Userlist.hs
@ -273,7 +273,7 @@ postLmsUserlistDirectR sid qsh = do
            $logWarnS "LMS" $ "Userlist upload failed parsing: " <> tshow e
            return (badRequest400, "Exception: " <> tshow e)
          Right nr -> do
-            let msg = "Success. LMS Userlist upload file " <> fileName file <> " containing " <> tshow nr <> " rows for file " <> fhead
+            let msg = "Success. LMS Userlist upload file " <> fileName file <> " containing " <> tshow nr <> " rows for " <> fhead <> ".  "
            $logInfoS "LMS" msg 
            when (nr > 0) $ queueDBJob $ JobLmsUserlist qid
            return (ok200, msg)
--- a/src/Handler/LMS/Users.hs
+++ b/src/Handler/LMS/Users.hs
@ -181,8 +181,11 @@ getLmsUsersDirectR sid qsh = do
                    }
      csvOpts = def { csvFormat = fmtOpts }
  csvSheetName <- csvFilenameLmsUser qsh
+  let nr  = length lms_users
+      msg = "Success. LMS Users download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"  
+  $logInfoS "LMS" msg
  addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
-  csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered
+  csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered  

 -- direct Download see:
 -- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod
--- a/src/Handler/SAP.hs
+++ b/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
--- a/templates/i18n/implementation/de-de-formal.hamlet
+++ b/templates/i18n/implementation/de-de-formal.hamlet
@ -39,3 +39,14 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
    <li>Winnie Ros
    <li>Sarah Vaupel
    <li>Wolfgang Witt
+
+<p>
+  Uni2work ist freie Software.<br />
+  Der Quellcode der Uni2work-Software steht unter der #
+  <a href="https://spdx.org/licenses/AGPL-3.0-or-later.html">
+    GNU Affero General Public License (AGPL) in der Version 3.0 oder neuer
+  .
+  <br />
+  Der Quellcode der Uni2work-Software ist über folgenden Link öffentlich verfügbar: #
+  <a href="https://gitlab.com/fradrive/fradrive">
+    https://gitlab.com/fradrive/fradrive
--- a/templates/i18n/implementation/en-eu.hamlet
+++ b/templates/i18n/implementation/en-eu.hamlet
@ -38,3 +38,14 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
    <li>Winnie Ros
    <li>Sarah Vaupel
    <li>Wolfgang Witt
+
+<p>
+  Uni2work is free software.<br />
+  The source code of the Uni2work software is licensed under the #
+  <a href="https://spdx.org/licenses/AGPL-3.0-or-later.html">
+    GNU Affero General Public License (AGPL) in the version 3.0 or later
+  .
+  <br />
+  The source code of the Uni2work software is publicly available via the following link: #
+  <a href="https://gitlab.com/fradrive/fradrive">
+    https://gitlab.com/fradrive/fradrive
--- a/templates/widgets/footer/footer.hamlet
+++ b/templates/widgets/footer/footer.hamlet
@ -8,3 +8,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
  <ul .footer-links .list--inline>
    $forall n <- filter isNavFooter nav
      ^{navWidget n}
+    <li>
+      <a href="https://gitlab.com/fradrive/fradrive" target="_blank">
+        _{MsgUni2workSource}