chore(avs): fix #76 allowing admins to switch to secondary company
This commit is contained in:
parent
5944efcb86
commit
21273e361a
@ -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.
|
||||
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.
|
||||
@ -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
|
||||
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.
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
2
routes
2
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
|
||||
|
||||
@ -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|
|
||||
<p>
|
||||
Die Ansicht zeigt ausschließlich kürzlich vom AVS abgerufene Daten:
|
||||
<p>
|
||||
^{contactWgt}
|
||||
<p>
|
||||
^{cardsWgt}
|
||||
<p>
|
||||
_{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|
|
||||
<table>
|
||||
<thead>
|
||||
<th>_{MsgAvsCardNo}
|
||||
<th>_{MsgTableAvsCardValid}
|
||||
<th>_{MsgAvsCardColor}
|
||||
<th>_{MsgAvsCardAreas}
|
||||
$if hasIssueDate
|
||||
<th>_{MsgTableAvsCardIssueDate}
|
||||
$if hasValidToDate
|
||||
<th>_{MsgTableAvsCardValidTo}
|
||||
$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} #
|
||||
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|
|
||||
<div .scrolltable .scrolltable-bordered>
|
||||
<table .table .table--striped>
|
||||
<thead>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgAvsCardNo}
|
||||
<th .table__th>_{MsgTableAvsCardValid}
|
||||
<th .table__th>_{MsgAvsCardColor}
|
||||
<th .table__th>_{MsgAvsCardAreas}
|
||||
$if hasIssueDate
|
||||
<td>
|
||||
$maybe d <- avsDataIssueDate
|
||||
^{formatTimeW SelFormatDate d}
|
||||
$if hasValidToDate
|
||||
<td>
|
||||
$maybe d <- avsDataValidTo
|
||||
^{formatTimeW SelFormatDate d}
|
||||
<th .table__th>_{MsgTableAvsCardIssueDate}
|
||||
$if hasValidToDate
|
||||
<th .table__th>_{MsgTableAvsCardValidTo}
|
||||
$if hasCompany
|
||||
<td>
|
||||
$maybe f <- avsDataFirm
|
||||
#{f}
|
||||
<td>
|
||||
$maybe f <- avsDataFirm
|
||||
$if (primName == stripCI f)
|
||||
current primary company
|
||||
$else
|
||||
$maybe cid <- compDict f
|
||||
switch company to #{tshow cid}
|
||||
|]
|
||||
<th .table__th>_{MsgTableCompany}
|
||||
<th .table__th>_{MsgAvsPrimaryCompany}
|
||||
<tbody>
|
||||
$forall c <- Set.toDescList crds
|
||||
$with AvsDataPersonCard{avsDataValid,avsDataCardColor,avsDataCardAreas,avsDataFirm,avsDataIssueDate,avsDataValidTo} <- c
|
||||
<tr .table__row>
|
||||
<td .table__td>
|
||||
#{tshowAvsFullCardNo (getFullCardNo c)}
|
||||
<td .table__td>
|
||||
#{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}
|
||||
|]
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user