78 lines
2.8 KiB
Haskell
78 lines
2.8 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.ExternalExam.New
|
|
( getEExamNewR, postEExamNewR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Jobs.Queue
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Invitations
|
|
|
|
import Handler.ExternalExam.StaffInvite
|
|
import Handler.ExternalExam.Form
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
|
|
getEExamNewR, postEExamNewR :: Handler Html
|
|
getEExamNewR = postEExamNewR
|
|
postEExamNewR = do
|
|
((newExamResult, newExamWidget'), newExamEnctype) <- runFormPost $ externalExamForm Nothing
|
|
|
|
formResult newExamResult $ \ExternalExamForm{..} -> do
|
|
insertRes <- runDBJobs $ do
|
|
insertRes <- insertUnique ExternalExam
|
|
{ externalExamTerm = eefTerm
|
|
, externalExamSchool = eefSchool
|
|
, externalExamCourseName = eefCourseName
|
|
, externalExamExamName = eefExamName
|
|
, externalExamDefaultTime = eefDefaultTime
|
|
, externalExamGradingMode = eefGradingMode
|
|
}
|
|
whenIsJust insertRes $ \eeId -> do
|
|
audit $ TransactionExternalExamEdit eeId
|
|
|
|
let eefOfficeSchools' = do
|
|
externalExamOfficeSchoolSchool <- Set.toList eefOfficeSchools
|
|
guard $ externalExamOfficeSchoolSchool /= eefSchool
|
|
let externalExamOfficeSchoolExam = eeId
|
|
return ExternalExamOfficeSchool{..}
|
|
insertMany_ eefOfficeSchools'
|
|
forM_ eefOfficeSchools' $ \ExternalExamOfficeSchool{..} ->
|
|
audit $ TransactionExternalExamOfficeSchoolEdit eeId externalExamOfficeSchoolSchool
|
|
|
|
memcachedByInvalidate AuthCacheExternalExamStaffList $ Proxy @(Set UserId)
|
|
let (invites, adds) = partitionEithers $ Set.toList eefStaff
|
|
eefStaff' = do
|
|
externalExamStaffUser <- adds
|
|
let externalExamStaffExam = eeId
|
|
return ExternalExamStaff{..}
|
|
insertMany_ eefStaff'
|
|
forM_ eefStaff' $ \ExternalExamStaff{..} ->
|
|
audit $ TransactionExternalExamStaffEdit eeId externalExamStaffUser
|
|
|
|
sinkInvitationsF externalExamStaffInvitationConfig $ map (, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff)) invites
|
|
forM_ invites $ \invEmail ->
|
|
audit $ TransactionExternalExamStaffInviteEdit eeId invEmail
|
|
return insertRes
|
|
|
|
case insertRes of
|
|
Nothing -> addMessageI Error $ MsgExternalExamExists eefCourseName eefExamName
|
|
Just _ -> do
|
|
addMessageI Success $ MsgExternalExamCreated eefCourseName eefExamName
|
|
redirect $ EExamR eefTerm eefSchool eefCourseName eefExamName EEShowR
|
|
|
|
let heading = MsgHeadingExternalExamNew
|
|
|
|
siteLayoutMsg heading $ do
|
|
setTitleI heading
|
|
wrapForm newExamWidget' def
|
|
{ formAction = Just $ SomeRoute EExamNewR
|
|
, formEncoding = newExamEnctype
|
|
}
|