fraport/fradrive
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
-- E.where_ $ qualificationUser E.^. QualificationUserQualification E.==. E.val qid
-- 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
-- E.<# qualificationUser E.^. QualificationUserId
-- E.<&> E.val unblock
-- E.<&> E.val nowaday
-- E.<&> E.val reason
-- E.<&> E.val authUsr
toChange' <- E.select $ do
toChange <- E.select $ do
qualUser <- E.from $ E.table @QualificationUser
E.where_ $ qualUser E.^. QualificationUserQualification E.==. E.val qid
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 !!!
return (qualUser E.^. QualificationUserId, qualUser E.^. QualificationUserUser)
let toChange = E.unValue . fst <$> toChange'
$logWarnS "BLOCK" $ tshow toChange
E.insertMany_ $ map (\quid -> QualificationUserBlock
{ qualificationUserBlockQualificationUser = quid
, qualificationUserBlockUnblock = unblock
, qualificationUserBlockFrom = now
, qualificationUserBlockReason = reason
, qualificationUserBlockBlocker = authUsr
}) toChange
E.&&. quserBlock unblock now qualUser -- only unblock blocked qualification and vice versa
return (qualUser E.^. QualificationUserUser, qualUser E.^. QualificationUserId)
-- $logInfoS "BLOCK" $ tshow 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
{ -- transactionQualificationUser = quid
transactionQualification = qid
, transactionUser = uid
, transactionQualificationBlock = error "TODO" -- CONTINUE HERE !!! --
, transactionQualificationBlock = qub
}
return $ fromIntegral $ length toChange
return $ fromIntegral $ length changes
qualificationUserUnblockByReason ::

2
test/Database/Fill.hs
View File

@ -724,7 +724,7 @@ fillDb = do
qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal)
<$> 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 "opqgrs" ) (n_day (-2)) now
void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now