diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index 60016e1ec..a3eabff86 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/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) - unless notify $ updateWhere [QualificationUserId <-. (fst3 <$> newBlocks)] [QualificationUserLastNotified =. now] - forM_ newBlocks $ \(_, uid, qub) -> audit TransactionQualificationUserBlocking + E.insertMany_ (snd <$> newBlocks) + unless notify $ updateWhere [QualificationUserId <-. (qualificationUserBlockQualificationUser . snd <$> newBlocks)] [QualificationUserLastNotified =. now] + forM_ newBlocks $ \(uid, qub) -> audit TransactionQualificationUserBlocking { transactionQualification = qid , transactionUser = uid , transactionQualificationBlock = qub diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index eeb6d15ab..07f6a6b62 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/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 diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs index 2ff047457..55c4a031b 100644 --- a/src/Model/Migration/Definitions.hs +++ b/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