diff --git a/src/Audit.hs b/src/Audit.hs index e13c769b9..1637ffc1f 100644 --- a/src/Audit.hs +++ b/src/Audit.hs @@ -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 diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 0d68a958f..8c25f0572 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -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 diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 28ffdecea..104dbc7b2 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -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 diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 2d7cc6686..63dfbc9d0 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index d573f139e..fe14123eb 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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) diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index a81cdc33d..1ae912248 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -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 diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index 7f6f0d696..b20ef42f1 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -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