fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): improve print of avs test interface

Browse Source
This commit is contained in:
Steffen Jost 2023-03-24 18:06:55 +00:00
parent db9ffa1830
commit 3b0f27d4f2
3 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Handler/Admin/Avs.hs
View File

@ -155,8 +155,8 @@ postAdminAvsR = do
Left err -> let msg = tshow err in return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
Right (AvsResponsePerson pns) -> return $ Just [whamlet|
<ul>
$forall p <- pns
<li>#{tshow p}
$forall p <- pns
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
|]
mbPerson <- formResultMaybe presult procFormPerson
@ -169,7 +169,7 @@ postAdminAvsR = do
Right (AvsResponseStatus pns) -> return $ Just [whamlet|
<ul>
$forall p <- pns
<li>#{tshow p}
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
|]
mbStatus <- formResultMaybe sresult procFormStatus
@ -181,8 +181,12 @@ postAdminAvsR = do
Left err -> let msg = tshow err in return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
Right (AvsResponseContact pns) -> return $ Just [whamlet|
<ul>
$forall p <- pns
<li>#{Pretty.encodePretty (toJSON p)}
$forall AvsDataContact{..} <- pns
<li>
<ul>
<li>AvsId: #{tshow avsContactPersonID}
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON avsContactPersonInfo))}
<li>#{decodeUtf8 (Pretty.encodePretty (toJSON avsContactFirmInfo))}
|]
mbContact <- formResultMaybe cresult procFormContact
@ -443,11 +447,10 @@ getProblemAvsSynchR = do
Just $ QualificationBlocked
{ qualificationBlockedDay = nowaday
, qualificationBlockedReason = licenceTableChangeFDriveReason
}
let lReq = length apids
if | oks < 0 -> addMessageI Error $ MsgRevokeFraDriveLicencesError alic
| oks == lreq && lreq > 0 -> addMessageI Success $ MsgRevokeFraDriveLicences alic oks
| otherwise -> addMessageI Warning $ MsgRevokeFraDriveLicences alic oks
}
if | oks < 0 -> addMessageI Error $ MsgRevokeFraDriveLicencesError alic
| oks > 0, oks == length apids -> addMessageI Success $ MsgRevokeFraDriveLicences alic oks
| otherwise -> addMessageI Warning $ MsgRevokeFraDriveLicences alic oks
redirect ProblemAvsSynchR -- must be outside runDB
procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do

2
src/Model/Types/Avs.hs
View File

@ -480,7 +480,7 @@ data AvsPersonInfo = AvsPersonInfo
{ avsInfoPersonNo :: Text -- Int -- AVS Personennummer, zum Gebrauch in menschlicher Kommunikation
, avsInfoFirstName :: Text -- WARNING: name stored as is, but AVS does contain weird whitespaces
, avsInfoLastName :: Text -- WARNING: name stored as is, but AVS does contain weird whitespaces
, avsInfoRampLicence :: AvsLicence -- unlike other queries, may return -1 for guest unable to hold a licence; currently not distinquished from no licence
, avsInfoRampLicence :: Int -- AvsLicence -- unlike other queries, may return -1 for guest unable to hold a licence; currently not distinquished from no licence
, avsInfoDateOfBirth :: Maybe Day
, avsInfoPersonEMail :: Maybe Text
, avsInfoPersonMobilePhoneNo :: Maybe Text

2
src/Utils/Avs.hs
View File

@ -68,7 +68,7 @@ mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
mkAvsQuery _ _ _ = AvsQuery
{ avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty
, avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty
, avsQueryContact = \_ -> return . Right $ AvsResponseContact mempty
, avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "AVSNO:123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
, avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty
, avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty
}