diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs index 94740d96c..22b846c66 100644 --- a/src/Handler/Utils/Invitations.hs +++ b/src/Handler/Utils/Invitations.hs @@ -175,7 +175,7 @@ sinkInvitations :: forall junction. -- updated, instead. -- -- For new junctions an invitation is sent by e-mail. -sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lift . sinkInvitations' +sinkInvitations InvitationConfig{..} = determineExists .| sinkInvitations' where determineExists :: Conduit (Invitation' junction) (YesodJobDB UniWorX) @@ -201,13 +201,9 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif JSON.Success dbData -> return dbData JSON.Error str -> fail $ "Could not decode invitationData: " <> str - sinkInvitations' :: [Invitation' junction] - -> YesodJobDB UniWorX () - sinkInvitations' new = do - when (is _Nothing (ephemeralInvitation @junction)) $ do - insertMany_ $ map (\(email, fid, dat) -> Invitation email (invRef @junction fid) (toJSON $ dat ^. _invitationDBData)) new - -- forM_ existing $ \(iid, oldDat) -> update iid [ InvitationData =. toJSON (dat ^. _invitationDBData) ] - forM_ new $ \(jInvitee, fid, dat) -> do + sinkInvitations' :: Sink (Invitation' junction) (YesodJobDB UniWorX) () + sinkInvitations' = do + C.mapM_ $ \(jInvitee, fid, dat) -> do app <- getYesod let mr = renderMessage app $ NonEmpty.toList appLanguages ur <- getUrlRenderParams @@ -224,6 +220,8 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif jInvitationSubject <- fmap mr . mapReaderT liftHandlerT $ invitationSubject fEnt dat let jInvitationExplanation = invitationExplanation fEnt dat (toHtml . mr) ur + when (is _Nothing (ephemeralInvitation @junction)) $ insert_ $ Invitation jInvitee (invRef @junction fid) (toJSON $ dat ^. _invitationDBData) + queueDBJob JobInvitation{..} sinkInvitationsF :: forall junction mono.