diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index d99c398d1..14f6fd6c6 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -187,8 +187,18 @@ data Transaction , transactionReceived :: UTCTime -- when was the csv file received? } - -- TODO: SetQualification - + | TransactionQualificationUserEdit + { transactionQualificationUser :: QualificationUserId + , transactionQualification :: QualificationId + , transactionUser :: UserId + , transactionQualificationValidUntil :: Day + } + | TransactionQualificationUserDelete + { transactionQualificationUser :: QualificationUserId + , transactionQualification :: QualificationId + , transactionUser :: UserId + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) deriveJSON defaultOptions diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index c8c84c099..be5c9a58b 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -97,8 +97,8 @@ postTUsersR tid ssh csh tutn = do formResult participantRes $ \case (TutorialUserGrantQualificationData{..}, selectedUsers) -> do today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime - runDB . forM_ selectedUsers $ \qualificationUserUser -> void $ - upsert + runDB . forM_ selectedUsers $ \qualificationUserUser -> void $ do + quid <- upsert QualificationUser { qualificationUserQualification = tuQualification , qualificationUserValidUntil = tuValidUntil @@ -111,6 +111,12 @@ postTUsersR tid ssh csh tutn = do , QualificationUserLastRefresh =. today , QualificationUserBlockedDue =. Nothing ] + audit TransactionQualificationUserEdit + { transactionQualificationUser = quid + , transactionQualification = tuQualification + , transactionUser = qualificationUserUser + , transactionQualificationValidUntil = tuValidUntil + } addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers redirect $ CTutorialR tid ssh csh tutn TUsersR (TutorialUserSendMailData{}, selectedUsers) -> do