fix(add-users): fix confirm secret field decoding

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