chore(avs): drop avs card no uniqueness and attempt to fix filtering
This commit is contained in:
parent
0b724565ad
commit
4161c92d12
@ -29,5 +29,5 @@ UserAvsCard
|
||||
cardNo AvsFullCardNo
|
||||
card AvsDataPersonCard
|
||||
lastSynch UTCTime
|
||||
UniqueAvsCard cardNo
|
||||
-- UniqueAvsCard cardNo -- Note: cardNo is not unique; invalid cardNo may be reissued to different persons
|
||||
deriving Generic
|
||||
|
||||
@ -439,13 +439,13 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.&&. testcrit
|
||||
)
|
||||
, single ("avs-card" , FilterColumn . E.mkExistsFilter $ \row criterion ->
|
||||
E.from $ \(usrAvs `E.InnerJoin` avsCard) -> do
|
||||
, single ("avs-card" , FilterColumn $ \(queryUser -> user) (criterion :: Set.Set Text) -> case readAvsFullCardNo =<< Set.lookupMin criterion of
|
||||
Nothing -> E.false
|
||||
Just cardNo -> E.exists $ E.from $ \(avsCard `E.InnerJoin` usrAvs) -> do
|
||||
E.on $ usrAvs E.^. UserAvsPersonId E.==. avsCard E.^. UserAvsCardPersonId
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. queryUser row E.^. UserId
|
||||
E.&&. ((E.explicitUnsafeCoerceSqlExprValue "citext" (avsCard E.^. UserAvsCardCardNo) :: E.SqlExpr (E.Value (CI Text)))
|
||||
`E.hasInfix` (E.val criterion :: E.SqlExpr (E.Value (CI Text))))
|
||||
)
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo)
|
||||
)
|
||||
, single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if
|
||||
| Set.null criteria -> E.true
|
||||
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
|
||||
|
||||
@ -358,17 +358,26 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. queryUser row E.^. UserId
|
||||
E.&&. ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
|
||||
(E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) ))
|
||||
, single ("avs-card" , FilterColumn . E.mkExistsFilter $ \row criterion ->
|
||||
E.from $ \(usrAvs `E.InnerJoin` avsCard) -> do
|
||||
, single ("avs-card" , FilterColumn $ \(queryUser -> user) (criterion :: Set.Set Text) -> case readAvsFullCardNo =<< Set.lookupMin criterion of
|
||||
Nothing -> E.false
|
||||
Just cardNo -> E.exists $ E.from $ \(avsCard `E.InnerJoin` usrAvs) -> do
|
||||
E.on $ usrAvs E.^. UserAvsPersonId E.==. avsCard E.^. UserAvsCardPersonId
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. queryUser row E.^. UserId
|
||||
E.&&. ((E.explicitUnsafeCoerceSqlExprValue "citext" (avsCard E.^. UserAvsCardCardNo) :: E.SqlExpr (E.Value (CI Text)))
|
||||
`E.hasInfix` (E.val criterion :: E.SqlExpr (E.Value (CI Text))))
|
||||
)
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo)
|
||||
)
|
||||
, single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if
|
||||
| Set.null criteria -> E.true
|
||||
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
|
||||
)
|
||||
, single ("user-company", FilterColumn . E.mkExistsFilter $ \row criterion ->
|
||||
E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||
let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
|
||||
(E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
|
||||
testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
|
||||
testcrit = maybe testname testnumber $ readMay $ CI.original criterion
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.&&. testcrit
|
||||
)
|
||||
, single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification nowaday))
|
||||
, single ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion ->
|
||||
if | Just renewal <- mbRenewal
|
||||
|
||||
@ -339,12 +339,16 @@ guessAvsUser (Text.splitAt 6 -> ("AVSNO:", avsnoTxt)) = ifMaybeM (readMay avsnoT
|
||||
_ -> return Nothing
|
||||
guessAvsUser someid = do
|
||||
let maybeUpsertAvsUserByCard = maybeCatchAll . upsertAvsUserByCard
|
||||
extractUid (Entity _ UserAvs{userAvsUser=uid}) = return $ Just uid
|
||||
extractUidCard (Entity _ UserAvsCard{userAvsCardPersonId=avid}) = getBy $ UniqueUserAvsId avid
|
||||
case discernAvsCardPersonalNo someid of
|
||||
Just cid@(Left cardNo) ->
|
||||
maybeM (maybeUpsertAvsUserByCard cid) extractUid $ runDB $
|
||||
maybeM (return Nothing) extractUidCard $ getBy $ UniqueAvsCard cardNo
|
||||
Just cid@(Left _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
|
||||
-- extractUidCard UserAvsCard{userAvsCardPersonId=avid} = getBy $ UniqueUserAvsId avid
|
||||
-- cards <- selectList [UserAvsCardCardNo ==. cardNo] []
|
||||
-- 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) ->
|
||||
maybeUpsertAvsUserByCard cid >>= \case
|
||||
Nothing ->
|
||||
@ -493,15 +497,16 @@ upsertAvsUserById api = do
|
||||
[UserPinPassword =. userPin]
|
||||
insert_ $ UserAvsCard api (getFullCardNo pCard) pCard now
|
||||
upsertUserCompany uid mbCompany userFirmAddr
|
||||
forM_ avsPersonPersonCards $ \aCard -> void $ upsert UserAvsCard
|
||||
forM_ avsPersonPersonCards $ \aCard -> do
|
||||
let fcn = getFullCardNo aCard
|
||||
-- probably not efficient, but fixes the problem that AvsCardNo is not unique as assumed before and may get reused
|
||||
deleteWhere [UserAvsCardCardNo ==. fcn]
|
||||
insert_ $ UserAvsCard
|
||||
{ userAvsCardPersonId = api
|
||||
, userAvsCardCardNo = getFullCardNo aCard
|
||||
, userAvsCardCardNo = fcn
|
||||
, userAvsCardCard = aCard
|
||||
, userAvsCardLastSynch = now
|
||||
}
|
||||
[ UserAvsCardCard =. aCard
|
||||
, UserAvsCardLastSynch =. now
|
||||
]
|
||||
return $ Just uid
|
||||
|
||||
|
||||
|
||||
@ -680,10 +680,10 @@ fillDb = do
|
||||
void . insert' $ UserAvs (AvsPersonId 4) sbarth 4
|
||||
void . insert' $ UserAvs (AvsPersonId 5) fhamann 5
|
||||
void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77
|
||||
void . insert' $ UserAvsCard (AvsPersonId 12345678) (AvsFullCardNo (AvsCardNo "1234") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "1234") "4") now
|
||||
void . insert' $ UserAvsCard (AvsPersonId 2) (AvsFullCardNo (AvsCardNo "3344") "1") (AvsDataPersonCard True Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "3344") "1") now
|
||||
void . insert' $ UserAvsCard (AvsPersonId 3) (AvsFullCardNo (AvsCardNo "7788") "1") (AvsDataPersonCard False Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "7788") "1") now
|
||||
void . insert' $ UserAvsCard (AvsPersonId 4) (AvsFullCardNo (AvsCardNo "9999") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "9999") "4") now
|
||||
insert_ $ UserAvsCard (AvsPersonId 12345678) (AvsFullCardNo (AvsCardNo "1234") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "1234") "4") now
|
||||
insert_ $ UserAvsCard (AvsPersonId 2) (AvsFullCardNo (AvsCardNo "3344") "1") (AvsDataPersonCard True Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "3344") "1") now
|
||||
insert_ $ UserAvsCard (AvsPersonId 3) (AvsFullCardNo (AvsCardNo "7788") "1") (AvsDataPersonCard False Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "7788") "1") now
|
||||
insert_ $ UserAvsCard (AvsPersonId 4) (AvsFullCardNo (AvsCardNo "9999") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "9999") "4") now
|
||||
|
||||
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
|
||||
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user