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

refactor(add-users): cleanup add-users handler

Browse Source
This commit is contained in:
Sarah Vaupel 2022-12-12 14:01:03 +01:00
parent 57c9535733
commit 2c13defecd
1 changed files with 23 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
src/Handler/Course/ParticipantInvite.hs
View File

@ -57,13 +57,13 @@ instance Finite CourseRegisterAction
data CourseRegisterActionData data CourseRegisterActionData
= CourseRegisterActionAddParticipantData = CourseRegisterActionAddParticipantData
{ crActAddParticipantIdent :: UserSearchKey { crActIdent :: UserSearchKey
, crActAddParticipantUser :: (UserId, User) , crActUser :: (UserId, User)
} }
| CourseRegisterActionAddTutorialMemberData | CourseRegisterActionAddTutorialMemberData
{ crActAddTutorialMemberIdent :: UserSearchKey { crActIdent :: UserSearchKey
, crActAddTutorialMemberUser :: (UserId, User) , crActUser :: (UserId, User)
, crActAddTutorialMemberTutorial :: TutorialIdent , crActTutorial :: TutorialIdent
} }
-- | CourseRegisterActionUnknownPersonData -- pseudo-action; just for display -- | CourseRegisterActionUnknownPersonData -- pseudo-action; just for display
-- { crActUnknownPersonIdent :: Text -- { crActUnknownPersonIdent :: Text
@ -92,9 +92,7 @@ courseRegisterRenderActionClass = \case
CourseRegisterActionAddTutorialMember -> [whamlet|_{MsgCourseParticipantsRegisterActionAddTutorialMembers}|] CourseRegisterActionAddTutorialMember -> [whamlet|_{MsgCourseParticipantsRegisterActionAddTutorialMembers}|]
courseRegisterRenderAction :: CourseRegisterActionData -> Widget courseRegisterRenderAction :: CourseRegisterActionData -> Widget
courseRegisterRenderAction = \case courseRegisterRenderAction act = [whamlet|^{userWidget (view _2 (crActUser act))} (#{crActIdent act})|]
CourseRegisterActionAddParticipantData{..} -> [whamlet|^{userWidget (view _2 crActAddParticipantUser)} (#{crActAddParticipantIdent})|]
CourseRegisterActionAddTutorialMemberData{..} -> [whamlet|^{userWidget (view _2 crActAddTutorialMemberUser)} (#{crActAddTutorialMemberIdent}), _{MsgCourseParticipantsRegisterTutorialField}: #{crActAddTutorialMemberTutorial}|]
data AddUserRequest = AddUserRequest data AddUserRequest = AddUserRequest
@ -126,27 +124,23 @@ postCAddUserR tid ssh csh = do
currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute
confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction
$logErrorS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs
if unless (Set.null confirmedActs) $ do -- TODO: check that all acts are member of availableActs
| not $ Set.null confirmedActs let
-> do users = Map.fromList . fmap (\act -> (crActIdent act, Just . view _1 $ crActUser act)) $ Set.toList confirmedActs
-- TODO: check that all acts are member of availableActs! tutActs = Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs
forM_ (Set.toList confirmedActs) $ \case actTutorial = fmap crActTutorial $ Set.lookupMin tutActs -- tutorial ident must be the same for every added member!
CourseRegisterActionAddTutorialMemberData{..} -> do registeredUsers <- registerUsers cid users
registeredUsers <- registerUsers cid $ Map.singleton crActAddTutorialMemberIdent (Just $ view _1 crActAddTutorialMemberUser) forM_ actTutorial $ \tutName -> do
tutId <- upsertNewTutorial cid crActAddTutorialMemberTutorial tutId <- upsertNewTutorial cid tutName
registerTutorialMembers tutId registeredUsers registerTutorialMembers tutId registeredUsers
CourseRegisterActionAddParticipantData{..} -> do
void . registerUsers cid $ Map.singleton crActAddParticipantIdent (Just $ view _1 crActAddParticipantUser) if
if | Just tutName <- actTutorial
| tutActs <- Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs , Set.size tutActs == Set.size confirmedActs
, CourseRegisterActionAddTutorialMemberData{..}:_ <- Set.toList tutActs -> redirect $ CTutorialR tid ssh csh tutName TUsersR
, Set.size tutActs == Set.size confirmedActs | otherwise
-> redirect $ CTutorialR tid ssh csh crActAddTutorialMemberTutorial TUsersR -> redirect $ CourseR tid ssh csh CUsersR
| otherwise
-> redirect $ CourseR tid ssh csh CUsersR
| otherwise
-> return ()
((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime