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

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

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

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   *****************"
+              apids <- queryAvsCardNos $ mapMaybe parseAvsCardNo xs -- $ foldMap cfAnySeparatedSet xs TODO
-              putStrLn $ tshow (length xs) <> ": " <> T.intercalate ", " criteria
+              if null apids
-              putStrLn "********   IT WORKS   *****************"
+                then 
-              return $ \(queryUser-> user) -> 
+                  -- addMessageI ???
-                user E.^. UserFirstName `E.in_` E.vals xs
+                  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

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 AvsFullCardNo{..} -> def{ avsPersonQueryCardNo = Just avsFullCardNo, avsPersonQueryVersionNo = Just avsFullCardVersion }
-              Right fpn -> def{ avsPersonQueryInternalPersonalNo = Just fpn }
+              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

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)))
+filterColumnHandler :: FilterColumn t fs -> Maybe ([Text] -> Handler (t -> E.SqlExpr (E.Value Bool)))
-filterColumnIO (FilterColumnIO f) = Just $ filterColumnIO' f
+filterColumnHandler (FilterColumnHandler f) = Just $ filterColumnHandler' f
-filterColumnIO  _                 = Nothing
+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 
+class IsFilterColumnHandler t a where 
-  filterColumnIO' :: a -> [Text] -> IO (t -> E.SqlExpr (E.Value Bool))  
+  filterColumnHandler' :: a -> [Text] -> Handler (t -> E.SqlExpr (E.Value Bool))  
 
-instance IsFilterColumnIO t ([Text] -> IO (t -> E.SqlExpr (E.Value Bool))) where
+instance IsFilterColumnHandler t ([Text] -> Handler (t -> E.SqlExpr (E.Value Bool))) where
-  filterColumnIO' fin args = fin args
+  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 
+  filterHandler <- case csvMode of 
-    FormSuccess DBCsvImport{} -> return mempty -- don't execute IO actions for unneeded filters upon csv _import_
+    FormSuccess DBCsvImport{} -> return mempty -- don't execute Handler actions for unneeded filters upon csv _import_
-    _other -> liftIO $ forM psFilter' $ \(fc,args) -> mapM ($ args) $ filterColumnIO fc  -- TODO: add timeout
+    _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)
 

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
+parseAvsCardNo :: Text -> Maybe (Either AvsCardNo AvsFullCardNo)
-discernAvsCardPersonalNo (Text.span Char.isDigit -> (c, pv))
+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
+    = Just $ Left $ fl c
-  | not $ Text.null c
+  | Just ('.', v) <- Text.uncons pv
-  , Just ('.', v) <- Text.uncons pv
   , Just (Char.isDigit -> True, "") <- Text.uncons v
-    = Just $ Left $ AvsFullCardNo (AvsCardNo c) v
+    = Just $ Right $ fr c v 
-discernAvsCardPersonalNo _ = Nothing
+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

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