diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index 37ba6ee4d..63455c081 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -213,7 +213,7 @@ data Transaction { transactionUser :: UserId -- qualification holder that is updated -- , transactionQualificationUser :: QualificationUserId -- not neccessary due to UniqueQualificationUser , transactionQualification :: QualificationId - , transactionQualificationBlock :: QualificationUserBlock + , transactionQualificationBlock :: QualificationUserBlock -- TODO -- } deriving (Eq, Ord, Read, Show, Generic) diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index 9fd19c74f..a0c6b50e9 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -10,6 +10,8 @@ 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 @@ -209,6 +211,7 @@ qualificationUserBlocking :: , Num n ) => QualificationId -> [UserId] -> Bool -> QualificationBlockReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n qualificationUserBlocking qid uids unblock (qualificationBlockReasonText -> reason) notify = do + $logWarnS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow uids, tshow unblock, tshow reason, tshow notify] authUsr <- liftHandler maybeAuthId now <- liftIO getCurrentTime -- -- Code would work, but problematic @@ -226,9 +229,10 @@ qualificationUserBlocking qid uids unblock (qualificationBlockReasonText -> reas 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) now qualUser -- only unblock blocked qualification and vice versa + 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 @@ -244,7 +248,7 @@ qualificationUserBlocking qid uids unblock (qualificationBlockReasonText -> reas { -- transactionQualificationUser = quid transactionQualification = qid , transactionUser = uid - , transactionQualificationBlock = error "TODO" -- CONTINUE HERE + , transactionQualificationBlock = error "TODO" -- CONTINUE HERE !!! -- } return $ fromIntegral $ length toChange