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

chore(avs): fix #76 allowing admins to switch to secondary company

Browse Source
This commit is contained in:
Steffen Jost 2024-05-03 17:17:24 +02:00
parent 5944efcb86
commit 21273e361a
8 changed files with 169 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/categories/avs/de-de-formal.msg
View File

@ -55,4 +55,6 @@ AvsPersonSearchEmpty: AVS Suche lieferte leeres Ergebnis
AvsPersonSearchAmbiguous: AVS Suche lieferte mehrere uneindeutige Ergebnisse AvsPersonSearchAmbiguous: AVS Suche lieferte mehrere uneindeutige Ergebnisse
AvsSetLicencesFailed reason@Text: Setzen der Fahrlizenz im AVS fehlgeschlagen. Grund: #{reason} AvsSetLicencesFailed reason@Text: Setzen der Fahrlizenz im AVS fehlgeschlagen. Grund: #{reason}
AvsIdMismatch api1@AvsPersonId api2@AvsPersonId: AVS Suche für Id #{tshow api1} lieferte stattdessen Id #{tshow api2} AvsIdMismatch api1@AvsPersonId api2@AvsPersonId: AVS Suche für Id #{tshow api1} lieferte stattdessen Id #{tshow api2}
AvsUserCreationFailed api@AvsPersonId: Für AVS Id #{tshow api} konnte kein neuer Benutzer angelegt werden, da es eine gemeinsame Id (z.B. Personalnummer) mit einem existierenden, aber verschiedenen Nutzer gibt. AvsUserCreationFailed api@AvsPersonId: Für AVS Id #{tshow api} konnte kein neuer Benutzer angelegt werden, da es eine gemeinsame Id (z.B. Personalnummer) mit einem existierenden, aber verschiedenen Nutzer gibt.
AvsCardsEmpty: AVS Suche lieferte keinerlei Ausweiskarten
AvsCurrentData: Diese angezeigten Daten wurden kürzlich über die AVS Schnittstelle abgerufen.

4
messages/uniworx/categories/avs/en-eu.msg
View File

@ -55,4 +55,6 @@ AvsPersonSearchEmpty: AVS search returned empty result
AvsPersonSearchAmbiguous: AVS search returned more than one result AvsPersonSearchAmbiguous: AVS search returned more than one result
AvsSetLicencesFailed reason: Set driving licence within AVS failed. Reason: #{reason} AvsSetLicencesFailed reason: Set driving licence within AVS failed. Reason: #{reason}
AvsIdMismatch api1 api2: AVS search for id #{tshow api1} returned id #{tshow api2} instead AvsIdMismatch api1 api2: AVS search for id #{tshow api1} returned id #{tshow api2} instead
AvsUserCreationFailed api@AvsPersonId: No new user could be created for AVS Id #{tshow api}, since an existing user shares at least one id presumed as unique AvsUserCreationFailed api@AvsPersonId: No new user could be created for AVS Id #{tshow api}, since an existing user shares at least one id presumed as unique
AvsCardsEmpty: AVS search returned no id cards
AvsCurrentData: This data has been recently received via the AVS interface.

1
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -96,6 +96,7 @@ UserSetSupervisor: Ansprechpartner ersetzen
UserRemoveSupervisor: Alle Ansprechpartner entfernen UserRemoveSupervisor: Alle Ansprechpartner entfernen
UserIsSupervisor: Ist Ansprechpartner UserIsSupervisor: Ist Ansprechpartner
UserAvsSwitchCompany: Als Primärfirma verwenden UserAvsSwitchCompany: Als Primärfirma verwenden
UserAvsCompanySwitched c@CompanyName: Primärfirma gewechselt zu #{tshow c}
AllUsersLdapSync: Alle LDAP-Synchronisieren AllUsersLdapSync: Alle LDAP-Synchronisieren
AllUsersAvsSync: Alle AVS-Synchronisieren AllUsersAvsSync: Alle AVS-Synchronisieren
AuthKindLDAP: Fraport AG Kennung AuthKindLDAP: Fraport AG Kennung

1
messages/uniworx/categories/user/en-eu.msg
View File

@ -96,6 +96,7 @@ UserSetSupervisor: Replace supervisors
UserRemoveSupervisor: Set to unsupervised UserRemoveSupervisor: Set to unsupervised
UserIsSupervisor: Is supervisor UserIsSupervisor: Is supervisor
UserAvsSwitchCompany: Use as primary company UserAvsSwitchCompany: Use as primary company
UserAvsCompanySwitched c: Primary company switched to #{tshow c}
AllUsersLdapSync: Synchronise all with LDAP AllUsersLdapSync: Synchronise all with LDAP
AllUsersAvsSync: Synchronise all with AVS AllUsersAvsSync: Synchronise all with AVS
AuthKindLDAP: Fraport AG account AuthKindLDAP: Fraport AG account

2
routes
View File

@ -68,7 +68,7 @@
/admin/crontab AdminCrontabR GET /admin/crontab AdminCrontabR GET
/admin/crontab/jobs AdminJobsR GET POST /admin/crontab/jobs AdminJobsR GET POST
/admin/avs AdminAvsR GET POST /admin/avs AdminAvsR GET POST
/admin/avs/#CryptoUUIDUser AdminAvsUserR GET /admin/avs/#CryptoUUIDUser AdminAvsUserR GET POST
/admin/ldap AdminLdapR GET POST /admin/ldap AdminLdapR GET POST
/admin/problems AdminProblemsR GET POST /admin/problems AdminProblemsR GET POST
/admin/problems/no-contact ProblemUnreachableR GET /admin/problems/no-contact ProblemUnreachableR GET

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

@ -9,7 +9,7 @@
module Handler.Admin.Avs module Handler.Admin.Avs
( getAdminAvsR, postAdminAvsR ( getAdminAvsR, postAdminAvsR
, getAdminAvsUserR , getAdminAvsUserR, postAdminAvsUserR
, getProblemAvsSynchR, postProblemAvsSynchR , getProblemAvsSynchR, postProblemAvsSynchR
, getProblemAvsErrorR , getProblemAvsErrorR
) where ) where
@ -28,6 +28,7 @@ import Handler.Utils
import Handler.Utils.Avs import Handler.Utils.Avs
-- import Handler.Utils.Qualification -- import Handler.Utils.Qualification
import Handler.Utils.Users (getUserPrimaryCompany) import Handler.Utils.Users (getUserPrimaryCompany)
import Handler.Utils.Company (switchAvsUserCompany)
import Database.Esqueleto.Experimental ((:&)(..)) import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Legacy as E
@ -682,28 +683,67 @@ data UserAvsAction = UserAvsSwitchCompany
nullaryPathPiece ''UserAvsAction $ camelToPathPiece' 1 nullaryPathPiece ''UserAvsAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''UserAvsAction id embedRenderMessage ''UniWorX ''UserAvsAction id
instance Button UniWorX UserAvsAction where
btnClasses UserAvsSwitchCompany = [BCIsButton, BCDefault]
data UserAvsActionData = UserAvsSwitchCompanyData { getAvsUser :: UserId, getAvsCompany :: CompanyId }
data UserAvsActionData = UserAvsSwitchCompanyData { uaaUser :: CryptoUUIDUser, uaaCompany :: CompanyId }
deriving (Eq, Ord, Read, Show, Generic) deriving (Eq, Ord, Read, Show, Generic)
-- derivePathPiece ''UserAvsActionData (camelToPathPiece' 1) "--"
-- instance Button UniWorX UserAvsActionData where
-- btnLabel UserAvsSwitchCompanyData{uaaCompany=cmp} = [whamlet|_{MsgUserAvsSwitchCompany} #{tshow cmp}|]
getAdminAvsUserR :: CryptoUUIDUser -> Handler Html switchCompanyForm :: CryptoUUIDUser -> CompanyId -> Form UserAvsActionData
getAdminAvsUserR uuid = do switchCompanyForm uuid cid html = flip (renderAForm FormStandard) html $ UserAvsSwitchCompanyData
<$> apopt hiddenField "" (Just uuid)
<*> apopt hiddenField "" (Just cid)
<* aopt (buttonField UserAvsSwitchCompany) "" Nothing
getAdminAvsUserR, postAdminAvsUserR :: CryptoUUIDUser -> Handler Html
getAdminAvsUserR = postAdminAvsUserR
postAdminAvsUserR uuid = do
isModal <- hasCustomHeader HeaderIsModal
uid <- decrypt uuid uid <- decrypt uuid
Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid
-- let fltrById prj = over _Wrapped (Set.filter ((== userAvsPersonId) . prj)) -- not sufficiently polymorphic -- let fltrById prj = over _Wrapped (Set.filter ((== userAvsPersonId) . prj)) -- not sufficiently polymorphic
let fltrIdContact = over _Wrapped (Set.filter ((== userAvsPersonId) . avsContactPersonID)) let fltrIdContact = over _Wrapped (Set.filter ((== userAvsPersonId) . avsContactPersonID))
-- fltrIdStatus = over _Wrapped (Set.filter ((== userAvsPersonId) . avsStatusPersonID)) fltrIdStatus = over _Wrapped (Set.filter ((== userAvsPersonId) . avsStatusPersonID))
mbContact <- try $ fmap fltrIdContact $ avsQuery $ AvsQueryContact $ Set.singleton $ AvsObjPersonId userAvsPersonId mbContact <- try $ fmap fltrIdContact $ avsQuery $ AvsQueryContact $ Set.singleton $ AvsObjPersonId userAvsPersonId
-- mbStatus <- try $ fmap fltrIdStatus $ avsQuery $ AvsQueryStatus $ Set.singleton userAvsPersonId mbStatus <- try $ fmap fltrIdStatus $ avsQuery $ AvsQueryStatus $ Set.singleton userAvsPersonId
mbStatus <- try $ queryAvsFullStatus userAvsPersonId -- TODO: delete Handler.Utils.Avs.lookupAvsUser if no longer needed -- NOTE: currently needed to provide card firms that are missing in AVS status query responses -- mbStatus <- try $ queryAvsFullStatus userAvsPersonId -- TODO: delete Handler.Utils.Avs.lookupAvsUser if no longer needed -- NOTE: currently needed to provide card firms that are missing in AVS status query responses
let compsUsed :: [CI Text] = stripCI <$> mbStatus ^.. _Right . _Wrapped . folded . _avsStatusPersonCardStatus . folded . _avsDataFirm . _Just
compDict <- runDB $ do runSwitchFrom :: CompanyName -> CompanyId -> Handler Widget
mbPrimeComp <- getUserPrimaryCompany uid runSwitchFrom cname cid = do
let (primeName, fltrPrimary) = maybeEmpty mbPrimeComp $ \Company{companyName=pName, companyShorthand=pShort} -> (pName, [CompanyShorthand !=. pShort]) ((fres, fraw), fenc) <- runFormPost $ switchCompanyForm uuid cid
compsUsed :: [Text] = stripCI <$> mbStatus ^.. _Right . _Wrapped . folded . _avsStatusPersonCardStatus . folded . _avsDataFirm . _Just -- formResultModal :: (MonadHandler m, RedirectUrl (HandlerSite m) route) => FormResult a -> route -> (a -> WriterT [Message] m ()) -> m ()
fltrCmps = (CompanyName <-. compsUsed) : fltrPrimary formResultModal fres (AdminAvsUserR uuid) (\UserAvsSwitchCompanyData{..} -> do
comps <- selectList fltrCmps [Asc CompanyName] -- company name is unique problems <- lift . runDB $ do
return (primeName, Map.fromAscList [(cname,cid) | (Entity{entityKey=cid, entityVal=Company{companyName=cname}}) <- comps]) (usrUp, problems) <- switchAvsUserCompany True False uid uaaCompany
update uid usrUp
mapM_ reportAdminProblem problems
return problems
-- todo tell all problems as well
forM_ problems (\p -> tell . pure =<< messageI Error (text2message $ tshow p)) -- todo: better display of errors
let ok = if null problems then Success else Error
tell . pure =<< messageI ok (MsgUserAvsCompanySwitched cname)
)
let fwgt = wrapForm fraw def{ formAction = Just $ SomeRoute (AdminAvsUserR uuid), formEncoding = fenc, formSubmit = FormNoSubmit, formAttrs = [ asyncSubmitAttr | isModal ]}
return fwgt
compDict <- if 1 >= length compsUsed
then return mempty -- switch company only sensible if there is more than one company to choose
else do
(primName, compDict) <- runDB $ do
mbPrimeUsrComp :: Maybe UserCompany <- getUserPrimaryCompany uid
mbPrimeComp :: Maybe Company <- traverseJoin (get . userCompanyCompany) mbPrimeUsrComp
let fltrCmps = (CompanyName <-. compsUsed) : maybeEmpty mbPrimeComp (\Company{companyShorthand=pShort} -> [CompanyShorthand !=. pShort])
comps :: [Entity Company] <- selectList fltrCmps [Asc CompanyName, Asc CompanyAvsId] -- company name is already unique, but AVS sometimes contains uses whitespace
return (companyName <$> mbPrimeComp, Map.fromAscList [(cname,cid) | (Entity{entityKey=cid, entityVal=Company{companyName=cname}}) <- comps])
formDict <- Map.traverseWithKey runSwitchFrom compDict
return (primName, formDict)
msgWarningTooltip <- messageI Warning MsgMessageWarning msgWarningTooltip <- messageI Warning MsgMessageWarning
let warnBolt = messageTooltip msgWarningTooltip let warnBolt = messageTooltip msgWarningTooltip
@ -712,24 +752,27 @@ getAdminAvsUserR uuid = do
setTitle $ toHtml $ show userAvsNoPerson setTitle $ toHtml $ show userAvsNoPerson
let contactWgt = case mbContact of let contactWgt = case mbContact of
Left err -> exceptionWgt err Left err -> exceptionWgt err
Right (AvsResponseContact adcs) -> do Right (AvsResponseContact adcs) ->
let cs = mkContactWgt warnBolt userAvsNoPerson <$> toList adcs if null adcs
mconcat cs then [whamlet|_{MsgAvsPersonSearchEmpty}|]
else
let cs = mkContactWgt warnBolt userAvsNoPerson <$> toList adcs
in mconcat cs
cardsWgt = case mbStatus of cardsWgt = case mbStatus of
Left err -> exceptionWgt err Left err -> exceptionWgt err
Right (AvsResponseStatus asts) -> do Right (AvsResponseStatus asts) ->
let cs = mkCardsWgt compDict . avsStatusPersonCardStatus <$> toList asts if null asts
mconcat cs then [whamlet|This should not occur|] -- TODO
-- cardsWgt = case mbDataPerson of else
-- Nothing -> mempty let cs = mkCardsWgt compDict . avsStatusPersonCardStatus <$> toList asts
-- Just AvsDataPerson{avsPersonPersonCards=crds} -> mkCardsWgt crds in mconcat cs
[whamlet| [whamlet|
<p>
Die Ansicht zeigt ausschließlich kürzlich vom AVS abgerufene Daten:
<p> <p>
^{contactWgt} ^{contactWgt}
<p> <p>
^{cardsWgt} ^{cardsWgt}
<p>
_{MsgAvsCurrentData}
|] |]
where where
mkContactWgt :: Widget -> Int -> AvsDataContact -> Widget mkContactWgt :: Widget -> Int -> AvsDataContact -> Widget
@ -775,58 +818,64 @@ getAdminAvsUserR uuid = do
_{MsgAvsNoLicenceGuest} _{MsgAvsNoLicenceGuest}
|] |]
mkCardsWgt :: (Maybe CompanyName, Map CompanyName CompanyId) -> Set AvsDataPersonCard -> Widget mkCardsWgt :: (Maybe CompanyName, Map CompanyName Widget) -> Set AvsDataPersonCard -> Widget
mkCardsWgt (primName, compDict) crds = do mkCardsWgt (mbPrimName, compDict) crds
let hasCompany = isJust $ Set.foldr ((<|>) . avsDataFirm) Nothing crds -- some if, since a true AVS status query never delivers values for these fields, but queryAvsFullStatus-workaround does | null crds = [whamlet|_{MsgAvsCardsEmpty}|]
hasIssueDate = isJust $ Set.foldr ((<|>) . avsDataIssueDate) Nothing crds | otherwise = do
hasValidToDate = isJust $ Set.foldr ((<|>) . avsDataValidTo) Nothing crds let hasCompany = isJust $ Set.foldr ((<|>) . avsDataFirm) Nothing crds -- some if, since a true AVS status query never delivers values for these fields, but queryAvsFullStatus-workaround does
[whamlet| hasIssueDate = isJust $ Set.foldr ((<|>) . avsDataIssueDate) Nothing crds
<table> hasValidToDate = isJust $ Set.foldr ((<|>) . avsDataValidTo) Nothing crds
<thead> [whamlet|
<th>_{MsgAvsCardNo} <div .scrolltable .scrolltable-bordered>
<th>_{MsgTableAvsCardValid} <table .table .table--striped>
<th>_{MsgAvsCardColor} <thead>
<th>_{MsgAvsCardAreas} <tr .table__row .table__row--head>
$if hasIssueDate <th .table__th>_{MsgAvsCardNo}
<th>_{MsgTableAvsCardIssueDate} <th .table__th>_{MsgTableAvsCardValid}
$if hasValidToDate <th .table__th>_{MsgAvsCardColor}
<th>_{MsgTableAvsCardValidTo} <th .table__th>_{MsgAvsCardAreas}
$if hasCompany
<th>_{MsgTableCompany}
<th>
<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} #
$if hasIssueDate $if hasIssueDate
<td> <th .table__th>_{MsgTableAvsCardIssueDate}
$maybe d <- avsDataIssueDate $if hasValidToDate
^{formatTimeW SelFormatDate d} <th .table__th>_{MsgTableAvsCardValidTo}
$if hasValidToDate
<td>
$maybe d <- avsDataValidTo
^{formatTimeW SelFormatDate d}
$if hasCompany $if hasCompany
<td> <th .table__th>_{MsgTableCompany}
$maybe f <- avsDataFirm <th .table__th>_{MsgAvsPrimaryCompany}
#{f} <tbody>
<td> $forall c <- Set.toDescList crds
$maybe f <- avsDataFirm $with AvsDataPersonCard{avsDataValid,avsDataCardColor,avsDataCardAreas,avsDataFirm,avsDataIssueDate,avsDataValidTo} <- c
$if (primName == stripCI f) <tr .table__row>
current primary company <td .table__td>
$else #{tshowAvsFullCardNo (getFullCardNo c)}
$maybe cid <- compDict f <td .table__td>
switch company to #{tshow cid} #{boolSymbol avsDataValid}
|] <td .table__td>
_{avsDataCardColor}
<td .table__td>
$forall a <- avsDataCardAreas
#{a} #
$if hasIssueDate
<td .table__td>
$maybe d <- avsDataIssueDate
^{formatTimeW SelFormatDate d}
$if hasValidToDate
<td .table__td>
$maybe d <- avsDataValidTo
^{formatTimeW SelFormatDate d}
$if hasCompany
<td .table__td>
$maybe f <- avsDataFirm
#{f}
<td .table__td>
$maybe f <- avsDataFirm
$with fci <- stripCI f
$maybe primName <- mbPrimName
$if (primName == fci)
_{MsgAvsPrimaryCompany}
$else
$maybe wgt <- Map.lookup fci compDict
^{wgt}
|]

2
src/Utils.hs
View File

@ -922,7 +922,6 @@ deepAlt altFst _ = altFst
maybeEmpty :: Monoid m => Maybe a -> (a -> m) -> m maybeEmpty :: Monoid m => Maybe a -> (a -> m) -> m
maybeEmpty = flip foldMap maybeEmpty = flip foldMap
-- The more general `find :: Foldable t => (a -> Bool) -> t a -> Maybe a` -- The more general `find :: Foldable t => (a -> Bool) -> t a -> Maybe a`
filterMaybe :: (a -> Bool) -> Maybe a -> Maybe a filterMaybe :: (a -> Bool) -> Maybe a -> Maybe a
filterMaybe c r@(Just x) | c x = r filterMaybe c r@(Just x) | c x = r
@ -950,6 +949,7 @@ positiveSum = maybePositive . getSum
maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM dft act mb = mb >>= maybe dft act maybeM dft act mb = mb >>= maybe dft act
-- maybeEmptyM, maybeNotingM
traverseJoin :: (Applicative m, Traversable maybe, Monad maybe) => (a -> m (maybe b)) -> maybe a -> m (maybe b) traverseJoin :: (Applicative m, Traversable maybe, Monad maybe) => (a -> m (maybe b)) -> maybe a -> m (maybe b)
traverseJoin f x = join <$> (f `traverse` x) traverseJoin f x = join <$> (f `traverse` x)

51
src/Utils/Avs.hs
View File

@ -76,25 +76,44 @@ avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero
mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
#ifdef DEVELOPMENT #ifdef DEVELOPMENT
mkAvsQuery _ _ _ = AvsQuery mkAvsQuery _ _ _ = AvsQuery
{ avsQueryPerson = { avsQueryPerson = return . Right . fakePerson
let , avsQueryStatus = return . Right . fakeStatus
sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) mempty , avsQueryContact = return . Right . fakeContact
stephan = Set.singleton $ AvsDataPerson "Stephan" "Barth" Nothing 4 (AvsPersonId 4) mempty
steffen = Set.singleton $ AvsDataPerson "Steffen" "Jost" (Just $ mkAvsInternalPersonalNo "47138") 12345678 (AvsPersonId 12345678) mempty
in \case
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234"), avsPersonQueryVersionNo=Just "4"} -> return . Right $ AvsResponsePerson steffen
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234")} -> return . Right $ AvsResponsePerson steffen
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00009944"), avsPersonQueryVersionNo=Just "4"} -> return . Right $ AvsResponsePerson stephan
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00003344"), avsPersonQueryVersionNo=Just "1"} -> return . Right $ AvsResponsePerson sarah
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "34")} -> return . Right $ AvsResponsePerson $ steffen <> sarah
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "4") , avsPersonQueryVersionNo=Just "4"} -> return . Right $ AvsResponsePerson $ steffen <> stephan
_ -> return . Right $ AvsResponsePerson mempty
, avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty
, avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing Nothing)
, avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty , avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty
, avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty , avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty
} }
where
fakePerson :: AvsQueryPerson -> AvsResponsePerson
fakePerson =
let
sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) 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
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
in \case
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson steffen
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234")} -> AvsResponsePerson steffen
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00009944"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson stephan
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00003344"), avsPersonQueryVersionNo=Just "1"} -> AvsResponsePerson sarah
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "34")} -> AvsResponsePerson $ steffen <> sarah
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "4") , avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ steffen <> stephan
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00006666"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00007777"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00008888"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
_ -> AvsResponsePerson mempty
fakeStatus :: AvsQueryStatus -> AvsResponseStatus
fakeStatus (AvsQueryStatus (Set.toList -> (api:_))) = AvsResponseStatus $ Set.singleton $ AvsStatusPerson api $ Set.fromList
[ AvsDataPersonCard True (Just $ fromGregorian 2026 5 1) Nothing AvsCardColorGelb (Set.fromList ['F','R','C']) Nothing Nothing Nothing (Just "Fraport AG") (AvsCardNo "6666") "4"
, AvsDataPersonCard False (Just $ fromGregorian 2025 6 2) Nothing AvsCardColorRot (Set.fromList ['F','A' ]) Nothing Nothing Nothing (Just "N*ICE Aircraft Services & Support GmbH") (AvsCardNo "7777") "4"
, AvsDataPersonCard True (Just $ fromGregorian 2028 7 3) Nothing AvsCardColorBlau mempty Nothing Nothing Nothing (Just "Fraport Facility Services GmbH") (AvsCardNo "8888") "4"
]
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 _ = AvsResponseContact mempty
#else #else
mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
{ avsQueryPerson = \q -> if q == def then return $ Right $ AvsResponsePerson mempty else -- prevent empty queries { avsQueryPerson = \q -> if q == def then return $ Right $ AvsResponsePerson mempty else -- prevent empty queries