Merge branch 'master' into fradrive/api-avs

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 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.5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.6.4...v26.6.5) (2022-12-05)
+
 ## [26.6.4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.6.3...v26.6.4) (2022-12-02)
 
 ## [26.6.3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.6.2...v26.6.3) (2022-11-30)

messages/uniworx/categories/avs/de-de-formal.msg

@@ -11,4 +11,5 @@ AvsInternalPersonalNo: Personalnummer (nur Fraport AG)
 AvsVersionNo: Versionsnummer
 AvsQueryEmpty: Bitte mindestens ein Anfragefeld ausfüllen!
 AvsQueryStatusInvalid t@Text: Nur numerische IDs eingeben, durch Komma getrennt! Erhalten: #{show t}
-AvsLicence: Fahrberechtigung
+AvsLicence: Fahrberechtigung
+AvsPersonNoNotId: AVS Personennummer dient zur menschlichen Kommunikation mit der Ausweisstelle und darf nicht verwechselt werden mit der maschinell verwendeten AVS Personen Id

messages/uniworx/categories/avs/en-eu.msg

@@ -11,4 +11,5 @@ AvsInternalPersonalNo: Personnel number (Fraport AG only)
 AvsVersionNo: Version number
 AvsQueryEmpty: At least one query field must be filled!
 AvsQueryStatusInvalid t: Numeric IDs only, comma seperated! #{show t}
-AvsLicence: Driving Licence
+AvsLicence: Driving Licence
+AvsPersonNoNotId: AVS person number is used in human communication only and must not be mistaken for the AVS personen id used in machine communications

models/avs.model

@@ -14,8 +14,9 @@
 
 
 UserAvs
-  personId        AvsPersonId -- unique identifier for user throughout avs; newtype for Int
+  personId        AvsPersonId -- unique identifier for user throughout avs; newtype for Int  
   user            UserId
+  noPerson        Int         default=0 -- only needed for manual communication with personnel from Ausweisverwaltungsstelle
   UniqueUserAvsUser user
   UniqueUserAvsId   personId
   deriving Generic

nix/docker/demo-version.json

@@ -1,3 +1,3 @@
 {
-  "version": "26.6.4"
+  "version": "26.6.5"
 }

nix/docker/version.json

@@ -1,3 +1,3 @@
 {
-  "version": "26.6.4"
+  "version": "26.6.5"
 }

package-lock.json

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

package.json

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

package.yaml

@@ -1,5 +1,5 @@
 name: uniworx
-version: 26.6.4
+version: 26.6.5
 dependencies:
   - base
   - yesod

src/Handler/Profile.hs

@@ -653,6 +653,8 @@ getForProfileDataR cID = do
 
 makeProfileData :: Entity User -> DB Widget
 makeProfileData (Entity uid User{..}) = do
+  avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
+  -- avsCards <- maybe (pure mempty) (\a -> selectList [UserAvsCardPersonId ==. userAvsPersonId a] []) avsId
   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
       E.on $ sheet E.^. SheetCourse E.==. course    E.^. CourseId
@@ -699,7 +701,8 @@ makeProfileData (Entity uid User{..}) = do
 
   cID <- encrypt uid
   mCRoute <- getCurrentRoute
-  showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)
+  showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)  
+  tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId
 
   let profileRemarks = $(i18nWidgetFile "profile-remarks")
   return $(widgetFile "profileData")

src/Handler/Utils/Avs.hs

@@ -272,14 +272,14 @@ upsertAvsUserById api = do
             $logInfoS "AVS" $ "Creating new user with avsInternalPersonalNo " <> tshow persNo
             candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] []
             case candidates of
-              [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid)
+              [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo)
               (_:_) -> throwM AvsUserAmbiguous
               [] -> do
                 upsRes :: Either CampusUserConversionException (Entity User)
                   <- try $ ldapLookupAndUpsert persNo
-                $logInfoS "AVS" $ "No matching user found. attempted LDAP upsert returned: " <> tshow upsRes
+                $logInfoS "AVS" $ "No matching existing user found. Attempted LDAP upsert returned: " <> tshow upsRes
                 case upsRes of
-                  Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid -- pin/addr are updated in next step anyway
+                  Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo -- pin/addr are updated in next step anyway
                   _other -> return mbuid -- ==Nothing -- user could not be created somehow
       _other -> return mbuid
   case (mbuid, mbapd) of
@@ -292,6 +292,7 @@ upsertAvsUserById api = do
           pinCard     = Set.lookupMax avsPersonPersonCards
           userPin     = tshowAvsFullCardNo . getFullCardNo <$> pinCard          
           fakeIdent   = CI.mk $ "AVSID:" <> tshow api
+          fakeNo      = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo
           newUsr = AdminUserForm
             { aufTitle     = Nothing
             , aufFirstName = avsPersonFirstName
@@ -307,14 +308,14 @@ upsertAvsUserById api = do
             , aufPostAddress = userFirmAddr
             , aufPrefersPostal = isJust firmAddress
             , aufPinPassword = userPin
-            , aufEmail = fakeIdent -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
+            , aufEmail = fakeNo    -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
             , aufIdent = fakeIdent -- use AvsPersonId instead
             , aufAuth  = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personal number is known
             }
       mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe      
       whenIsJust mbUid $ \uid -> runDB $ do 
         now <- liftIO getCurrentTime
-        insert_ $ UserAvs avsPersonPersonID uid
+        insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo
         -- forM_ avsPersonPersonCards $ -- save all cards for later
         let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
         forM_ cs $  -- only save used cards for the postal address update detection

src/Utils.hs

@@ -1057,6 +1057,16 @@ throwExceptT = exceptT throwM return
 generalFinally :: MonadMask m => m a -> (ExitCase a -> m b) -> m a
 generalFinally action finalizer = view _1 <$> generalBracket (return ()) (const finalizer) (const action)
 
+
+-------------
+-- Functor --
+-------------
+
+infixl 4 <<$>>
+(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
+(<<$>>) f x = fmap f <$> x
+
+
 ------------
 -- Monads --
 ------------

src/Utils/Lens.hs

@@ -125,6 +125,8 @@ makeClassyFor_ ''QualificationUser
 makeClassyFor_ ''LmsUser
 makeClassyFor_ ''LmsUserlist
 makeClassyFor_ ''LmsResult
+makeClassyFor_ ''UserAvs
+makeClassyFor_ ''UserAvsCard
 
 _entityKey :: Getter (Entity record) (Key record)
 -- ^ Not a `Lens'` for safety

templates/profileData.hamlet

@@ -11,9 +11,15 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
       <dd .deflist__dd .email>
         #{userIdent}
       <dt .deflist__dt>
-        _{MsgAuthModeSet}
+        _{MsgAuthModeSet}        
-      <dd .deflist__dd>
+      <dd .deflist__dd>        
         _{userAuthentication}
+      $maybe avs <- avsId
+        <dt .deflist__dt>
+          _{MsgAvsPersonNo}
+          ^{messageTooltip tooltipAvsPersNo}
+        <dd .deflist__dd>
+          #{view _userAvsNoPerson avs}      
       <dt .deflist__dt>
         _{MsgNameSet}
       <dd .deflist__dd>

test/Database/Fill.hs

@@ -518,6 +518,7 @@ fillDb = do
     void . insert' $ UserSchool uid mi False
   for_ [jost] $ \uid ->
     void . insert' $ UserSchool uid avn False
+  void . insert' $ UserAvs (AvsPersonId 12345678) jost 87654321
 
   let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
   let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]