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

fix(qualification): new block/unblock mechanism working now

Browse Source
This commit is contained in:
Steffen Jost 2023-07-26 08:59:08 +00:00
parent 9cf7f3965a
commit 5397c7be35
2 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/Handler/Utils/Qualification.hs
View File

@ -218,39 +218,40 @@ qualificationUserBlocking qid uids unblock (qualificationBlockReasonText -> reas
-- oks <- E.insertSelectCount . E.from $ \qualificationUser -> do -- oks <- E.insertSelectCount . E.from $ \qualificationUser -> do
-- E.where_ $ qualificationUser E.^. QualificationUserQualification E.==. E.val qid -- E.where_ $ qualificationUser E.^. QualificationUserQualification E.==. E.val qid
-- E.&&. qualificationUser E.^. QualificationUserUser E.in_ E.valList uid -- E.&&. qualificationUser E.^. QualificationUserUser E.in_ E.valList uid
-- E.&&. quserBlock (not unblock) nowaday qualificationUser -- only unblock blocked qualification and vice versa -- E.&&. quserBlock unblock nowaday qualificationUser -- only unblock blocked qualification and vice versa
-- return $ QualificationUserBlock -- return $ QualificationUserBlock
-- E.<# qualificationUser E.^. QualificationUserId -- E.<# qualificationUser E.^. QualificationUserId
-- E.<&> E.val unblock -- E.<&> E.val unblock
-- E.<&> E.val nowaday -- E.<&> E.val nowaday
-- E.<&> E.val reason -- E.<&> E.val reason
-- E.<&> E.val authUsr -- E.<&> E.val authUsr
toChange' <- E.select $ do toChange <- E.select $ do
qualUser <- E.from $ E.table @QualificationUser qualUser <- E.from $ E.table @QualificationUser
E.where_ $ qualUser E.^. QualificationUserQualification E.==. E.val qid E.where_ $ qualUser E.^. QualificationUserQualification E.==. E.val qid
E.&&. qualUser E.^. QualificationUserUser `E.in_` E.valList uids E.&&. qualUser E.^. QualificationUserUser `E.in_` E.valList uids
E.&&. quserBlock (unblock) now qualUser -- only unblock blocked qualification and vice versa -- TODO: (not unblock) <-> unblock !!!CHECK THIS ONCE MORE !!! E.&&. quserBlock unblock now qualUser -- only unblock blocked qualification and vice versa
return (qualUser E.^. QualificationUserId, qualUser E.^. QualificationUserUser) return (qualUser E.^. QualificationUserUser, qualUser E.^. QualificationUserId)
let toChange = E.unValue . fst <$> toChange' -- $logInfoS "BLOCK" $ tshow toChange
$logWarnS "BLOCK" $ tshow toChange
E.insertMany_ $ map (\quid -> QualificationUserBlock
{ qualificationUserBlockQualificationUser = quid
, qualificationUserBlockUnblock = unblock
, qualificationUserBlockFrom = now
, qualificationUserBlockReason = reason
, qualificationUserBlockBlocker = authUsr
}) toChange
unless notify $ updateWhere [QualificationUserId <-. toChange] [QualificationUserLastNotified =. now] let changes :: [(UserId, QualificationUserBlock)] = map (\(E.Value uid, E.Value quid) -> (uid, QualificationUserBlock
{ qualificationUserBlockQualificationUser = quid
, qualificationUserBlockUnblock = unblock
, qualificationUserBlockFrom = now
, qualificationUserBlockReason = reason
, qualificationUserBlockBlocker = authUsr
})
) toChange
E.insertMany_ (map snd changes)
unless notify $ updateWhere [QualificationUserId <-. (qualificationUserBlockQualificationUser . snd <$> changes)] [QualificationUserLastNotified =. now]
forM_ toChange' $ \(_, E.Value uid) -> do forM_ changes $ \(uid, qub) -> do
audit TransactionQualificationUserBlocking audit TransactionQualificationUserBlocking
{ -- transactionQualificationUser = quid { -- transactionQualificationUser = quid
transactionQualification = qid transactionQualification = qid
, transactionUser = uid , transactionUser = uid
, transactionQualificationBlock = error "TODO" -- CONTINUE HERE !!! -- , transactionQualificationBlock = qub
} }
return $ fromIntegral $ length toChange return $ fromIntegral $ length changes
qualificationUserUnblockByReason :: qualificationUserUnblockByReason ::

2
test/Database/Fill.hs
View File

@ -724,7 +724,7 @@ fillDb = do
qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal) qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal)
<$> selectList [QualificationUserQualification ==. qid_f] [Asc QualificationUserUser] <$> selectList [QualificationUserQualification ==. qid_f] [Asc QualificationUserUser]
insertMany_ [QualificationUser uid qid_f (n_day 42) (n_day $ -42) (n_day $ -365) True (n_day' $ -11)| Entity uid _ <- take 200 matUsers, uid `Set.notMember` qidfUsers] insertMany_ [QualificationUser uid qid_f (n_day (fromIntegral (length udn) - 12)) (n_day $ -42) (n_day $ -365) True (n_day' $ -11)| Entity uid User{userDisplayName=udn} <- take 200 matUsers, uid `Set.notMember` qidfUsers]
void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now
void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now
void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now