From 5397c7be353fc1b1e8310f66b49a9b93ee890253 Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Wed, 26 Jul 2023 08:59:08 +0000
Subject: [PATCH] fix(qualification): new block/unblock mechanism working now

---
 src/Handler/Utils/Qualification.hs | 35 +++++++++++++++---------------
 test/Database/Fill.hs              |  2 +-
 2 files changed, 19 insertions(+), 18 deletions(-)

diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs
index a0c6b50e9..9d0c6836b 100644
--- a/src/Handler/Utils/Qualification.hs
+++ b/src/Handler/Utils/Qualification.hs
@@ -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 :: 
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index 03c7ee385..7a70451e3 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -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