fix(avs): fix #69 by redesigning live avs status page
This commit is contained in:
parent
a5dfd5e10f
commit
697979c277
@ -2,11 +2,13 @@
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
AvsPersonInfo: AVS Personendaten
|
||||
AvsPersonId: AVS Personen Id
|
||||
AvsPersonId: AVS Personen Id
|
||||
AvsPersonNo: AVS Personennummer
|
||||
AvsPersonNoMismatch: AVS Personennummer hat sich geändert und wurde in FRADrive noch nicht aktualisiert
|
||||
AvsCardNo: Ausweiskartennummer
|
||||
AvsFirstName: Vorname
|
||||
AvsLastName: Nachname
|
||||
AvsPrimaryCompany: Primäre Firma
|
||||
AvsInternalPersonalNo: Personalnummer (nur Fraport AG)
|
||||
AvsVersionNo: Versionsnummer
|
||||
AvsQueryNeeded: Benötigt Verbindung zum AVS.
|
||||
@ -33,6 +35,11 @@ LicenceTableChangeAvs: Im AVS ändern
|
||||
LicenceTableGrantFDrive: In FRADrive erteilen
|
||||
LicenceTableRevokeFDrive: In FRADrive entziehen
|
||||
TableAvsActiveCards: Gültige Ausweise
|
||||
TableAvsCardValid: Aktuell gültig
|
||||
TableAvsCardIssueDate: Ausgestellt am
|
||||
TableAvsCardValidTo: Gültig bis
|
||||
AvsCardAreas: Ausweiszusätze
|
||||
AvsCardColor: Ausweisfarbe
|
||||
AvsCardColorGreen: Grün
|
||||
AvsCardColorBlue: Blau
|
||||
AvsCardColorRed: Rot
|
||||
|
||||
@ -1,12 +1,14 @@
|
||||
# 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
|
||||
AvsPersonInfo: AVS person info
|
||||
AvsPersonId: AVS person id
|
||||
AvsPersonNo: AVS person number
|
||||
AvsPersonNoMismatch: AVS person number has changed and was not yet updated in FRADrive
|
||||
AvsCardNo: Card number
|
||||
AvsFirstName: First name
|
||||
AvsLastName: Last name
|
||||
AvsPrimaryCompany: Primary company
|
||||
AvsInternalPersonalNo: Personnel number (Fraport AG only)
|
||||
AvsVersionNo: Version number
|
||||
AvsQueryNeeded: AVS connection required.
|
||||
@ -33,6 +35,11 @@ LicenceTableChangeAvs: Change in AVS
|
||||
LicenceTableGrantFDrive: Grant in FRADrive
|
||||
LicenceTableRevokeFDrive: Revoke in FRADrive
|
||||
TableAvsActiveCards: Valid Cards
|
||||
TableAvsCardValid: Currently valid
|
||||
TableAvsCardIssueDate: Issued
|
||||
TableAvsCardValidTo: Valid to
|
||||
AvsCardAreas: Card areas
|
||||
AvsCardColor: Color
|
||||
AvsCardColorGreen: Green
|
||||
AvsCardColorBlue: Blue
|
||||
AvsCardColorRed: Red
|
||||
|
||||
@ -21,6 +21,7 @@ ClusterVolatileQuickActionsEnabled: Schnellzugriffsmenü aktiv
|
||||
AvsNoLicence: Keine Fahrberechtigung
|
||||
AvsLicenceVorfeld: Vorfeld Fahrberechtigung
|
||||
AvsLicenceRollfeld: Rollfeld Fahrberechtigung
|
||||
AvsNoLicenceGuest: Keine Fahrberechtigung (Gast, Fahrberechtigungserwerb nicht möglich)
|
||||
|
||||
PaginationSize: Einträge pro Seite
|
||||
PaginationPage: Angzeigte Seite
|
||||
|
||||
@ -21,6 +21,7 @@ ClusterVolatileQuickActionsEnabled: Quick actions enabled
|
||||
AvsNoLicence: No driving licence
|
||||
AvsLicenceVorfeld: Apron driving licence
|
||||
AvsLicenceRollfeld: Maneuvering area driving licence
|
||||
AvsNoLicenceGuest: No driving licence (Guest account, cannot acquire a diriving licence)
|
||||
|
||||
PaginationSize: Rows per Page
|
||||
PaginationPage: Page to show
|
||||
|
||||
@ -605,7 +605,7 @@ unRenderMessage = unRenderMessage' (==)
|
||||
|
||||
unRenderMessageLenient :: forall a master. (Ord a, Finite a, RenderMessage master a) => master -> Text -> [a]
|
||||
unRenderMessageLenient = unRenderMessage' cmp
|
||||
where cmp = (==) `on` mk . under packed (filter Char.isAlphaNum . concatMap unidecode)
|
||||
where cmp = (==) `on` mk . under packed (concatMap $ filter Char.isAlphaNum . unidecode)
|
||||
|
||||
|
||||
instance Default DateTimeFormatter where
|
||||
|
||||
@ -17,7 +17,7 @@ module Handler.Admin.Avs
|
||||
import Import
|
||||
import qualified Control.Monad.State.Class as State
|
||||
-- import Data.Aeson (encode)
|
||||
import qualified Data.Aeson.Encode.Pretty as Pretty
|
||||
-- import qualified Data.Aeson.Encode.Pretty as Pretty
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Set as Set
|
||||
@ -167,8 +167,8 @@ postAdminAvsR = do
|
||||
return [whamlet|
|
||||
<ul>
|
||||
$forall p <- pns
|
||||
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
|
||||
|]
|
||||
<li>^{jsonWidget p}
|
||||
|] -- <li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
|
||||
mbPerson <- formResultMaybe presult (Just <<$>> procFormPerson)
|
||||
|
||||
((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing
|
||||
@ -179,7 +179,7 @@ postAdminAvsR = do
|
||||
return [whamlet|
|
||||
<ul>
|
||||
$forall p <- pns
|
||||
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
|
||||
<li>^{jsonWidget p}
|
||||
|]
|
||||
mbStatus <- formResultMaybe sresult (Just <<$>> procFormStatus)
|
||||
|
||||
@ -193,10 +193,10 @@ postAdminAvsR = do
|
||||
$forall AvsDataContact{..} <- pns
|
||||
<li>
|
||||
<ul>
|
||||
<li>AvsId: #{tshow avsContactPersonID}
|
||||
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON avsContactPersonInfo))}
|
||||
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON avsContactFirmInfo))}
|
||||
|]
|
||||
<li>AvsId: #{tshow avsContactPersonID}
|
||||
<li>^{jsonWidget avsContactPersonInfo}
|
||||
<li>^{jsonWidget avsContactFirmInfo}
|
||||
|] -- <li>#{decodeUtf8 (Pretty.encodePretty (toJSON avsContactPersonInfo))}
|
||||
mbContact <- formResultMaybe cresult (Just <<$>> procFormContact)
|
||||
|
||||
|
||||
@ -681,87 +681,148 @@ getAdminAvsUserR uuid = do
|
||||
uid <- decrypt uuid
|
||||
Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid
|
||||
mbContact <- try $ avsQuery $ AvsQueryContact $ Set.singleton $ AvsObjPersonId userAvsPersonId
|
||||
-- mbStatus <- try $ avsQuery $ AvsQueryStatus $ Set.singleton userAvsPersonId
|
||||
-- CONTINUE HERE
|
||||
mbDataPerson <- lookupAvsUser userAvsPersonId -- TODO: delete Handler.Utils.Avs.lookupAvsUser if no longer needed
|
||||
|
||||
let heading = [whamlet|_{MsgAvsPersonNo} #{userAvsNoPerson}|]
|
||||
mbStatus <- try $ avsQuery $ AvsQueryStatus $ Set.singleton userAvsPersonId
|
||||
-- mbDataPerson <- lookupAvsUser userAvsPersonId -- TODO: delete Handler.Utils.Avs.lookupAvsUser if no longer needed
|
||||
|
||||
msgWarningTooltip <- messageI Warning MsgMessageWarning
|
||||
let warnBolt = messageTooltip msgWarningTooltip
|
||||
heading = [whamlet|_{MsgAvsPersonNo} #{userAvsNoPerson}|]
|
||||
siteLayout heading $ do
|
||||
setTitle $ toHtml $ show userAvsNoPerson
|
||||
|
||||
let contactWgt = case mbContact of
|
||||
Left err -> exceptionWgt err
|
||||
Right (AvsResponseContact adcs) -> do
|
||||
let cs = mkContactWgt <$> toList adcs
|
||||
let cs = mkContactWgt warnBolt userAvsNoPerson <$> toList adcs
|
||||
mconcat cs
|
||||
mkContactWgt :: AvsDataContact -> Widget
|
||||
mkContactWgt AvsDataContact
|
||||
{ avsContactPersonID = _api -- TODO
|
||||
, avsContactPersonInfo = AvsPersonInfo {..}
|
||||
, avsContactFirmInfo = AvsFirmInfo { avsFirmFirm = _fname } -- TODO
|
||||
} =
|
||||
let licence :: AvsLicence = toEnum avsInfoRampLicence in -- TODO: show bad numbers too?
|
||||
[whamlet|
|
||||
<section .profile>
|
||||
<dl .deflist.profile-dl>
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserSurname}
|
||||
<dd .deflist__dd>
|
||||
#{avsInfoLastName}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserFirstName}
|
||||
<dd .deflist__dd>
|
||||
#{avsInfoFirstName}
|
||||
|
||||
$maybe bday <- avsInfoDateOfBirth
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserBirthday}
|
||||
<dd .deflist__dd>
|
||||
^{formatTimeW SelFormatDate bday}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAvsLicence}
|
||||
<dd .deflist__dd>
|
||||
_{licence}
|
||||
|]
|
||||
|
||||
cardsWgt = case mbStatus of
|
||||
Left err -> exceptionWgt err
|
||||
Right (AvsResponseStatus asts) -> do
|
||||
let cs = mkCardsWgt . avsStatusPersonCardStatus <$> toList asts
|
||||
mconcat cs
|
||||
-- cardsWgt = case mbDataPerson of
|
||||
-- Nothing -> mempty
|
||||
-- Just AvsDataPerson{avsPersonPersonCards=crds} -> mkCardsWgt crds
|
||||
[whamlet|
|
||||
<p>
|
||||
Die Ansicht zeigt ausschließlich kürzlich vom AVS glieferte Daten:
|
||||
Die Ansicht zeigt ausschließlich kürzlich vom AVS abgerufene Daten:
|
||||
<p>
|
||||
^{contactWgt}
|
||||
<p>
|
||||
^{cardsWgt}
|
||||
|]
|
||||
-- <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>InfoPersonContact <br>
|
||||
-- <i>(bevorzugt)
|
||||
-- <dd .deflist__dd>
|
||||
-- $case mbContact
|
||||
-- $of Left err
|
||||
-- ^{exceptionWgt err}
|
||||
-- $of Right contactInfo
|
||||
-- #{decodeUtf8 (Pretty.encodePretty (toJSON contactInfo))}
|
||||
-- <dt .deflist__dt>PersonStatus und mehrere PersonSearch <br>
|
||||
-- <i>(benötigt mehrere AVS Abfragen)
|
||||
-- <dd .deflist__dd>
|
||||
-- $maybe dataPerson <- mbDataPerson
|
||||
-- #{decodeUtf8 (Pretty.encodePretty (toJSON dataPerson))}
|
||||
-- $nothing
|
||||
-- Keine Daten erhalten.
|
||||
-- <h3>
|
||||
-- Provisorische formatierte Ansicht
|
||||
-- <p>
|
||||
-- Generisch formatierte Ansicht, die zeigt, in welche Richtung die Endansicht gehen könnte.
|
||||
-- In der Endansicht wären nur ausgewählte Felder mit besserer Bennenung in einer manuell gewählten Reihenfolge sichtbar.
|
||||
-- <p>
|
||||
-- ^{foldMap jsonWidget mbContact}
|
||||
-- <p>
|
||||
-- ^{foldMap jsonWidget mbDataPerson}
|
||||
-- |]
|
||||
|
||||
|
||||
<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>InfoPersonContact <br>
|
||||
<i>(bevorzugt)
|
||||
mkContactWgt :: Widget -> Int -> AvsDataContact -> Widget
|
||||
mkContactWgt warnBolt reqAvsNo AvsDataContact
|
||||
{ -- avsContactPersonID = _api
|
||||
avsContactPersonInfo = AvsPersonInfo{..}
|
||||
, avsContactFirmInfo = AvsFirmInfo{ avsFirmFirm = firmName }
|
||||
} =
|
||||
let avsNoOk = readMay avsInfoPersonNo /= Just reqAvsNo in
|
||||
[whamlet|
|
||||
<section .profile>
|
||||
<dl .deflist.profile-dl>
|
||||
$if avsNoOk
|
||||
<dt .deflist__dt>
|
||||
_{MsgAvsPersonNo}
|
||||
<dd .deflist__dd>
|
||||
#{avsInfoPersonNo}
|
||||
^{warnBolt}
|
||||
_{MsgAvsPersonNoMismatch}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAvsLastName}
|
||||
<dd .deflist__dd>
|
||||
#{avsInfoLastName}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAvsFirstName}
|
||||
<dd .deflist__dd>
|
||||
#{avsInfoFirstName}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAvsPrimaryCompany}
|
||||
<dd .deflist__dd>
|
||||
#{firmName}
|
||||
$maybe bday <- avsInfoDateOfBirth
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserBirthday}
|
||||
<dd .deflist__dd>
|
||||
$case mbContact
|
||||
$of Left err
|
||||
^{exceptionWgt err}
|
||||
$of Right contactInfo
|
||||
#{decodeUtf8 (Pretty.encodePretty (toJSON contactInfo))}
|
||||
<dt .deflist__dt>PersonStatus und mehrere PersonSearch <br>
|
||||
<i>(benötigt mehrere AVS Abfragen)
|
||||
<dd .deflist__dd>
|
||||
$maybe dataPerson <- mbDataPerson
|
||||
#{decodeUtf8 (Pretty.encodePretty (toJSON dataPerson))}
|
||||
$nothing
|
||||
Keine Daten erhalten.
|
||||
<h3>
|
||||
Provisorische formatierte Ansicht
|
||||
<p>
|
||||
Generisch formatierte Ansicht, die zeigt, in welche Richtung die Endansicht gehen könnte.
|
||||
In der Endansicht wären nur ausgewählte Felder mit besserer Bennenung in einer manuell gewählten Reihenfolge sichtbar.
|
||||
<p>
|
||||
^{foldMap jsonWidget mbContact}
|
||||
<p>
|
||||
^{foldMap jsonWidget mbDataPerson}
|
||||
|]
|
||||
^{formatTimeW SelFormatDate bday}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAvsLicence}
|
||||
<dd .deflist__dd>
|
||||
$maybe licence <- parseAvsLicence avsInfoRampLicence
|
||||
_{licence}
|
||||
$nothing
|
||||
_{MsgAvsNoLicenceGuest}
|
||||
|]
|
||||
|
||||
mkCardsWgt :: Set AvsDataPersonCard -> Widget
|
||||
mkCardsWgt crds =
|
||||
[whamlet|
|
||||
<table>
|
||||
<thead>
|
||||
<th>_{MsgAvsCardNo}
|
||||
<th>_{MsgTableAvsCardValid}
|
||||
<th>_{MsgAvsCardColor}
|
||||
<th>_{MsgAvsCardAreas}
|
||||
<th>_{MsgTableCompany}
|
||||
<th>_{MsgTableAvsCardIssueDate}
|
||||
<th>_{MsgTableAvsCardValidTo}
|
||||
<tbody>
|
||||
$forall c <- crds
|
||||
$with AvsDataPersonCard{avsDataValid,avsDataCardColor,avsDataCardAreas,avsDataFirm,avsDataIssueDate,avsDataValidTo} <- c
|
||||
<tr>
|
||||
<td>
|
||||
#{tshowAvsFullCardNo (getFullCardNo c)}
|
||||
<td>
|
||||
#{boolSymbol avsDataValid}
|
||||
<td>
|
||||
_{avsDataCardColor}
|
||||
<td>
|
||||
$forall a <- avsDataCardAreas
|
||||
#{a} #
|
||||
<td>
|
||||
$maybe f <- avsDataFirm
|
||||
#{f}
|
||||
<td>
|
||||
$maybe d <- avsDataIssueDate
|
||||
^{formatTimeW SelFormatDate d}
|
||||
<td>
|
||||
$maybe d <- avsDataValidTo
|
||||
^{formatTimeW SelFormatDate d}
|
||||
|]
|
||||
|
||||
|
||||
|
||||
instance HasEntity (DBRow (Entity UserAvs, Entity User)) User where
|
||||
hasEntity = _dbrOutput . _2
|
||||
|
||||
@ -23,7 +23,7 @@ module Handler.Utils.Avs
|
||||
, retrieveDifferingLicences, retrieveDifferingLicencesStatus
|
||||
, computeDifferingLicences
|
||||
-- , synchAvsLicences
|
||||
, lookupAvsUser, lookupAvsUsers
|
||||
-- , lookupAvsUser, lookupAvsUsers
|
||||
, AvsException(..)
|
||||
, updateReceivers
|
||||
, AvsPersonIdMapPersonCard
|
||||
@ -141,26 +141,26 @@ catchAVShandler allEx toLog toMsg dft act = act `catches` (avsHandlers <> allHan
|
||||
|
||||
|
||||
-- TODO: delete lookupAvsUser and lookupAvsUsers once Handler.Admin.Avs.getAdminAvsUserR as refactored!
|
||||
lookupAvsUser :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX ) =>
|
||||
AvsPersonId -> m (Maybe AvsDataPerson)
|
||||
lookupAvsUser api = Map.lookup api <$> lookupAvsUsers (Set.singleton api)
|
||||
-- lookupAvsUser :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX ) =>
|
||||
-- AvsPersonId -> m (Maybe AvsDataPerson)
|
||||
-- lookupAvsUser api = Map.lookup api <$> lookupAvsUsers (Set.singleton api)
|
||||
|
||||
-- | retrieves complete avs user records for given AvsPersonIds.
|
||||
-- Note that this requires several AVS-API queries, since
|
||||
-- - avsQueryPerson does not support querying an AvsPersonId directly
|
||||
-- - avsQueryStatus only provides limited information
|
||||
-- avsQuery is used to obtain all card numbers, which are then queried separately an merged
|
||||
-- May throw Servant.ClientError or AvsExceptions
|
||||
-- Does not write to our own DB!
|
||||
lookupAvsUsers :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX ) =>
|
||||
Set AvsPersonId -> m (Map AvsPersonId AvsDataPerson)
|
||||
lookupAvsUsers apis = do
|
||||
AvsResponseStatus statuses <- avsQuery $ AvsQueryStatus apis
|
||||
let forFoldlM = $(permuteFun [3,2,1]) foldlM
|
||||
forFoldlM statuses mempty $ \acc1 AvsStatusPerson{avsStatusPersonCardStatus=cards} ->
|
||||
forFoldlM cards acc1 $ \acc2 AvsDataPersonCard{avsDataCardNo, avsDataVersionNo} -> do
|
||||
AvsResponsePerson adps <- avsQuery $ def{avsPersonQueryCardNo = Just avsDataCardNo, avsPersonQueryVersionNo = Just avsDataVersionNo}
|
||||
return $ mergeByPersonId adps acc2
|
||||
-- -- | retrieves complete avs user records for given AvsPersonIds.
|
||||
-- -- Note that this requires several AVS-API queries, since
|
||||
-- -- - avsQueryPerson does not support querying an AvsPersonId directly
|
||||
-- -- - avsQueryStatus only provides limited information
|
||||
-- -- avsQuery is used to obtain all card numbers, which are then queried separately an merged
|
||||
-- -- May throw Servant.ClientError or AvsExceptions
|
||||
-- -- Does not write to our own DB!
|
||||
-- lookupAvsUsers :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX ) =>
|
||||
-- Set AvsPersonId -> m (Map AvsPersonId AvsDataPerson)
|
||||
-- lookupAvsUsers apis = do
|
||||
-- AvsResponseStatus statuses <- avsQuery $ AvsQueryStatus apis
|
||||
-- let forFoldlM = $(permuteFun [3,2,1]) foldlM
|
||||
-- forFoldlM statuses mempty $ \acc1 AvsStatusPerson{avsStatusPersonCardStatus=cards} ->
|
||||
-- forFoldlM cards acc1 $ \acc2 AvsDataPersonCard{avsDataCardNo, avsDataVersionNo} -> do
|
||||
-- AvsResponsePerson adps <- avsQuery $ def{avsPersonQueryCardNo = Just avsDataCardNo, avsPersonQueryVersionNo = Just avsDataVersionNo}
|
||||
-- return $ mergeByPersonId adps acc2
|
||||
|
||||
|
||||
-- | Like `Handler.Utils.getReceivers`, but calls upsertAvsUserById on each user to ensure that postal address is up-to-date
|
||||
|
||||
@ -25,7 +25,7 @@ import qualified Data.Set as Set
|
||||
-- import qualified Data.HashMap.Lazy as HM
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import Data.Aeson.Types as Aeson
|
||||
|
||||
|
||||
{-
|
||||
@ -308,6 +308,10 @@ licence2char AvsNoLicence = '0'
|
||||
licence2char AvsLicenceVorfeld = 'F'
|
||||
licence2char AvsLicenceRollfeld = 'R'
|
||||
|
||||
parseAvsLicence :: Int -> Maybe AvsLicence
|
||||
parseAvsLicence (fromJSON . Number . fromIntegral -> Aeson.Success lic) = Just lic
|
||||
parseAvsLicence _ = Nothing
|
||||
|
||||
|
||||
data AvsDataCardColor = AvsCardColorMisc Text | AvsCardColorGrün | AvsCardColorBlau | AvsCardColorRot | AvsCardColorGelb
|
||||
deriving (Eq, Ord, Read, Show, Generic, Binary)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user