fix(build): refix test commits somehow

src/Handler/Utils/Qualification.hs

@@ -10,6 +10,7 @@ module Handler.Utils.Qualification
 
 import Import
 
+import qualified Data.Text as Text
 -- import Data.Time.Calendar (CalendarDiffDays(..))
 -- import Database.Persist.Sql (updateWhereCount)
 import qualified Database.Esqueleto.Experimental as E   -- might need TypeApplications Lang-Pragma
@@ -228,6 +229,7 @@ qualificationUserBlocking ::
   , Num n
   ) => QualificationId -> [UserId] -> Bool -> Maybe UTCTime -> QualificationBlockReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
 qualificationUserBlocking qid uids unblock mbBlockTime (qualificationBlockReasonText -> reason) notify = do
+  $logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow uids, tshow unblock, tshow reason, tshow notify]
   authUsr <- liftHandler maybeAuthId
   now <- liftIO getCurrentTime
   let blockTime = fromMaybe now mbBlockTime      
@@ -235,7 +237,7 @@ qualificationUserBlocking qid uids unblock mbBlockTime (qualificationBlockReason
   -- 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) blockTime qualificationUser -- only unblock blocked qualification and vice versa
+  --       E.&&.  quserBlock unblock blockTime qualificationUser -- only unblock blocked qualification and vice versa
   --   return $ QualificationUserBlock
   --     E.<#  qualificationUser E.^. QualificationUserId
   --     E.<&> E.val unblock
@@ -246,9 +248,9 @@ qualificationUserBlocking qid uids unblock mbBlockTime (qualificationBlockReason
     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 (not unblock) blockTime qualUser -- only unblock blocked qualification and vice versa
+        E.&&.  quserBlock unblock blockTime qualUser -- only unblock blocked qualification and vice versa
     return (qualUser E.^. QualificationUserId, qualUser E.^. QualificationUserUser)
-  let newBlocks = [ (quid, uid, qub) 
+  let newBlocks = [ (uid, qub) 
         | (E.Value quid, E.Value uid) <- toChange
         , let qub = QualificationUserBlock
                       { qualificationUserBlockQualificationUser = quid
@@ -258,9 +260,9 @@ qualificationUserBlocking qid uids unblock mbBlockTime (qualificationBlockReason
                       , qualificationUserBlockBlocker           = authUsr
                       }
         ]
-  E.insertMany_ (trd3 <$> newBlocks)
+  E.insertMany_ (snd <$> newBlocks)
-  unless notify $ updateWhere [QualificationUserId <-. (fst3 <$> newBlocks)] [QualificationUserLastNotified =. now]
+  unless notify $ updateWhere [QualificationUserId <-. (qualificationUserBlockQualificationUser . snd <$> newBlocks)] [QualificationUserLastNotified =. now]
-  forM_ newBlocks $ \(_, uid, qub) -> audit TransactionQualificationUserBlocking
+  forM_ newBlocks $ \(uid, qub) -> audit TransactionQualificationUserBlocking
     { transactionQualification      = qid
     , transactionUser               = uid
     , transactionQualificationBlock = qub

src/Jobs/Handler/LMS.hs

@@ -243,7 +243,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
     act = whenM (exists [LmsReportQualification ==. qid]) $ do -- executing twice must be prohibited due to assertion that ALL learners are always sent (D fails otherwise)
       now <- liftIO getCurrentTime    
       let today = utctDay now
-          -- locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now      
+          -- locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now  -- no longer necessary, since LMS reports dates only
           -- DB query for LmsUserUser, provided a matching LmsReport exists
           luserQry luFltr repFltr = E.select $ do
             luser <- E.from $ E.table @LmsUser

src/Model/Migration/Definitions.hs

@@ -885,7 +885,9 @@ customMigrations = mapF $ \case
         |]
 
   Migration20230703LmsUserStatus ->
-    unlessM (columnExists "lms_user" "status_day") $ do
+    whenM (andM [ tableExists "lms_user"
+                , not <$> columnExists "lms_user" "status_day"
+          ] ) $ do     
       [executeQQ|
         ALTER TABLE "lms_user" ADD COLUMN "status_day" date;
         UPDATE "lms_user"
@@ -922,7 +924,7 @@ tableDropEmpty table = whenM (tableExists table) $ do
 columnExists :: MonadIO m
              => Text -- ^ Table
              -> Text -- ^ Column
-             -> ReaderT SqlBackend m Bool
+             -> ReaderT SqlBackend m Bool -- BEWARE: use tablesExist beforehand!!! 
 columnExists table column = do
   haveColumn <- [sqlQQ|SELECT column_name FROM information_schema.columns WHERE table_name=#{table} and column_name=#{column};|]
   case haveColumn :: [Single PersistValue] of