Merge branch 'master' into fradrive/company

CHANGELOG.md

@@ -2,6 +2,15 @@
 
 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.
 
+## [27.4.42](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.41...v27.4.42) (2023-10-12)
+
+
+### Bug Fixes
+
+* **build:** Update ParticipantInvite.hs ([f888da3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f888da3ab0df45bb3c515ebb7cbb43569fdaa1fa))
+* **build:** Update ParticipantInvite.hs ([fa4f9b2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fa4f9b24475261afc1e534541c8878a85e6a1b10))
+* **build:** Update Utils.hs ([87f0b2e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/87f0b2edab2bcf696b7b776e47272ef2204c0b75))
+
 ## [27.4.41](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.40...v27.4.41) (2023-10-04)
 
 

nix/docker/version.json

@@ -1,3 +1,3 @@
 {
-  "version": "27.4.41"
+  "version": "27.4.42"
 }

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "27.4.41",
+  "version": "27.4.42",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "27.4.41",
+  "version": "27.4.42",
   "description": "",
   "keywords": [],
   "author": "",

package.yaml

@@ -1,5 +1,5 @@
 name: uniworx
-version: 27.4.41
+version: 27.4.42
 dependencies:
   - base
   - yesod

src/Handler/Course/ParticipantInvite.hs

@@ -49,11 +49,19 @@ tutorialTemplateNames Nothing     = ["Vorlage", "Template"]
 tutorialTemplateNames (Just name) = [prefixes <> suffixes | prefixes <- tutorialTemplateNames Nothing, suffixes <- [mempty, tutorialTypeSeparator <> name]]
 
 tutorialDefaultName :: Maybe TutorialType -> Day -> TutorialName
-tutorialDefaultName Nothing     = string2citext . formatTime defaultTimeLocale "%y_%m_%d" -- Don't use user date display setting, so that tutorial default names conform to all users
+tutorialDefaultName Nothing     = formatDayForTutName 
 tutorialDefaultName (Just ttyp) = 
   let prefix = CI.mk $ snd $ Text.breakOnEnd (CI.original tutorialTypeSeparator) $ CI.original ttyp
   in  (<> (tutorialTypeSeparator <> prefix)) . tutorialDefaultName Nothing
 
+formatDayForTutName :: Day -> CI Text -- "%yy_%mm_%dd" -- Do not use user date display setting, since tutorial default names must be universal regardless of user
+-- formatDayForTutName = CI.mk . formatTime' "%y_%m_%d" -- we don't want to go monadic for this
+formatDayForTutName = CI.mk . Text.map d2u . Text.drop 2 . tshow 
+  where 
+    d2u '-' = '_'
+    d2u  c  =  c
+
+
 data ButtonCourseRegisterMode = BtnCourseRegisterConfirm | BtnCourseRegisterAbort
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 instance Universe ButtonCourseRegisterMode

src/Handler/SAP.hs

@@ -56,8 +56,8 @@ instance ToNamedRecord SapUserTableCsv where
 
 -- | Removes all personalNummer which are not numbers between 10000 and 99999 (also excludes E-Accounts), which should not be returned by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted)
 --   TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
-sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
-sapRes2csv l = [ res | (Ex.Value pn@(Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l 
+sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text), Maybe (Entity QualificationUserBlock))] -> [SapUserTableCsv]
+sapRes2csv l = [ res | (Ex.Value pn@(Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId), mbQualUserBlock) <- l 
                 --  , let persNoAsInt = readMay =<< persNo -- also see Handler.Utils.Profile.validFraportPersonalNumber
                 --  , persNoAsInt >= Just (10000::Int)       -- filter E-accounts for SAP export
                 --  , persNoAsInt <= Just (99999::Int)       -- filter E-accounts for SAP export                                                     
@@ -65,12 +65,16 @@ sapRes2csv l = [ res | (Ex.Value pn@(Just persNo), Ex.Value firstHeld, Ex.Value
                             { csvSUTpersonalNummer = persNo
                             , csvSUTqualifikation  = sapId
                             , csvSUTgültigVon      = firstHeld
-                            , csvSUTgültigBis      = validUntil
+                            , csvSUTgültigBis      = getMaxValidDay mbQualUserBlock validUntil
                             -- , csvSUTsupendiertBis  = blocked
                             , csvSUTausprägung     = "J"
                             }
                 , validFraportPersonalNumber pn
                ]
+  where
+    getMaxValidDay :: Maybe (Entity QualificationUserBlock) -> Day -> Day
+    getMaxValidDay (Just Entity{entityVal=QualificationUserBlock{qualificationUserBlockUnblock=False, qualificationUserBlockFrom=bd}}) = min $ utctDay bd
+    getMaxValidDay _ = id
 
 -- | Deliver all employess with a successful LDAP synch within the last 3 months
 getQualificationSAPDirectR :: Handler TypedContent
@@ -79,12 +83,17 @@ getQualificationSAPDirectR = do
   fdate <- formatTime' "%Y%m%d_%H-%M" now 
   let ldap_cutoff = addDiffDaysRollOver (fromMonths $ -3) now
   qualUsers <- runDB $ Ex.select $ do
-    (qual :& qualUser :& user) <- 
+    (qual :& qualUser :& user :& qualBlock) <- 
       Ex.from $ Ex.table @Qualification 
       `Ex.innerJoin` Ex.table @QualificationUser
       `Ex.on` (\(qual :& qualUser) -> qual Ex.^. QualificationId Ex.==. qualUser Ex.^. QualificationUserQualification)
       `Ex.innerJoin` Ex.table @User
       `Ex.on` (\(_ :& qualUser :& user) -> qualUser Ex.^. QualificationUserUser Ex.==. user Ex.^. UserId)
+      `Ex.leftJoin` Ex.table @QualificationUserBlock
+      `Ex.on` (\(_ :& qualUser :& _ :& qualBlock) -> 
+                  qualBlock Ex.?. QualificationUserBlockQualificationUser E.?=. qualUser Ex.^. QualificationUserId
+          Ex.&&.  qualBlock `isLatestBlockBefore` Ex.val now
+        )
     Ex.where_ $ E.isJust (qual Ex.^. QualificationSapId)
         Ex.&&.  E.isJust (user Ex.^. UserCompanyPersonalNumber)
         Ex.&&.  E.isJust (user Ex.^. UserLastLdapSynchronisation)
@@ -95,6 +104,7 @@ getQualificationSAPDirectR = do
       , qualUser  Ex.^. QualificationUserValidUntil
       -- , qualUser  Ex.^. QualificationUserBlockedDue
       , qual      Ex.^. QualificationSapId
+      , qualBlock
       )    
   let csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qualUsers
       fmtOpts = (review csvPreset CsvPresetRFC)