fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(block): negate condition to test

Browse Source
This commit is contained in:
Steffen Jost 2023-07-24 13:50:16 +00:00
parent 8d64ca9842
commit 9cf7f3965a
2 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Audit/Types.hs
View File

@ -213,7 +213,7 @@ data Transaction
{ transactionUser :: UserId -- qualification holder that is updated { transactionUser :: UserId -- qualification holder that is updated
-- , transactionQualificationUser :: QualificationUserId -- not neccessary due to UniqueQualificationUser -- , transactionQualificationUser :: QualificationUserId -- not neccessary due to UniqueQualificationUser
, transactionQualification :: QualificationId , transactionQualification :: QualificationId
, transactionQualificationBlock :: QualificationUserBlock , transactionQualificationBlock :: QualificationUserBlock -- TODO --
} }
deriving (Eq, Ord, Read, Show, Generic) deriving (Eq, Ord, Read, Show, Generic)

8
src/Handler/Utils/Qualification.hs
View File

@ -10,6 +10,8 @@ module Handler.Utils.Qualification
import Import import Import
import qualified Data.Text as Text
-- import Data.Time.Calendar (CalendarDiffDays(..)) -- import Data.Time.Calendar (CalendarDiffDays(..))
-- import Database.Persist.Sql (updateWhereCount) -- import Database.Persist.Sql (updateWhereCount)
import qualified Database.Esqueleto.Experimental as E -- might need TypeApplications Lang-Pragma import qualified Database.Esqueleto.Experimental as E -- might need TypeApplications Lang-Pragma
@ -209,6 +211,7 @@ qualificationUserBlocking ::
, Num n , Num n
) => QualificationId -> [UserId] -> Bool -> QualificationBlockReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n ) => QualificationId -> [UserId] -> Bool -> QualificationBlockReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
qualificationUserBlocking qid uids unblock (qualificationBlockReasonText -> reason) notify = do 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 authUsr <- liftHandler maybeAuthId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
-- -- Code would work, but problematic -- -- Code would work, but problematic
@ -226,9 +229,10 @@ qualificationUserBlocking qid uids unblock (qualificationBlockReasonText -> reas
qualUser <- E.from $ E.table @QualificationUser qualUser <- E.from $ E.table @QualificationUser
E.where_ $ qualUser E.^. QualificationUserQualification E.==. E.val qid E.where_ $ qualUser E.^. QualificationUserQualification E.==. E.val qid
E.&&. qualUser E.^. QualificationUserUser `E.in_` E.valList uids 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) return (qualUser E.^. QualificationUserId, qualUser E.^. QualificationUserUser)
let toChange = E.unValue . fst <$> toChange' let toChange = E.unValue . fst <$> toChange'
$logWarnS "BLOCK" $ tshow toChange
E.insertMany_ $ map (\quid -> QualificationUserBlock E.insertMany_ $ map (\quid -> QualificationUserBlock
{ qualificationUserBlockQualificationUser = quid { qualificationUserBlockQualificationUser = quid
, qualificationUserBlockUnblock = unblock , qualificationUserBlockUnblock = unblock
@ -244,7 +248,7 @@ qualificationUserBlocking qid uids unblock (qualificationBlockReasonText -> reas
{ -- transactionQualificationUser = quid { -- transactionQualificationUser = quid
transactionQualification = qid transactionQualification = qid
, transactionUser = uid , transactionUser = uid
, transactionQualificationBlock = error "TODO" -- CONTINUE HERE , transactionQualificationBlock = error "TODO" -- CONTINUE HERE !!! --
} }
return $ fromIntegral $ length toChange return $ fromIntegral $ length toChange