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

chore(avs): construct comprehensive avs queries

Browse Source
This commit is contained in:
Steffen Jost 2022-09-28 18:13:23 +02:00
parent 9830cb2503
commit 3b34627733
2 changed files with 50 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Handler/Utils/Avs.hs
View File

@ -26,6 +26,11 @@ data AvsException
deriving (Show, Generic, Typeable)
instance Exception AvsException
{-
Error Handling: in Addition to AvsException, Servant.ClientError must be expected. Maybe we should wrap it within an AvsException?
-}
------------------
-- AVS Handlers --
------------------
@ -38,8 +43,6 @@ instance Exception AvsException
-}
-- Do we need this?
-- getLicence :: UserId -> Handler (Maybe AvsLicence) -- with runDB
getLicence :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, WithRunDB SqlReadBackend (HandlerFor UniWorX) m ) => UserId -> m (Maybe AvsLicence)
@ -114,9 +117,13 @@ upsertAvsUser api = do
-- lookupAvsUser :: AvsPersonId ->
lookupAvsUser api = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
-- avsQueryPerson does not support querying an AvsPersonId, hence we need a preliminary avsQueryStatus to get all AvsCardNo
-- avsQueryPerson does not support querying an AvsPersonId directly,
-- hence we need a preliminary avsQueryStatus to get all AvsCardNo.
-- Note that avsQueryStatus only provides limited information
AvsResponseStatus statuses <- throwLeftM $ avsQueryStatus $ AvsQueryStatus $ Set.singleton api
_avsperson <- forM statuses $ \AvsStatusPerson{avsStatusPersonCardStatus} ->
foldlM Map.empty avsStatusPersonCardStatus
TODO TODO TODO
forM avsStatusPersonCardStatus $ \AvsDataPersonCard{avsDataCardNo} ->
AvsResponsePerson ps <- throwLeftM $ avsQueryPerson $ AvsQueryPerson def{avsPersonQueryCardNo = avsDataCardNo}
return $ mergeByPersonId ps

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

@ -140,15 +140,15 @@ instance FromJSON AvsDataCardColor where
data AvsDataPersonCard = AvsDataPersonCard
{ avsDataValid :: Bool -- card currently valid? Note that AVS encodes booleans as JSON String "true" and "false" and not as JSON booleans
, avsDataValidTo :: Maybe Day -- always Nothing if returned with AvsResponseStatus
, avsDataIssueDate :: Maybe Day -- always Nothing if returned with AvsResponseStatus
{ avsDataValid :: Bool -- card currently valid? Note that AVS encodes booleans as JSON String "true" and "false" and not as JSON booleans
, avsDataValidTo :: Maybe Day -- Nothing if returned with AvsResponseStatus
, avsDataIssueDate :: Maybe Day -- Nothing if returned with AvsResponseStatus
, avsDataCardColor :: AvsDataCardColor
, avsDataCardAreas :: Set Char -- logically a set of upper-case letters
, avsDataStreet :: Maybe Text -- always Nothing if returned with AvsResponseStatus
, avsDataPostalCode:: Maybe Text -- always Nothing if returned with AvsResponseStatus
, avsDataCity :: Maybe Text -- always Nothing if returned with AvsResponseStatus
, avsDataFirm :: Maybe Text -- always Nothing if returned with AvsResponseStatus
, avsDataCardAreas :: Set Char -- logically a set of upper-case letters
, avsDataStreet :: Maybe Text -- Nothing if returned with AvsResponseStatus
, avsDataPostalCode:: Maybe Text -- Nothing if returned with AvsResponseStatus
, avsDataCity :: Maybe Text -- Nothing if returned with AvsResponseStatus
, avsDataFirm :: Maybe Text -- Nothing if returned with AvsResponseStatus
, avsDataCardNo :: AvsCardNo -- always 8 digits
, avsDataVersionNo :: Text
}
@ -236,7 +236,7 @@ deriveJSON defaultOptions
data AvsStatusPerson = AvsStatusPerson
{ avsStatusPersonID :: AvsPersonId
, avsStatusPersonCardStatus :: Set AvsDataPersonCard
, avsStatusPersonCardStatus :: Set AvsDataPersonCard -- only delivers non-Maybe fields, all Maybe-fields are Nothing
}
deriving (Eq, Ord, Read, Show, Generic, Typeable)
@ -462,6 +462,36 @@ bestAddress :: AvsDataPersonCard -> AvsDataPersonCard -> Ordering
compareBy f = compare `on` f a b
-}
mergeAvsDataPerson :: Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson
mergeAvsDataPerson = Map.unionWithKey merger
where
merger :: AvsPersonId -> AvsDataPerson -> AvsDataPerson -> AvsDataPerson
merger api pa pb =
let pickBy' :: Ord b => (a -> b) -> (AvsDataPerson -> a) -> a
pickBy' f p = pickBy f (p pa) (p pb) -- pickBy f `on` p pa pb
in AvsDataPerson
{ avsPersonFirstName = pickBy' Text.length avsPersonFirstName
, avsPersonLastName = pickBy' Text.length avsPersonLastName
, avsPersonInternalPersonalNo = pickBy' (Text.length . fromMaybe mempty) avsPersonInternalPersonalNo
, avsPersonPersonNo = pickBy' id avsPersonPersonNo
, avsPersonPersonID = api -- keys must be identical due to call with insertWithKey
, avsPersonPersonCards = (Set.union `on` avsPersonPersonCards) pa pb
}
pickBy :: Ord b => (a -> b) -> a -> a -> a
pickBy f x y | f x >= f y = x
| otherwise = y
catalogueAvsDataPerson :: AvsDataPerson -> Map AvsPersonId AvsDataPerson
catalogueAvsDataPerson adp = Map.singleton (avsPersonPersonID adp) adp
mergeByPersonId :: Set AvsDataPerson -> Map AvsPersonId AvsDataPerson
mergeByPersonId = Set.foldr aux Map.empty
where
aux :: AvsDataPerson -> Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson
aux adp = mergeAvsDataPerson $ catalogueAvsDataPerson adp
{- Not general enough:
mergeByPersonId :: Set AvsDataPerson -> Map AvsPersonId AvsDataPerson
mergeByPersonId = Set.foldr aux Map.empty
where
@ -484,3 +514,4 @@ mergeByPersonId = Set.foldr aux Map.empty
pickBy :: Ord b => (a -> b) -> a -> a -> a
pickBy f x y | f x >= f y = x
| otherwise = y
-}