Merge branch 'fradrive/cr3'

messages/uniworx/misc/de-de-formal.msg

@@ -15,7 +15,7 @@ WeekDay: Wochentag
 LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
 Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
 Days num@Int64: #{num} #{pluralDE num "Tag" "Tage"}
-NoAutomaticUpdateTip: Dieser Wert wurde manuell editiert und wird daher nicht mehr automatisch aktualisiert.
+NoAutomaticUpdateTip: Dieser Wert wurde manuell editiert und wird daher nicht mehr automatisch durch as AVS aktualisiert.
 
 ClusterVolatileQuickActionsEnabled: Schnellzugriffsmenü aktiv
 

messages/uniworx/misc/en-eu.msg

@@ -15,7 +15,7 @@ WeekDay: Day of the week
 LdapIdentificationOrEmail: Fraport AG-Kennung / email address
 Months num: #{num} #{pluralEN num "Month" "Months"}
 Days num: #{num} #{pluralEN num "Day" "Days"}
-NoAutomaticUpdateTip: This value receives no automatic updates, since it has been edited manually.
+NoAutomaticUpdateTip: This particular value receives no automatic AVS updates, since it has been edited manually.
 
 ClusterVolatileQuickActionsEnabled: Quick actions enabled
 

src/Data/CaseInsensitive/Instances.hs

@@ -128,4 +128,4 @@ instance Swagger.ToSchema s => Swagger.ToSchema (CI s) where
 
 instance (CI.FoldCase s, Binary s) => Binary (CI s) where
   get = CI.mk <$> Binary.get
-  put = Binary.put . CI.original
+  put = Binary.put . CI.original

src/Handler/Profile.hs

@@ -21,6 +21,7 @@ module Handler.Profile
 import Import
 
 import Handler.Utils
+import Handler.Utils.AvsUpdate
 import Handler.Utils.Avs
 import Handler.Utils.Profile
 import Handler.Utils.Users
@@ -588,9 +589,13 @@ getForProfileDataR cID = do
     dataWidget
 
 makeProfileData :: Entity User -> DB Widget
-makeProfileData usrEnt@(Entity uid User{..}) = do
+makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
-  now <- liftIO getCurrentTime
+  now <- liftIO getCurrentTime 
   avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
+  let usrAutomatic :: forall t . EntityField User t -> Widget
+      usrAutomatic upd = updateAutomatic $ maybe False (mayUpdate usrVal (avsId ^? _Just . _userAvsLastPersonInfo . _Just)) $ getUserPersonUpd upd
+      -- usrAutomatic upd = updateAutomatic $ maybe False (mayUpdate usrVal avsId) $ getUserAvsUpd upd      
+
   (actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt
   functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
   lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do

src/Handler/Utils/Avs.hs

@@ -4,8 +4,6 @@
 
 {-# LANGUAGE TypeApplications, ExistentialQuantification #-}
 
-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
-
 -- Module for functions directly related to the AVS interface,
 -- for utilities dealing with FraDrive Qualification types see Handler.Utils.Qualification
 -- NOTE: Several ifdef DEVELOPMENT used, so UNSET DEVELOPMENT and build before comitting.
@@ -30,7 +28,7 @@ module Handler.Utils.Avs
   , AvsPersonIdMapPersonCard
   -- CR3 
   , SomeAvsQuery(..)
-  , queryAvsCardNo, queryAvsCardNos
+  , queryAvsCardNo, queryAvsCardNos  
   ) where
 
 import Import
@@ -57,6 +55,7 @@ import Handler.Utils.Users
 import Handler.Utils.Company
 import Handler.Utils.Qualification
 import Handler.Utils.Memcached
+import Handler.Utils.AvsUpdate
 
 import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
@@ -66,7 +65,6 @@ import qualified Database.Esqueleto.PostgreSQL   as E
 import Servant.Client.Core.ClientError (ClientError)
 
 
-
 --------------------
 -- AVS Exceptions --
 --------------------
@@ -323,6 +321,7 @@ updateAvsUserByIds' apids = do
       catchAll (runDB updateAvsUserByADC') errHandler
       
 
+
 updateAvsUserByADC :: AvsDataContact -> DB (Maybe (AvsPersonId, UserId))
 updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMaybeT $ do
       (Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid      
@@ -355,26 +354,26 @@ updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMa
                               ( CheckUpdate UserLdapPrimaryKey         $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just)
                               [ CheckUpdate UserCompanyPersonalNumber  $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
                               ]
-        let per_ups = mapMaybe (mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo)
+        let per_ups = mapMaybe (mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo) $ catMaybes
-                      [ CheckUpdate UserFirstName                _avsInfoFirstName
+                      [ getUserPersonUpd UserFirstName            
-                      , CheckUpdate UserSurname                  _avsInfoLastName
+                      , getUserPersonUpd UserSurname              
-                      , CheckUpdate UserDisplayName              _avsInfoDisplayName
+                      , getUserPersonUpd UserDisplayName          
-                      , CheckUpdate UserBirthday                 _avsInfoDateOfBirth
+                      , getUserPersonUpd UserBirthday             
-                      , CheckUpdate UserMobile                   _avsInfoPersonMobilePhoneNo
+                      , getUserPersonUpd UserMobile               
-                      , CheckUpdate UserMatrikelnummer         $ _avsInfoPersonNo . re _Just                                              -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
+                      , getUserPersonUpd UserMatrikelnummer       
-                      -- , CheckUpdate UserCompanyPersonalNumber  $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups above
+                      -- , getUserPersonUpd UserCompanyPersonalNumber -- needs special treatment, see ldap_ups above
                       ]
-            apiEmail = _avsInfoPersonEMail  . to (fromMaybe mempty) . from _CI
+            apiEmail = _avsInfoPersonEMail  . _Just . from _CI
-            afiEmail = _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
+            afiEmail = _avsFirmPrimaryEmail . _Just . from _CI
-            em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo  $ CheckUpdate UserDisplayEmail apiEmail                            -- Maybe im AvsInfo, aber nicht im User
+            em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo  $ CheckUpdateOpt UserDisplayEmail apiEmail                         -- Maybe im AvsInfo, aber nicht im User
-            em_f_up = mkUpdate' usr newAvsFirmInfo   oldAvsFirmInfo    $ CheckUpdate UserDisplayEmail afiEmail                            -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.          
+            em_f_up = mkUpdate' usr newAvsFirmInfo   oldAvsFirmInfo    $ CheckUpdateOpt UserDisplayEmail afiEmail                         -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.          
             eml_up                                                                                                                        -- Ensure that only one email update is produced; there is no Eq instance for the Update type
-              | isJust em_f_up, mempty == newAvsFirmInfo   ^. afiEmail                                                                    -- Was some FirmEmail, but this is no longer the case; update to PersonalEmail, if possible
+              | isJust em_f_up, isNothing (newAvsFirmInfo   ^? afiEmail)                                                                  -- Was some FirmEmail, but this is no longer the case; update to PersonalEmail, if possible
-                = mkUpdate' usr newAvsPersonInfo Nothing $ CheckUpdate UserDisplayEmail apiEmail
+                = mkUpdate' usr newAvsPersonInfo Nothing $ CheckUpdateOpt UserDisplayEmail apiEmail
               | isJust em_f_up                                                                                                            -- Update FirmEmail
                 = em_f_up
-              | isJust em_p_up, mempty == newAvsPersonInfo ^. apiEmail                                                                    -- Was PersonalEmai, but this is no longer the case; update to FirmEmail, if possible
+              | isJust em_p_up, isNothing (newAvsPersonInfo ^? apiEmail)                                                                  -- Was PersonalEmai, but this is no longer the case; update to FirmEmail, if possible
-                = mkUpdate' usr newAvsFirmInfo   Nothing $ CheckUpdate UserDisplayEmail afiEmail
+                = mkUpdate' usr newAvsFirmInfo   Nothing $ CheckUpdateOpt UserDisplayEmail afiEmail
               | otherwise                                                                                                                 -- Maybe update PersonalEmail                
                   = em_p_up                                           
             frm_up  = mkUpdate' usr newAvsFirmInfo   oldAvsFirmInfo    $                                                                  -- Legacy, if company postal is stored in user; should no longer be true for new users,

src/Handler/Utils/AvsUpdate.hs

@@ -0,0 +1,70 @@
+-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+{-# OPTIONS_GHC -fno-warn-unused-top-binds -fno-warn-orphans #-}
+
+-- Module for Template Haskell functions to be executed at compile time
+-- to allow safe static partial functions
+
+module Handler.Utils.AvsUpdate
+    ( getUserPersonUpd 
+    , getUserAvsUpd
+    ) where
+
+
+import Import
+
+-- import Language.Haskell.TH.Lift
+-- import Language.Haskell.TH.Syntax
+
+--  import Utils.Avs
+
+deriving instance Lift (EntityField User typ)
+
+-- instance Lift (CheckUpdate record iraw) where
+--     -- liftTyped :: forall (m :: Type -> Type). Quote m => t -> Code m t
+--     lift = $(makeLift ''CheckUpdate)
+
+-- No Lift instance for lenses:
+-- type Getting r s a = (a -> Const r a) -> s -> Const r s
+-- deriving instance Lift (Getting typ AvsPersonInfo typ)
+-- deriving instance Lift (Getting (First typ) AvsPersonInfo typ)
+-- deriving instance Lift (CheckUpdate User AvsPersonInfo)
+
+-- mkUsrPerUpd upd = getUserPersonUpd $$(liftTyped upd)
+
+-- maybe use a TypeFamily?
+getUserPersonUpd :: EntityField User t -> Maybe (CheckUpdate User AvsPersonInfo)
+getUserPersonUpd UserFirstName             = Just $ CheckUpdate     UserFirstName               _avsInfoFirstName
+getUserPersonUpd UserSurname               = Just $ CheckUpdate     UserSurname                 _avsInfoLastName
+getUserPersonUpd UserDisplayName           = Just $ CheckUpdate     UserDisplayName             _avsInfoDisplayName
+getUserPersonUpd UserBirthday              = Just $ CheckUpdate     UserBirthday                _avsInfoDateOfBirth
+getUserPersonUpd UserMobile                = Just $ CheckUpdate     UserMobile                  _avsInfoPersonMobilePhoneNo
+getUserPersonUpd UserMatrikelnummer        = Just $ CheckUpdate     UserMatrikelnummer        $ _avsInfoPersonNo . re _Just                                              -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
+getUserPersonUpd UserCompanyPersonalNumber = Just $ CheckUpdate     UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
+getUserPersonUpd UserLdapPrimaryKey        = Just $ CheckUpdate     UserLdapPrimaryKey        $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
+getUserPersonUpd UserDisplayEmail          = Just $ CheckUpdateOpt  UserDisplayEmail          $ _avsInfoPersonEMail  . _Just . from _CI
+getUserPersonUpd _ = Nothing -- error "Handler.Utils.AvsUpdate.getPersonUserUpd received unknown argument. This should only occur at compile time."
+
+
+-- -- more general than userPersonUpd, starting at UserAvs instead of AvsPersonInfo
+getUserAvsUpd :: EntityField User t -> Maybe (CheckUpdate User UserAvs)
+getUserAvsUpd UserPinPassword           = Just $ CheckUpdateOpt  UserPinPassword $ _userAvsLastCardNo . _Just . to avsFullCardNo2pin . re _Just
+getUserAvsUpd UserPostAddress           = Just $ CheckUpdateOpt  UserPostAddress $ _userAvsLastFirmInfo . _Just . _avsFirmPostAddress
+getUserAvsUpd UserFirstName             = Just $ CheckUpdateOpt  UserFirstName             $ _userAvsLastPersonInfo . _Just . _avsInfoFirstName
+getUserAvsUpd UserSurname               = Just $ CheckUpdateOpt  UserSurname               $ _userAvsLastPersonInfo . _Just . _avsInfoLastName
+getUserAvsUpd UserDisplayName           = Just $ CheckUpdateOpt  UserDisplayName           $ _userAvsLastPersonInfo . _Just . _avsInfoDisplayName
+getUserAvsUpd UserBirthday              = Just $ CheckUpdateOpt  UserBirthday              $ _userAvsLastPersonInfo . _Just . _avsInfoDateOfBirth
+getUserAvsUpd UserMobile                = Just $ CheckUpdateOpt  UserMobile                $ _userAvsLastPersonInfo . _Just . _avsInfoPersonMobilePhoneNo
+getUserAvsUpd UserMatrikelnummer        = Just $ CheckUpdateOpt  UserMatrikelnummer        $ _userAvsLastPersonInfo . _Just . _avsInfoPersonNo . re _Just                                              -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
+getUserAvsUpd UserCompanyPersonalNumber = Just $ CheckUpdateOpt  UserCompanyPersonalNumber $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
+getUserAvsUpd UserLdapPrimaryKey        = Just $ CheckUpdateOpt  UserLdapPrimaryKey        $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
+getUserAvsUpd UserDisplayEmail          = Just $ CheckUpdateOpt  UserDisplayEmail          $ _userAvsLastPersonInfo . _Just . _avsInfoPersonEMail  . _Just . from _CI
+{- Type system does not manage:
+getUserAvsUpd ent 
+    -- | Just (CheckUpdate _ pl) <- getUserPersonUpd ent
+    --     = Just $ CheckUpdateOpt ent $ _userAvsLastPersonInfo . _Just . pl
+    | Just (CheckUpdateOpt _ pl) <- getUserPersonUpd ent
+        = Just $ CheckUpdateOpt ent $ _userAvsLastPersonInfo . _Just . pl
+-}        
+getUserAvsUpd _ = Nothing

src/Utils/Avs.hs

@@ -86,9 +86,9 @@ mkAvsQuery _ _ _ = AvsQuery
     fakePerson :: AvsQueryPerson -> AvsResponsePerson
     fakePerson = 
       let
-        sarah   = Set.singleton $ AvsDataPerson "Sarah"   "Vaupel"  Nothing            2 (AvsPersonId        2) mempty
+        sarah    = Set.singleton $ AvsDataPerson "Sarah"   "Vaupel"  Nothing            2 (AvsPersonId        2) mempty
-        stephan = Set.singleton $ AvsDataPerson "Stephan" "Barth"   Nothing            4 (AvsPersonId        4) mempty
+        stephan  = Set.singleton $ AvsDataPerson "Stephan" "Barth"   Nothing            4 (AvsPersonId        4) mempty
-        steffen = Set.singleton $ AvsDataPerson "Steffen" "Jost" (Just $ mkAvsInternalPersonalNo "47138") 12345678 (AvsPersonId 12345678) mempty
+        steffen  = Set.singleton $ AvsDataPerson "Steffen" "Jost" (Just $ mkAvsInternalPersonalNo "47138") 12345678 (AvsPersonId 12345678) mempty
         sumpfi1  = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 12345678) mempty
         sumpfi2  = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604387) mempty
         sumpfi3  = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604591) mempty
@@ -112,7 +112,7 @@ mkAvsQuery _ _ _ = AvsQuery
         ]
     fakeStatus  _ = AvsResponseStatus mempty
     fakeContact :: AvsQueryContact -> AvsResponseContact
-    fakeContact (AvsQueryContact (Set.toList -> ((AvsObjPersonId api):_))) = AvsResponseContact $ Set.singleton $ AvsDataContact api (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Fraport AG" 7 "Fraport" Nothing Nothing Nothing Nothing Nothing Nothing Nothing)
+    fakeContact (AvsQueryContact (Set.toList -> ((AvsObjPersonId api):_))) = AvsResponseContact $ Set.singleton $ AvsDataContact api (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing (Just "jost@tcs.ifi.lmu.de") Nothing) (AvsFirmInfo "Fraport AG" 7 "Fraport" Nothing Nothing Nothing Nothing Nothing Nothing Nothing)
     fakeContact _ = AvsResponseContact mempty
 #else
 mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery

src/Utils/DB.hs

@@ -8,6 +8,7 @@ module Utils.DB where
 
 import ClassyPrelude.Yesod hiding (addMessageI)
 
+import qualified Data.Monoid as Monoid (First())
 import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -25,6 +26,8 @@ import Database.Persist.Sql (runSqlConn) -- , updateWhereCount)
 
 import GHC.Stack (HasCallStack, CallStack, callStack)
 
+-- import Language.Haskell.TH.Lift
+
 -- import Control.Monad.Fix (MonadFix)
 -- import Control.Monad.Fail (MonadFail)
 
@@ -335,8 +338,26 @@ instance WithRunDB backend m (ReaderT backend m) where
 
 
 -- A datatype for a specific heterogeneous list to compute DB updates, consisting of a persistent record field and a fitting lens
-data CheckUpdate record iraw = forall typ. (Eq typ, PersistField typ) => CheckUpdate (EntityField record typ) (Getting typ iraw typ) -- A persistent record field and fitting getting
+data CheckUpdate record iraw = 
+    forall typ. (Eq typ, PersistField typ) => 
+    CheckUpdate     (EntityField record typ) (Getting               typ  iraw typ) -- A persistent record field and fitting getting (also use for typ ~ Maybe typ')
+  | forall typ. (Eq typ, PersistField typ) => 
+    CheckUpdateOpt  (EntityField record typ) (Getting (Monoid.First typ) iraw typ) -- Special case, when `typ` is optional for the lens, but not optional in DB.
 
+-- deriving instance Lift (CheckUpdate record iraw) -- not possible
+-- instance Lift (CheckUpdate record iraw) where
+--   lift = $(makeLift ''CheckUpdate)
+
+mayUpdate :: PersistEntity record => record -> Maybe iraw -> CheckUpdate record iraw -> Bool
+mayUpdate ent (Just old) (CheckUpdate up l)
+  | let oldval = old ^. l
+  , let entval = ent ^. fieldLensVal up
+    = oldval == entval    
+mayUpdate ent (Just old) (CheckUpdateOpt up l)
+  | Just oldval <- old ^? l
+  , let entval = ent ^. fieldLensVal up
+    = oldval == entval    
+mayUpdate _ _ _ = False
 
 -- | Compute necessary updates. Given a database record, the new and old raw data, and a pair consisting of a getter from raw data to a value and an EntityField of the same value,
 --   an update is returned, if the current value is identical to the old value, which changed in the new raw data
@@ -348,6 +369,13 @@ mkUpdate ent new (Just old) (CheckUpdate up l)
   , newval /= entval
   , oldval == entval
     = Just (up =. newval)
+mkUpdate ent new (Just old) (CheckUpdateOpt up l)
+  | Just newval <- new ^? l
+  , Just oldval <- old ^? l
+  , let entval = ent ^. fieldLensVal up
+  , newval /= entval
+  , oldval == entval
+    = Just (up =. newval)
 mkUpdate _ _ _ _ = Nothing
 
 -- | Like `mkUpdate` but performs the update even if there was no old value to check if the value had been edited
@@ -361,14 +389,24 @@ mkUpdateDirect ent new (CheckUpdate up l)
   , let entval = ent ^. fieldLensVal up
   , newval /= entval
     = Just (up =. newval)
+mkUpdateDirect ent new (CheckUpdateOpt up l)
+  | Just newval <- new ^? l
+  , let entval = ent ^. fieldLensVal up
+  , newval /= entval
+    = Just (up =. newval)
 mkUpdateDirect _ _ _ = Nothing
 
--- | Unconditionally update a record through ChecUpdate
+-- | Unconditionally update a record through CheckUpdate
 updateRecord :: PersistEntity record => record -> iraw -> CheckUpdate record iraw -> record
 updateRecord ent new (CheckUpdate up l) = 
   let newval  = new ^. l
       lensRec = fieldLensVal up
   in  ent & lensRec .~ newval
+updateRecord ent new (CheckUpdateOpt up l)
+  | Just newval <- new ^? l  
+    = ent & fieldLensVal up .~ newval
+  | otherwise
+    = ent  
 
 -- | like mkUpdate' but only returns the update if the new value would be unique
 -- mkUpdateCheckUnique' :: PersistEntity record => record -> iraw -> Maybe iraw -> CheckUpdate record iraw -> DB (Maybe (Update record))
@@ -382,6 +420,13 @@ mkUpdateCheckUnique' ent new Nothing (CheckUpdate up l)
     = do 
         newval_exists <- exists [up ==. newval]
         return $ toMaybe (not newval_exists) (up =. newval)
+mkUpdateCheckUnique' ent new Nothing (CheckUpdateOpt up l)
+  | Just newval <- new ^? l
+  , let entval = ent ^. fieldLensVal up
+  , newval /= entval
+    = do 
+        newval_exists <- exists [up ==. newval]
+        return $ toMaybe (not newval_exists) (up =. newval)
 mkUpdateCheckUnique' ent new (Just old) (CheckUpdate up l)
   | let newval = new ^. l
   , let oldval = old ^. l
@@ -391,4 +436,13 @@ mkUpdateCheckUnique' ent new (Just old) (CheckUpdate up l)
     = do 
         newval_exists <- exists [up ==. newval]
         return $ toMaybe (not newval_exists) (up =. newval)
+mkUpdateCheckUnique' ent new (Just old) (CheckUpdateOpt up l)
+  | Just newval <- new ^? l
+  , Just oldval <- old ^? l
+  , let entval = ent ^. fieldLensVal up
+  , newval /= entval
+  , oldval == entval
+    = do 
+        newval_exists <- exists [up ==. newval]
+        return $ toMaybe (not newval_exists) (up =. newval)
 mkUpdateCheckUnique' _ _ _ _ = return Nothing

src/Utils/Print/RenewQualification.hs

@@ -10,7 +10,7 @@ import Import
 import Text.Hamlet
 
 -- import           Data.Char as Char
--- import qualified Data.Text as Text
+import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
 
 import Data.FileEmbed (embedFile)
@@ -19,6 +19,40 @@ import Utils.Print.Letters
 import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
 
 
+defaultNotice :: Lang -> Text -> Text -> Text -> [Text]
+defaultNotice l qualName qualShort newExpire
+  | isDe l 
+    = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen. Sollte bis zum Ablaufdatum das E-Learning nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|]
+      , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung."
+      , "(Please contact us if you prefer letters in English.)"
+      ]
+  
+  | otherwise
+    = [ [st|A certificate for your records can only be generated immediately after a successful test. The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed. Upon successful completion of the training, the expiry date will automatically be extended until #{newExpire}. We recommend completing the training as soon as possible. The licence irrevocably expires, if the e-learning is not successfully completed by the expiry date or after 5 failed attempts. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|]
+      , "Please inform us, if this driving licence is no longer required."
+      , "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)"
+      ]
+  
+
+qualificationText :: Lang -> Text -> Text -> (Text, Text, Text)
+qualificationText l qName@(Text.stripSuffix "führerschein" -> Just qPrefix) qShort
+  | isDe l
+    = (qPrefix, qPrefix <> "fahrberechtigung", qName)
+  | qShort == "F"
+    = ("apron", "apron driving licence", "apron driving licence")
+  | qShort == "R"
+    = ("maneuvering area", "maneuvering area driving licence", "maneuvering area driving licence")
+  | otherwise
+    = (qPrefix, qPrefix <> " driving licence", qName)
+qualificationText l _qName "GSS"
+  | isDe l
+    = ("Gabelstapler", "Fahrberechtigung Gabelstapler", "Gabelstaplerführerschein")
+  | otherwise
+    = ("Forklift", "forklift driving licence", "forklift driving licence")
+qualificationText _l qName qShort
+    = (qShort, qName, qName)
+
+
 data LetterRenewQualification = LetterRenewQualification
     { lmsLogin      :: LmsIdent
     , lmsPin        :: Text
@@ -62,6 +96,7 @@ instance MDLetter LetterRenewQualification where
     let LetterRenewQualificationData{..} = letterRenewalQualificationFData l 
         isSupervised = rcvrId /= qualHolderID
         newExpire = addDays (fromIntegral $ fromMaybe 0 qualDuration) qualExpiry
+        (qArea, qFormal, qLicence) = qualificationText lang qualName qualShort        
     in mkMeta $
       guardMonoid isSupervised
       [ toMeta "supervisor" userDisplayName
@@ -80,13 +115,13 @@ instance MDLetter LetterRenewQualification where
       , mbMeta "validduration"  (show <$> qualDuration)
       , toMeta "url-text"       lmsUrl
       , toMeta "url"            lmsUrlLogin
-      , toMeta "notice"         [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{format SelFormatDate newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen. Sollte bis zum Ablaufdatum das E-Learning nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|]
+      , toMeta "notice"       $ defaultNotice lang qualName qualShort $ format SelFormatDate newExpire
-                                , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung."::Text
-                                , "(Please contact us if you prefer letters in English.)"
-                                ]
       , toMeta "de-subject"     [st|Verlängerung Fahrberechtigung „#{qualShort}“ (#{qualName})|]
       , toMeta "en-subject"     [st|Renewal of driving licence „#{qualShort}“ (#{qualName})|]
-      ] -- TODO use [st|some simple text with interpolation|]
+      , toMeta "qarea"          qArea
+      , toMeta "qformal"        qFormal
+      , toMeta "qlicence"       qLicence
+      ] -- NOTE: use [st|some simple text with interpolation|]
 
   getPJId LetterRenewQualification{..} =
     PrintJobIdentification

templates/letter/fraport_renewal_new.md

@@ -21,6 +21,9 @@ encludes:
 hyperrefoptions: hidelinks
 
 ### Metadaten, welche automatisch ersetzt werden:
+qarea: 'Vorfeld'
+qformal: 'Vorfeldfahrberechtigung'
+qlicence: 'Vorfeldführerschein'
 url-text: 'drive.fraport.de'
 url: 'https://drive.fraport.de'
 date: 11.11.1111

templates/profileData.hamlet

@@ -30,12 +30,12 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <dd .deflist__dd>
           ^{formatTimeW SelFormatDateTime (view _userAvsLastSynch avs)}
       <dt .deflist__dt>
-        _{MsgNameSet}
+        _{MsgNameSet} ^{usrAutomatic UserDisplayName}
       <dd .deflist__dd>
         ^{nameWidget userDisplayName userSurname}
       $maybe matnr <- userMatrikelnummer
         <dt .deflist__dt>
-          _{MsgTableMatrikelNr}
+          _{MsgTableMatrikelNr} ^{usrAutomatic UserMatrikelnummer}
         <dd .deflist__dd>
           ^{modalAccess (text2widget matnr) (text2widget matnr) False (AdminAvsUserR cID)}          
       $maybe sex <- userSex 
@@ -45,7 +45,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
           _{sex}
       $maybe bday <- userBirthday
         <dt .deflist__dt>
-          _{MsgTableBirthday}
+          _{MsgTableBirthday} ^{usrAutomatic UserBirthday}
         <dd .deflist__dd>
           ^{formatTimeW SelFormatDate bday}      
       <dt .deflist__dt>
@@ -96,7 +96,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
           #{telephonenr}
       $maybe mobilenr <- userMobile
         <dt .deflist__dt>
-          _{MsgUserMobile}
+          _{MsgUserMobile} ^{usrAutomatic UserMobile}
         <dd .deflist__dd>
           #{mobilenr}
       $maybe companyDepartment <- userCompanyDepartment
@@ -106,7 +106,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
           #{companyDepartment}
       $maybe companyPersonalNumber <- userCompanyPersonalNumber
         <dt .deflist__dt>
-          _{MsgCompanyPersonalNumber}
+          _{MsgCompanyPersonalNumber} ^{usrAutomatic UserCompanyPersonalNumber}
         <dd .deflist__dd>
           #{companyPersonalNumber}          
       $maybe compWgt <- companies