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

chore(avs): card no filter basic functionality WIP compiles

Browse Source
This commit is contained in:
Steffen Jost 2024-02-12 18:44:14 +01:00
parent 482dbe5c4e
commit d4f7dce716
7 changed files with 95 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Audit.hs
View File

@ -130,7 +130,7 @@ logInterface :: ( AuthId (HandlerSite m) ~ Key User
logInterface interfaceLogInterface interfaceLogSubtype interfaceLogRows interfaceLogInfo = do
interfaceLogTime <- liftIO getCurrentTime
interfaceLogWrite <- (methodGet /=) . Wai.requestMethod . reqWaiRequest <$> getRequest
deleteBy $ UniqueInterfaceSubtypeWrite interfaceLogInterface interfaceLogSubtype interfaceLogWrite -- always replace, deleteBy & insert seems to be safest and fastest
deleteBy $ UniqueInterfaceSubtypeWrite interfaceLogInterface interfaceLogSubtype interfaceLogWrite -- always replace, deleteBy & insert is correct here, since we want to repalce the it
insert_ InterfaceLog{..}
audit TransactionInterface
{ transactionInterfaceName = interfaceLogInterface

2
src/Handler/Firm.hs
View File

@ -619,7 +619,7 @@ mkFirmAllTable isAdmin uid = do
case criterion of
Nothing -> return True :: DB Bool
(Just (crit::Text)) -> do
critFirms <- memcachedBy (Just . Right $ 1 * diffMinute) ("SVR:"<>crit) $ fmap (Set.fromList . fmap E.unValue) $ E.select $ E.distinct $ do
critFirms <- memcachedBy (Just . Right $ 3 * diffMinute) ("SVR:"<>crit) $ fmap (Set.fromList . fmap E.unValue) $ E.select $ E.distinct $ do
(usr :& cmp) <- E.from $ E.table @User `E.innerJoin` E.table @Company
`E.on` (\(usr :& cmp) -> E.exists (do
usrCmp <- E.from $ E.table @UserCompany

23
src/Handler/Qualification.hs
View File

@ -18,7 +18,7 @@ import Import
import Handler.Utils
import Handler.Utils.Users
import Handler.Utils.LMS
import Handler.Utils.Avs (queryAvsCardNos)
import qualified Data.Set as Set
import qualified Data.Map as Map
@ -418,15 +418,20 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
-- E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo)
-- )
-- , single ("avs-card" , FilterColumnIO $ \(queryUser -> user) (criterion :: [Text]) -> const (return E.true :: IO (E.SqlExpr (E.Value Bool))) -- putStrLn "******** IT WORKS *****************"
, single ("avs-card" , FilterColumnIO $ \(criteria :: [Text]) ->
, single ("avs-card" , FilterColumnHandler $ \(criteria :: [Text]) ->
case criteria of
[] -> return (const E.true) :: IO (QualificationTableExpr -> E.SqlExpr (E.Value Bool))
[] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool))
xs -> do
putStrLn "******** IT WORKS *****************"
putStrLn $ tshow (length xs) <> ": " <> T.intercalate ", " criteria
putStrLn "******** IT WORKS *****************"
return $ \(queryUser-> user) ->
user E.^. UserFirstName `E.in_` E.vals xs
apids <- queryAvsCardNos $ mapMaybe parseAvsCardNo xs -- $ foldMap cfAnySeparatedSet xs TODO
if null apids
then
-- addMessageI ???
return (const E.false)
else
return $ \(queryUser-> user) ->
E.exists $ E.from $ \usrAvs ->
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
E.&&. usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids
)
, single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if
| Set.null criteria -> E.true
@ -458,7 +463,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
, prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo)
, prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo) -- & cfAnySeparatedSet
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
, if isNothing mbRenewal then mempty

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

@ -22,6 +22,8 @@ module Handler.Utils.Avs
, AvsException(..)
, updateReceivers
, AvsPersonIdMapPersonCard
-- CR3
, queryAvsCardNo, queryAvsCardNos
) where
import Import
@ -41,6 +43,7 @@ import Foundation.Yesod.Auth (ldapLookupAndUpsert) -- , CampusUserConversionExce
import Handler.Utils.Company
import Handler.Utils.Qualification
import Handler.Utils.Memcached
import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
@ -160,7 +163,6 @@ setLicencesAvs persLics = do -- exceptT (return 0 <$ addMessage Error . text2Htm
-- | Retrieve all currently valid driving licences and check against our database
-- Only react to changes as compared to last seen status in avs.model
-- TODO: run in a background job, once the interface is actually available
synchAvsLicences :: Handler Bool
synchAvsLicences = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
@ -340,7 +342,7 @@ guessAvsUser (Text.splitAt 6 -> ("AVSNO:", avsnoTxt)) = ifMaybeM (readMay avsnoT
guessAvsUser someid = do
let maybeUpsertAvsUserByCard = maybeCatchAll . upsertAvsUserByCard
case discernAvsCardPersonalNo someid of
Just cid@(Left _cardNo) -> maybeUpsertAvsUserByCard cid
Just cid@(Right _cardNo) -> maybeUpsertAvsUserByCard cid
-- NOTE: card validity might be outdated, so we must always check with avs
-- maybeM (maybeUpsertAvsUserByCard cid) extractUid $ runDB $ do
-- let extractUid (Entity _ UserAvs{userAvsUser=uid}) = return $ Just uid
@ -349,7 +351,7 @@ guessAvsUser someid = do
-- case [c | cent <- cards, let c = entityVal cent, avsDataValid (userAvsCardCard c)] of
-- [justOneCard] -> maybeM (return Nothing) extractUidCard (return $ Just justOneCard)
-- _ -> return Nothing
Just cid@(Right _wholeNumber) ->
Just cid@(Left _wholeNumber) ->
maybeUpsertAvsUserByCard cid >>= \case
Nothing ->
runDB (selectList [UserCompanyPersonalNumber ==. Just someid] []) >>= \case
@ -358,7 +360,7 @@ guessAvsUser someid = do
uid -> return uid
Nothing -> try (runDB $ ldapLookupAndUpsert someid) >>= \case
Right Entity{entityKey=uid, entityVal=User{userCompanyPersonalNumber=Just persNo}} ->
maybeM (return $ Just uid) (return . Just) (maybeUpsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo))
maybeM (return $ Just uid) (return . Just) (maybeUpsertAvsUserByCard (Left $ mkAvsInternalPersonalNo persNo))
Right Entity{entityKey=uid} -> return $ Just uid
other -> do -- attempt to recover by trying other ids
whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser LDAP error " <> tshow err) -- this line primarily forces exception type to catch-all
@ -372,7 +374,7 @@ upsertAvsUser :: Text -> Handler (Maybe UserId) -- TODO: change to Entity
upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = maybeCatchAll $ upsertAvsUserByCard someid -- Note: Right case is any number; it could be AvsCardNumber or AvsInternalPersonalNumber; we cannot know, but the latter is much more likely and useful to users!
upsertAvsUser otherId = -- attempt LDAP lookup to find by eMail
try (runDB $ ldapLookupAndUpsert otherId) >>= \case
Right Entity{entityVal=User{userCompanyPersonalNumber=Just persNo}} -> maybeCatchAll $ upsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo)
Right Entity{entityVal=User{userCompanyPersonalNumber=Just persNo}} -> maybeCatchAll $ upsertAvsUserByCard (Left $ mkAvsInternalPersonalNo persNo)
other -> do -- attempt to recover by trying other ids
whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser LDAP error " <> tshow err) -- this line primarily forces exception type to catch-all
apid <- runDB . runMaybeT $ do
@ -385,11 +387,11 @@ upsertAvsUser otherId = -- attempt LDAP lookup to find by eMail
-- | Given CardNo or internal Number, retrieve UserId. Create non-existing users, if possible. Always update.
-- Throws errors if the avsInterface in unavailable or the user is non-unique within external AVS DB.
upsertAvsUserByCard :: Either AvsFullCardNo AvsInternalPersonalNo -> Handler (Maybe UserId) -- Idee: Eingabe ohne Punkt is AvsInternalPersonalNo mit Punkt is Ausweisnummer?!
upsertAvsUserByCard :: Either AvsInternalPersonalNo AvsFullCardNo -> Handler (Maybe UserId) -- Idee: Eingabe ohne Punkt is AvsInternalPersonalNo mit Punkt is Ausweisnummer?!
upsertAvsUserByCard persNo = do
let qry = case persNo of
Left AvsFullCardNo{..} -> def{ avsPersonQueryCardNo = Just avsFullCardNo, avsPersonQueryVersionNo = Just avsFullCardVersion }
Right fpn -> def{ avsPersonQueryInternalPersonalNo = Just fpn }
Right AvsFullCardNo{..} -> def{ avsPersonQueryCardNo = Just avsFullCardNo, avsPersonQueryVersionNo = Just avsFullCardVersion }
Left fpn -> def{ avsPersonQueryInternalPersonalNo = Just fpn }
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
AvsResponsePerson adps <- throwLeftM $ avsQueryPerson qry
case Set.elems adps of
@ -571,6 +573,25 @@ updateReceivers uid = do
------------------
-- CR3 Functions
queryAvsCardNos :: Foldable t => t (Either AvsCardNo AvsFullCardNo) -> Handler (Set AvsPersonId)
queryAvsCardNos = foldMapM queryAvsCardNo
queryAvsCardNo :: Either AvsCardNo AvsFullCardNo -> Handler (Set AvsPersonId)
queryAvsCardNo crd = do
AvsResponsePerson adps <- avsPersonQueryCached $ qry crd
return $ Set.map avsPersonPersonID adps
where
qry (Left acno) = def{ avsPersonQueryCardNo = Just acno }
qry (Right AvsFullCardNo{..}) = def{ avsPersonQueryCardNo = Just avsFullCardNo
, avsPersonQueryVersionNo = Just avsFullCardVersion
}
avsPersonQueryCached :: AvsQueryPerson -> Handler AvsResponsePerson
avsPersonQueryCached apq = memcachedBy (Just . Right $ 5 * diffMinute) apq $ do -- TODO using settings for time
AvsQuery{avsQueryPerson} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
throwLeftM $ avsQueryPerson apq
-- A datatype for a specific heterogeneous list
-- data CheckAvsUpdate record iavs = forall typ f. (Eq typ, PersistField typ, Functor f) => CheckAvsUpdate (EntityField record typ) ((typ -> f typ) -> iavs -> f iavs) -- An Record Field and fitting Lens
data CheckAvsUpdate record iavs = forall typ. (Eq typ, PersistField typ) => CheckAvsUpdate (EntityField record typ) ((typ -> Const typ typ) -> iavs -> Const typ iavs) -- An Record Field and fitting Lens

28
src/Handler/Utils/Table/Pagination.hs
View File

@ -22,7 +22,7 @@ module Handler.Utils.Table.Pagination
, SortColumn(..), SortDirection(..)
, SortingSetting(..)
, pattern SortAscBy, pattern SortDescBy
, FilterColumn(..), IsFilterColumn, IsFilterColumnIO, IsFilterProjected
, FilterColumn(..), IsFilterColumn, IsFilterColumnHandler, IsFilterProjected
, mkFilterProjectedPost
, DBTProjFilterPost(..)
, DBRow(..), _dbrOutput, _dbrCount
@ -262,7 +262,7 @@ instance Monoid (DBTProjFilterPost r') where
data FilterColumn t fs = forall a. IsFilterColumn t a => FilterColumn a
| forall a. IsFilterColumnIO t a => FilterColumnIO a
| forall a. IsFilterColumnHandler t a => FilterColumnHandler a
| forall a. IsFilterProjected fs a => FilterProjected a
@ -270,9 +270,9 @@ filterColumn :: FilterColumn t fs -> Maybe ([Text] -> t -> E.SqlExpr (E.Value Bo
filterColumn (FilterColumn f) = Just $ filterColumn' f
filterColumn _ = Nothing
filterColumnIO :: FilterColumn t fs -> Maybe ([Text] -> IO (t -> E.SqlExpr (E.Value Bool)))
filterColumnIO (FilterColumnIO f) = Just $ filterColumnIO' f
filterColumnIO _ = Nothing
filterColumnHandler :: FilterColumn t fs -> Maybe ([Text] -> Handler (t -> E.SqlExpr (E.Value Bool)))
filterColumnHandler (FilterColumnHandler f) = Just $ filterColumnHandler' f
filterColumnHandler _ = Nothing
filterProjected :: FilterColumn t fs -> [Text] -> (fs -> fs)
filterProjected (FilterProjected f) = filterProjected' f
@ -293,11 +293,11 @@ instance IsFilterColumn t cont => IsFilterColumn t (t -> cont) where
instance {-# OVERLAPPABLE #-} (PathPiece (Element l), IsFilterColumn t cont, MonoPointed l, Monoid l) => IsFilterColumn t (l -> cont) where
filterColumn' cont is' = filterColumn' (cont $ is' ^. mono' _PathPiece) is'
class IsFilterColumnIO t a where
filterColumnIO' :: a -> [Text] -> IO (t -> E.SqlExpr (E.Value Bool))
class IsFilterColumnHandler t a where
filterColumnHandler' :: a -> [Text] -> Handler (t -> E.SqlExpr (E.Value Bool))
instance IsFilterColumnIO t ([Text] -> IO (t -> E.SqlExpr (E.Value Bool))) where
filterColumnIO' fin args = fin args
instance IsFilterColumnHandler t ([Text] -> Handler (t -> E.SqlExpr (E.Value Bool))) where
filterColumnHandler' fin args = fin args
class IsFilterProjected fs a where
filterProjected' :: a -> [Text] -> (fs -> fs)
@ -1217,10 +1217,10 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
-- && all (is _Just) filterSql
-- psLimit' = bool PagesizeAll psLimit selectPagesize
filterIO <- case csvMode of
FormSuccess DBCsvImport{} -> return mempty -- don't execute IO actions for unneeded filters upon csv _import_
_other -> liftIO $ forM psFilter' $ \(fc,args) -> mapM ($ args) $ filterColumnIO fc -- TODO: add timeout
filterHandler <- case csvMode of
FormSuccess DBCsvImport{} -> return mempty -- don't execute Handler actions for unneeded filters upon csv _import_
_other -> liftHandler $ forM psFilter' $ \(fc,args) -> mapM ($ args) $ filterColumnHandler fc
rows' <- E.select . E.from $ \t -> do
res <- dbtSQLQuery t
@ -1240,7 +1240,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
Just ps -> E.where_ $ dbtRowKey t `E.sqlIn` ps -- Note that multiple where_ are indeed concatenated
_other -> return ()
let filterAppT = Map.foldr (\fc expr -> maybe expr ((: expr) . ($ t)) fc) []
sqlFilters = filterAppT filterIO <> filterAppT filterSql -- Note that <> on the maps won't work as intended, since keys are present in both
sqlFilters = filterAppT filterHandler <> filterAppT filterSql -- Note that <> on the maps won't work as intended, since keys are present in both
unless (null sqlFilters) $ E.where_ $ E.and sqlFilters
return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), dbtRowKey t, res)

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

@ -100,7 +100,7 @@ composeAddress street zipcode city country = toMaybe (notNull compAddr) compAddr
newtype AvsInternalPersonalNo = AvsInternalPersonalNo { avsInternalPersonalNo :: Text } -- ought to be all digits
deriving (Eq, Ord, Show, Generic)
deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField)
deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Binary)
instance E.SqlString AvsInternalPersonalNo
-- AvsInternalPersonalNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API
@ -160,7 +160,7 @@ instance {-# OVERLAPS #-} Canonical (Maybe AvsInternalPersonalNo) where
type AvsVersionNo = Text -- always 1 digit
newtype AvsCardNo = AvsCardNo { avsCardNo :: Text } -- always 8 digits -- TODO: Create Smart Constructor
deriving (Eq, Ord, Show, Generic)
deriving newtype (NFData, PathPiece, Csv.ToField, Csv.FromField)
deriving newtype (NFData, PathPiece, Csv.ToField, Csv.FromField, Binary)
-- No longer needed:
-- deriving newtype (PersistField, PersistFieldSql)
-- instance E.SqlString AvsCardNo
@ -203,15 +203,22 @@ instance PersistField AvsFullCardNo where
instance PersistFieldSql AvsFullCardNo where
sqlType _ = SqlString
discernAvsCardPersonalNo :: Text -> Maybe (Either AvsFullCardNo AvsInternalPersonalNo) -- Just implies it is a whole number or decimal with one digit after the point
discernAvsCardPersonalNo (Text.span Char.isDigit -> (c, pv))
parseAvsCardNo :: Text -> Maybe (Either AvsCardNo AvsFullCardNo)
parseAvsCardNo = splitDigitsByDot AvsCardNo (AvsFullCardNo . AvsCardNo)
discernAvsCardPersonalNo :: Text -> Maybe (Either AvsInternalPersonalNo AvsFullCardNo)
discernAvsCardPersonalNo = splitDigitsByDot mkAvsInternalPersonalNo (AvsFullCardNo . AvsCardNo)
-- | Just implies that argument is a whole number or decimal with one single digit after the point. Helper functions receive digit-parts without dot
splitDigitsByDot :: (Text -> a) -> (Text -> Text -> b) -> Text -> Maybe (Either a b)
splitDigitsByDot fl fr (Text.span Char.isDigit -> (c, pv))
| Text.null c = Nothing
| Text.null pv
= Just $ Right $ mkAvsInternalPersonalNo c
| not $ Text.null c
, Just ('.', v) <- Text.uncons pv
= Just $ Left $ fl c
| Just ('.', v) <- Text.uncons pv
, Just (Char.isDigit -> True, "") <- Text.uncons v
= Just $ Left $ AvsFullCardNo (AvsCardNo c) v
discernAvsCardPersonalNo _ = Nothing
= Just $ Right $ fr c v
splitDigitsByDot _ _ _ = Nothing
-- The AVS API requires PersonIds sometimes as as mere numbers `AvsPersonId` and sometimes as tagged objects `AvsObjPersonId`
newtype AvsPersonId = AvsPersonId { avsPersonId :: Int } -- untagged Int
@ -303,7 +310,7 @@ licence2char AvsLicenceRollfeld = 'R'
data AvsDataCardColor = AvsCardColorMisc Text | AvsCardColorGrün | AvsCardColorBlau | AvsCardColorRot | AvsCardColorGelb
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Generic, Binary)
deriving anyclass (NFData)
-- instance RenderMessage declared in Foundation.I18n
@ -337,7 +344,7 @@ data AvsDataPersonCard = AvsDataPersonCard
, avsDataCardNo :: AvsCardNo -- always 8 digits number, prefixed with 0
, avsDataVersionNo :: AvsVersionNo -- always 1 digit number
}
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Generic,Binary)
deriving anyclass (NFData)
{- Automatically derived Ord instance should prioritize avsDataValid and avsDataValidTo. Checked in test/Model.TypesSpec
@ -431,7 +438,7 @@ data AvsDataPerson = AvsDataPerson
, avsPersonPersonID :: AvsPersonId -- Eindeutige PersonenID, wichtig für die Schnittstelle!
, avsPersonPersonCards :: Set AvsDataPersonCard
}
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Generic, NFData, Binary)
makeLenses_ ''AvsDataPerson
@ -696,7 +703,8 @@ instance Semigroup AvsResponseStatus where
(AvsResponseStatus a) <> (AvsResponseStatus b) = AvsResponseStatus (a <> b)
newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson)
deriving (Eq, Ord, Show, Generic)
deriving (Show, Generic)
deriving newtype (Eq, Ord, NFData, Binary)
-- makeWrapped ''AvsResponsePerson
deriveJSON defaultOptions
{ fieldLabelModifier = dropCamel 2
@ -749,7 +757,7 @@ data AvsQueryPerson = AvsQueryPerson
, avsPersonQueryLastName :: Maybe Text
, avsPersonQueryInternalPersonalNo :: Maybe AvsInternalPersonalNo
}
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Generic, NFData, Binary)
instance Default AvsQueryPerson where
def = AvsQueryPerson Nothing Nothing Nothing Nothing Nothing

15
src/Utils/Avs.hs
View File

@ -70,7 +70,20 @@ avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero
mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
#ifdef DEVELOPMENT
mkAvsQuery _ _ _ = AvsQuery
{ avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty
{ 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)
, avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty