From 21273e361aa6f9722650eb6871c7bb8aa88a68dc Mon Sep 17 00:00:00 2001 From: Steffen Date: Fri, 3 May 2024 17:17:24 +0200 Subject: [PATCH] chore(avs): fix #76 allowing admins to switch to secondary company --- .../uniworx/categories/avs/de-de-formal.msg | 4 +- messages/uniworx/categories/avs/en-eu.msg | 4 +- .../uniworx/categories/user/de-de-formal.msg | 1 + messages/uniworx/categories/user/en-eu.msg | 1 + routes | 2 +- src/Handler/Admin/Avs.hs | 199 +++++++++++------- src/Utils.hs | 2 +- src/Utils/Avs.hs | 51 +++-- 8 files changed, 169 insertions(+), 95 deletions(-) diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index 801c49e55..316f053dc 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -55,4 +55,6 @@ AvsPersonSearchEmpty: AVS Suche lieferte leeres Ergebnis AvsPersonSearchAmbiguous: AVS Suche lieferte mehrere uneindeutige Ergebnisse 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} -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. \ No newline at end of file +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. \ No newline at end of file diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index f942bd92f..6ce16160f 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -55,4 +55,6 @@ AvsPersonSearchEmpty: AVS search returned empty result AvsPersonSearchAmbiguous: AVS search returned more than one result AvsSetLicencesFailed reason: Set driving licence within AVS failed. Reason: #{reason} 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 \ No newline at end of file +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. \ No newline at end of file diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index a5447bd65..1f6900a20 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -96,6 +96,7 @@ UserSetSupervisor: Ansprechpartner ersetzen UserRemoveSupervisor: Alle Ansprechpartner entfernen UserIsSupervisor: Ist Ansprechpartner UserAvsSwitchCompany: Als Primärfirma verwenden +UserAvsCompanySwitched c@CompanyName: Primärfirma gewechselt zu #{tshow c} AllUsersLdapSync: Alle LDAP-Synchronisieren AllUsersAvsSync: Alle AVS-Synchronisieren AuthKindLDAP: Fraport AG Kennung diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index dbad43215..fd5cde532 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -96,6 +96,7 @@ UserSetSupervisor: Replace supervisors UserRemoveSupervisor: Set to unsupervised UserIsSupervisor: Is supervisor UserAvsSwitchCompany: Use as primary company +UserAvsCompanySwitched c: Primary company switched to #{tshow c} AllUsersLdapSync: Synchronise all with LDAP AllUsersAvsSync: Synchronise all with AVS AuthKindLDAP: Fraport AG account diff --git a/routes b/routes index b3871ef8c..0585153a1 100644 --- a/routes +++ b/routes @@ -68,7 +68,7 @@ /admin/crontab AdminCrontabR GET /admin/crontab/jobs AdminJobsR GET POST /admin/avs AdminAvsR GET POST -/admin/avs/#CryptoUUIDUser AdminAvsUserR GET +/admin/avs/#CryptoUUIDUser AdminAvsUserR GET POST /admin/ldap AdminLdapR GET POST /admin/problems AdminProblemsR GET POST /admin/problems/no-contact ProblemUnreachableR GET diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 0cb2fa130..b04ea3795 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -9,7 +9,7 @@ module Handler.Admin.Avs ( getAdminAvsR, postAdminAvsR - , getAdminAvsUserR + , getAdminAvsUserR, postAdminAvsUserR , getProblemAvsSynchR, postProblemAvsSynchR , getProblemAvsErrorR ) where @@ -28,6 +28,7 @@ import Handler.Utils import Handler.Utils.Avs -- import Handler.Utils.Qualification import Handler.Utils.Users (getUserPrimaryCompany) +import Handler.Utils.Company (switchAvsUserCompany) import Database.Esqueleto.Experimental ((:&)(..)) import qualified Database.Esqueleto.Legacy as E @@ -682,28 +683,67 @@ data UserAvsAction = UserAvsSwitchCompany nullaryPathPiece ''UserAvsAction $ camelToPathPiece' 1 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) +-- derivePathPiece ''UserAvsActionData (camelToPathPiece' 1) "--" +-- instance Button UniWorX UserAvsActionData where +-- btnLabel UserAvsSwitchCompanyData{uaaCompany=cmp} = [whamlet|_{MsgUserAvsSwitchCompany} #{tshow cmp}|] -getAdminAvsUserR :: CryptoUUIDUser -> Handler Html -getAdminAvsUserR uuid = do +switchCompanyForm :: CryptoUUIDUser -> CompanyId -> Form UserAvsActionData +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 Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid -- let fltrById prj = over _Wrapped (Set.filter ((== userAvsPersonId) . prj)) -- not sufficiently polymorphic 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 - -- 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 $ 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 + let compsUsed :: [CI Text] = stripCI <$> mbStatus ^.. _Right . _Wrapped . folded . _avsStatusPersonCardStatus . folded . _avsDataFirm . _Just - compDict <- runDB $ do - mbPrimeComp <- getUserPrimaryCompany uid - let (primeName, fltrPrimary) = maybeEmpty mbPrimeComp $ \Company{companyName=pName, companyShorthand=pShort} -> (pName, [CompanyShorthand !=. pShort]) - compsUsed :: [Text] = stripCI <$> mbStatus ^.. _Right . _Wrapped . folded . _avsStatusPersonCardStatus . folded . _avsDataFirm . _Just - fltrCmps = (CompanyName <-. compsUsed) : fltrPrimary - comps <- selectList fltrCmps [Asc CompanyName] -- company name is unique - return (primeName, Map.fromAscList [(cname,cid) | (Entity{entityKey=cid, entityVal=Company{companyName=cname}}) <- comps]) + runSwitchFrom :: CompanyName -> CompanyId -> Handler Widget + runSwitchFrom cname cid = do + ((fres, fraw), fenc) <- runFormPost $ switchCompanyForm uuid cid + -- formResultModal :: (MonadHandler m, RedirectUrl (HandlerSite m) route) => FormResult a -> route -> (a -> WriterT [Message] m ()) -> m () + formResultModal fres (AdminAvsUserR uuid) (\UserAvsSwitchCompanyData{..} -> do + problems <- lift . runDB $ do + (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 let warnBolt = messageTooltip msgWarningTooltip @@ -712,24 +752,27 @@ getAdminAvsUserR uuid = do setTitle $ toHtml $ show userAvsNoPerson let contactWgt = case mbContact of Left err -> exceptionWgt err - Right (AvsResponseContact adcs) -> do - let cs = mkContactWgt warnBolt userAvsNoPerson <$> toList adcs - mconcat cs + Right (AvsResponseContact adcs) -> + if null adcs + then [whamlet|_{MsgAvsPersonSearchEmpty}|] + else + let cs = mkContactWgt warnBolt userAvsNoPerson <$> toList adcs + in mconcat cs cardsWgt = case mbStatus of Left err -> exceptionWgt err - Right (AvsResponseStatus asts) -> do - let cs = mkCardsWgt compDict . avsStatusPersonCardStatus <$> toList asts - mconcat cs - -- cardsWgt = case mbDataPerson of - -- Nothing -> mempty - -- Just AvsDataPerson{avsPersonPersonCards=crds} -> mkCardsWgt crds + Right (AvsResponseStatus asts) -> + if null asts + then [whamlet|This should not occur|] -- TODO + else + let cs = mkCardsWgt compDict . avsStatusPersonCardStatus <$> toList asts + in mconcat cs [whamlet| -

- Die Ansicht zeigt ausschließlich kürzlich vom AVS abgerufene Daten:

^{contactWgt}

^{cardsWgt} +

+ _{MsgAvsCurrentData} |] where mkContactWgt :: Widget -> Int -> AvsDataContact -> Widget @@ -775,58 +818,64 @@ getAdminAvsUserR uuid = do _{MsgAvsNoLicenceGuest} |] - mkCardsWgt :: (Maybe CompanyName, Map CompanyName CompanyId) -> Set AvsDataPersonCard -> Widget - mkCardsWgt (primName, compDict) crds = do - 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 - hasIssueDate = isJust $ Set.foldr ((<|>) . avsDataIssueDate) Nothing crds - hasValidToDate = isJust $ Set.foldr ((<|>) . avsDataValidTo) Nothing crds - [whamlet| - - - - $forall c <- crds - $with AvsDataPersonCard{avsDataValid,avsDataCardColor,avsDataCardAreas,avsDataFirm,avsDataIssueDate,avsDataValidTo} <- c - -
_{MsgAvsCardNo} - _{MsgTableAvsCardValid} - _{MsgAvsCardColor} - _{MsgAvsCardAreas} - $if hasIssueDate - _{MsgTableAvsCardIssueDate} - $if hasValidToDate - _{MsgTableAvsCardValidTo} - $if hasCompany - _{MsgTableCompany} - -
- #{tshowAvsFullCardNo (getFullCardNo c)} - - #{boolSymbol avsDataValid} - - _{avsDataCardColor} - - $forall a <- avsDataCardAreas - #{a} # + mkCardsWgt :: (Maybe CompanyName, Map CompanyName Widget) -> Set AvsDataPersonCard -> Widget + mkCardsWgt (mbPrimName, compDict) crds + | null crds = [whamlet|_{MsgAvsCardsEmpty}|] + | otherwise = do + 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 + hasIssueDate = isJust $ Set.foldr ((<|>) . avsDataIssueDate) Nothing crds + hasValidToDate = isJust $ Set.foldr ((<|>) . avsDataValidTo) Nothing crds + [whamlet| +
+ + + + + $forall c <- Set.toDescList crds + $with AvsDataPersonCard{avsDataValid,avsDataCardColor,avsDataCardAreas,avsDataFirm,avsDataIssueDate,avsDataValidTo} <- c + +
_{MsgAvsCardNo} + _{MsgTableAvsCardValid} + _{MsgAvsCardColor} + _{MsgAvsCardAreas} $if hasIssueDate - - $maybe d <- avsDataIssueDate - ^{formatTimeW SelFormatDate d} - $if hasValidToDate - - $maybe d <- avsDataValidTo - ^{formatTimeW SelFormatDate d} + _{MsgTableAvsCardIssueDate} + $if hasValidToDate + _{MsgTableAvsCardValidTo} $if hasCompany - - $maybe f <- avsDataFirm - #{f} - - $maybe f <- avsDataFirm - $if (primName == stripCI f) - current primary company - $else - $maybe cid <- compDict f - switch company to #{tshow cid} - |] + _{MsgTableCompany} + _{MsgAvsPrimaryCompany} +
+ #{tshowAvsFullCardNo (getFullCardNo c)} + + #{boolSymbol avsDataValid} + + _{avsDataCardColor} + + $forall a <- avsDataCardAreas + #{a} # + $if hasIssueDate + + $maybe d <- avsDataIssueDate + ^{formatTimeW SelFormatDate d} + $if hasValidToDate + + $maybe d <- avsDataValidTo + ^{formatTimeW SelFormatDate d} + $if hasCompany + + $maybe f <- avsDataFirm + #{f} + + $maybe f <- avsDataFirm + $with fci <- stripCI f + $maybe primName <- mbPrimName + $if (primName == fci) + _{MsgAvsPrimaryCompany} + $else + $maybe wgt <- Map.lookup fci compDict + ^{wgt} + |] diff --git a/src/Utils.hs b/src/Utils.hs index 8cdad90a8..21685f564 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -922,7 +922,6 @@ deepAlt altFst _ = altFst maybeEmpty :: Monoid m => Maybe a -> (a -> m) -> m maybeEmpty = flip foldMap - -- The more general `find :: Foldable t => (a -> Bool) -> t a -> Maybe a` filterMaybe :: (a -> Bool) -> Maybe a -> Maybe a 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 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 f x = join <$> (f `traverse` x) diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index a9c81a7c4..c54b80864 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -76,25 +76,44 @@ avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery #ifdef DEVELOPMENT mkAvsQuery _ _ _ = AvsQuery - { avsQueryPerson = - 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 - - 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) + { avsQueryPerson = return . Right . fakePerson + , avsQueryStatus = return . Right . fakeStatus + , avsQueryContact = return . Right . fakeContact , avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences 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 mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery { avsQueryPerson = \q -> if q == def then return $ Right $ AvsResponsePerson mempty else -- prevent empty queries