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

chore(tutorial-users): audit qualification edits

Browse Source
This commit is contained in:
Sarah Vaupel 2022-12-13 20:08:38 +01:00
parent 71cde92a1a
commit 22228ee9c1
2 changed files with 20 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Audit/Types.hs
View File

@ -187,8 +187,18 @@ data Transaction
, transactionReceived :: UTCTime -- when was the csv file received? , 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) deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriveJSON defaultOptions deriveJSON defaultOptions

10
src/Handler/Tutorial/Users.hs
View File

@ -97,8 +97,8 @@ postTUsersR tid ssh csh tutn = do
formResult participantRes $ \case formResult participantRes $ \case
(TutorialUserGrantQualificationData{..}, selectedUsers) -> do (TutorialUserGrantQualificationData{..}, selectedUsers) -> do
today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
runDB . forM_ selectedUsers $ \qualificationUserUser -> void $ runDB . forM_ selectedUsers $ \qualificationUserUser -> void $ do
upsert quid <- upsert
QualificationUser QualificationUser
{ qualificationUserQualification = tuQualification { qualificationUserQualification = tuQualification
, qualificationUserValidUntil = tuValidUntil , qualificationUserValidUntil = tuValidUntil
@ -111,6 +111,12 @@ postTUsersR tid ssh csh tutn = do
, QualificationUserLastRefresh =. today , QualificationUserLastRefresh =. today
, QualificationUserBlockedDue =. Nothing , QualificationUserBlockedDue =. Nothing
] ]
audit TransactionQualificationUserEdit
{ transactionQualificationUser = quid
, transactionQualification = tuQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = tuValidUntil
}
addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
redirect $ CTutorialR tid ssh csh tutn TUsersR redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserSendMailData{}, selectedUsers) -> do (TutorialUserSendMailData{}, selectedUsers) -> do