diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 8a2957aa0..5e6c3b7ad 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -71,6 +71,7 @@ data CourseRegisterActionData deriving (Eq, Ord, Show, Generic, Typeable) makeLenses_ ''CourseRegisterActionData +makePrisms ''CourseRegisterActionData instance Aeson.FromJSON CourseRegisterActionData where parseJSON = Aeson.genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 } @@ -124,30 +125,28 @@ postCAddUserR tid ssh csh = do cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute - confirmAvailableActs <- fmap (maybe FormMissing FormSuccess) . throwExceptT . runMaybeT $ encodedSecretBoxOpen =<< MaybeT (lift . lookupPostParam $ toPathPiece PostCourseUserAddConfirmAvailableActions) - confirmActs <- fmap (maybe FormMissing FormSuccess) . throwExceptT . runMaybeT $ encodedSecretBoxOpen =<< MaybeT (lift . lookupPostParam $ toPathPiece PostCourseUserAddConfirmAction) - $logErrorS "CAddUserR available" . tshow $ Aeson.encode (confirmAvailableActs :: Maybe (Set CourseRegisterActionData)) - $logErrorS "CAddUserR acts" . tshow $ Aeson.encode (confirmActs :: Maybe (Set CourseRegisterActionData)) + confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction + $logErrorS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs if - | FormSuccess acts <- confirmActs - , FormSuccess _availableActs <- confirmAvailableActs + | not $ Set.null confirmedActs -> do -- TODO: check that all acts are member of availableActs! - forM_ (Set.toList acts) $ \case + forM_ (Set.toList confirmedActs) $ \case CourseRegisterActionAddTutorialMemberData{..} -> do registeredUsers <- registerUsers cid $ Map.singleton crActAddTutorialMemberIdent (Just $ view _1 crActAddTutorialMemberUser) tutId <- upsertNewTutorial cid crActAddTutorialMemberTutorial registerTutorialMembers tutId registeredUsers - redirect $ CTutorialR tid ssh csh crActAddTutorialMemberTutorial TUsersR CourseRegisterActionAddParticipantData{..} -> do void . registerUsers cid $ Map.singleton crActAddParticipantIdent (Just $ view _1 crActAddParticipantUser) - redirect $ CourseR tid ssh csh CUsersR - | FormSuccess _ <- confirmActsRes - -> addMessageI Error MsgCourseParticipantsRegisterConfirmInvalid - | FormMissing <- confirmActsRes + if + | tutActs <- Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs + , CourseRegisterActionAddTutorialMemberData{..}:_ <- Set.toList tutActs + , Set.size tutActs == Set.size confirmedActs + -> redirect $ CTutorialR tid ssh csh crActAddTutorialMemberTutorial TUsersR + | otherwise + -> redirect $ CourseR tid ssh csh CUsersR + | otherwise -> return () - | FormFailure errs <- confirmActsRes - -> forM_ errs $ addMessage Error . toHtml ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime