chore(avs): create and link avs contact info page

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

@@ -1,7 +1,7 @@
 # SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
-
+AvsPersonInfo: AVS Personendaten
 AvsPersonId: AVS Personen Id 
 AvsPersonNo: AVS Personennummer
 AvsCardNo: Ausweiskartennummer 

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

@@ -1,7 +1,7 @@
 # SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
-
+AvsPersonInfo: AVS Person Info
 AvsPersonId: AVS Person Id
 AvsPersonNo: AVS Person Number
 AvsCardNo: Card number

routes

@@ -67,6 +67,7 @@
 /admin/tokens                 AdminTokensR     GET POST
 /admin/crontab                AdminCrontabR    GET
 /admin/avs                    AdminAvsR        GET POST
+/admin/avs/#CryptoUUIDUser    AdminAvsUserR    GET
 /admin/ldap                   AdminLdapR       GET POST
 /admin/problems               AdminProblemsR			 GET
 /admin/problems/no-contact    ProblemUnreachableR  GET

src/Foundation/Navigation.hs

@@ -113,6 +113,7 @@ breadcrumb AdminErrMsgR         = i18nCrumb MsgMenuAdminErrMsg            $ Just
 breadcrumb AdminTokensR         = i18nCrumb MsgMenuAdminTokens            $ Just AdminR
 breadcrumb AdminCrontabR        = i18nCrumb MsgBreadcrumbAdminCrontab     $ Just AdminR
 breadcrumb AdminAvsR            = i18nCrumb MsgMenuAvs                    $ Just AdminR
+breadcrumb AdminAvsUserR{}      = i18nCrumb MsgAvsPersonInfo              $ Just AdminAvsR
 breadcrumb AdminLdapR           = i18nCrumb MsgMenuLdap                   $ Just AdminR
 breadcrumb AdminProblemsR       = i18nCrumb MsgProblemsHeading            $ Just AdminR
 breadcrumb ProblemUnreachableR  = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR

src/Handler/Admin/Avs.hs

@@ -9,6 +9,7 @@
 
 module Handler.Admin.Avs
   ( getAdminAvsR, postAdminAvsR
+  , getAdminAvsUserR
   , getProblemAvsSynchR, postProblemAvsSynchR
   ) where
 
@@ -144,7 +145,7 @@ postAdminAvsR = do
         |]
   mAvsQuery <- getsYesod $ view _appAvsQuery
   case mAvsQuery of
-    Nothing -> return mempty
+    Nothing -> siteLayoutMsg MsgMenuAvs [whamlet|Error: AVS interface configuration is incomplete.|] -- should never occur after initilisation
     Just AvsQuery{..} -> do
       ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
 
@@ -536,7 +537,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
         [ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId)
                                 -- $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal
         , colUserNameLink AdminUserR
-        , sortable (Just "avspersonno")   (i18nCell MsgAvsPersonNo)                  $ \(view      resultUserAvs       -> a) -> avsPersonNoCell a
+        , sortable (Just "avspersonno")   (i18nCell MsgAvsPersonNo)                  $ \(view      resultUserAvs       -> a) -> avsPersonNoLinkedCell a
         -- , colUserCompany 
         , sortable (Just "user-company") (i18nCell MsgTableCompany) $ \(view (resultUser . _entityKey) -> uid) -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
             companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
@@ -633,3 +634,43 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
         return (act, usrSet)
 
   over _1 postprocess <$> dbTable validator DBTable{..}
+
+
+
+getAdminAvsUserR :: CryptoUUIDUser -> Handler Html
+getAdminAvsUserR uuid = do
+  uid <- decrypt uuid
+  Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid  
+  mAvsQuery <- getsYesod $ view _appAvsQuery
+  resWgt <- case mAvsQuery of
+    Nothing -> return [whamlet|Error: AVS interface configuration is incomplete.|] -- should never occur after initilisation
+    Just AvsQuery{..} -> do 
+      mbContact <- avsQueryContact $ AvsQueryContact $ Set.singleton $ AvsObjPersonId userAvsPersonId
+      mbDataPerson <- lookupAvsUser userAvsPersonId      
+      return [whamlet|
+        <p>
+          Vorläufige Admin Ansicht AVS Daten. 
+          Ansicht zeigt aktuelle Daten. 
+          Es erfolgte damit aber noch kein Update der FRADrive Daten.
+        <p>
+          <dl .deflist>
+            <dt .deflist__dt>Info Person Contact <br>
+              <i>(bevorzugt)
+            <dd .deflist_dd>
+              $case mbContact
+                $of Left err 
+                  Fehler: #{tshow err}
+                $of Right contactInfo
+                  #{decodeUtf8 (Pretty.encodePretty (toJSON contactInfo))}              
+            <dt .deflist__dt>PersonStatus und mehrere PersoSearch <br>
+              <i>(benötigt mehrere AVS Abfragen)
+            <dd .deflist_dd>
+              $maybe dataPerson <- mbDataPerson
+                #{decodeUtf8 (Pretty.encodePretty (toJSON dataPerson))}
+              $nothing 
+                Keine Daten erhalten.
+        |]       
+  let heading = [whamlet|_{MsgAvsPersonNo} #{userAvsNoPerson}|]
+  siteLayout heading $ do 
+    setTitle $ toHtml $ show userAvsNoPerson
+    resWgt

src/Handler/LMS.hs

@@ -648,6 +648,6 @@ getLmsUserR uuid = do
 
   let heading = [whamlet|_{MsgMenuLmsUser} ^{userWidget user}|]  
   siteLayout heading $ do
-    setTitle $ toHtml $ "Qualifkationen " <> userDisplayName
+    setTitle $ toHtml userDisplayName
     $(widgetFile "lms-user")
     -- $(i18nWidgetFile "lms-user")

src/Handler/Utils/Avs.hs

@@ -240,8 +240,8 @@ retrieveDifferingLicences' getStatus = do
               ] <> 
               [ AvsStatusPerson  avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
 #else
-  let statQry = AvsQueryStatus $ avsLicenceDifferences2LicenceIds lDiff
+  let statQry = avsLicenceDifferences2LicenceIds lDiff
-  lStat <- if getStatus then throwLeftM $ avsQueryStatus statQry else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
+  lStat <- if getStatus && notNull statQry then throwLeftM $ avsQueryStatus $ AvsQueryStatus statQry else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
 #endif
   return (lDiff, avsResponseStatusMap lStat)
 

src/Handler/Utils/Table/Cells.hs

@@ -383,6 +383,11 @@ qualificationBlockedCell (Just QualificationBlocked{..})
 avsPersonNoCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
 avsPersonNoCell = numCell . view _userAvsNoPerson
 
+avsPersonNoLinkedCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
+avsPersonNoLinkedCell a = cell $ do
+  uuid <- liftHandler $ encrypt $ a ^. _userAvsUser
+  modal (toWgt $ toMessage $ a ^. _userAvsNoPerson) (Left $ SomeRoute $ AdminAvsUserR uuid)
+
 avsPersonCardCell :: (IsDBTable m c) => Set AvsDataPersonCard -> DBCell m c
 avsPersonCardCell cards = wgtCell 
     [whamlet|

src/Model/Types/Avs.hs

@@ -209,6 +209,9 @@ instance Show AvsPersonId where
 instance Read AvsPersonId where
   readPrec = fmap AvsPersonId readPrec
 
+_AvsPersonId :: Iso AvsPersonId AvsPersonId Int Int
+_AvsPersonId = iso avsPersonId AvsPersonId
+
 -- | Non-existing default, also needed for query all ramp driving licences
 avsPersonIdZero :: AvsPersonId 
 avsPersonIdZero = AvsPersonId 0 -- this mus be zero acording to VSM specification