From 8591306b14e22447dfd189ea9226c260056c0e3b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 22 Apr 2019 23:56:05 +0200
Subject: [PATCH 1/6] Prototype of generic invitation infrastructure

---
 messages/uniworx/de.msg                  |  10 +-
 models/invitations                       |   5 +
 package.yaml                             |   2 +
 src/Handler/Utils/Invitations.hs         | 289 +++++++++++++++++++++++
 src/Handler/Utils/Tokens.hs              |   7 +
 src/Import/NoFoundation.hs               |   1 +
 src/Jobs.hs                              |   1 +
 src/Jobs/Handler/Invitation.hs           |  14 ++
 src/Jobs/Types.hs                        |   6 +
 src/Jose/Jwt/Instances.hs                |   8 +
 src/Utils.hs                             |   6 +
 src/Utils/Form.hs                        |  13 +
 templates/widgets/invitation-site.hamlet |   4 +
 13 files changed, 365 insertions(+), 1 deletion(-)
 create mode 100644 models/invitations
 create mode 100644 src/Handler/Utils/Invitations.hs
 create mode 100644 src/Jobs/Handler/Invitation.hs
 create mode 100644 templates/widgets/invitation-site.hamlet

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index c29f933d6..8a6a194bc 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -792,4 +792,12 @@ CourseLecInviteExplanation: Sie wurden eingeladen, Verwalter für einen Kurs zu
 CorrectorInvitationAccepted shn@SheetName: Sie wurden als Korrektor für #{shn} eingetragen
 CorrectorInvitationDeclined shn@SheetName: Sie haben die Einladung, Korrektor für #{shn} zu werden, abgelehnt
 SheetCorrInviteHeading shn@SheetName: Einladung zum Korrektor für #{shn}
-SheetCorrInviteExplanation: Sie wurden eingeladen, Korrektor für ein Übungsblatt zu sein.
\ No newline at end of file
+SheetCorrInviteExplanation: Sie wurden eingeladen, Korrektor für ein Übungsblatt zu sein.
+
+InvitationAction: Aktion
+InvitationActionTip: Abgelehnte Einladungen können nicht mehr angenommen werden
+InvitationMissingRestrictions: Authorisierungs-Token fehlen benötigte Daten
+InvitationCollision: Einladung konnte nicht angenommen werden da ein derartiger Eintrag bereits existiert
+InvitationDeclined: Einladung wurde abgelehnt
+BtnInviteAccept: Einladung annehmen
+BtnInviteDecline: Einladung ablehnen
\ No newline at end of file
diff --git a/models/invitations b/models/invitations
new file mode 100644
index 000000000..c1d15148c
--- /dev/null
+++ b/models/invitations
@@ -0,0 +1,5 @@
+Invitation
+  email     UserEmail
+  for       Value
+  data      Value
+  UniqueInvitation email for
\ No newline at end of file
diff --git a/package.yaml b/package.yaml
index 47917503c..16178c5ae 100644
--- a/package.yaml
+++ b/package.yaml
@@ -172,12 +172,14 @@ default-extensions:
   - PackageImports
   - TypeApplications
   - RecursiveDo
+  - TypeFamilyDependencies
 
 ghc-options:
   - -Wall
   - -fno-warn-type-defaults
   - -fno-warn-unrecognised-pragmas
   - -fno-warn-partial-type-signatures
+  - -fno-max-relevant-binds
 
 when:
   - condition: flag(pedantic)
diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs
new file mode 100644
index 000000000..480282060
--- /dev/null
+++ b/src/Handler/Utils/Invitations.hs
@@ -0,0 +1,289 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Handler.Utils.Invitations
+  ( -- * Procedure
+    --
+    -- $procedure
+    IsInvitableJunction(..)
+  , _invitationDBData, _invitationTokenData
+  , InvitationConfig(..), InvitationTokenConfig(..)
+  , sinkInvitations, sinkInvitationsF
+  , invitationR
+  ) where
+
+import Import
+import Utils.Lens
+import Utils.Form
+import Jobs.Queue
+
+import Handler.Utils.Tokens
+
+import Text.Hamlet
+
+import Control.Monad.Trans.Reader (mapReaderT)
+
+import qualified Data.Conduit.List as C
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.HashSet as HashSet
+
+import Data.Aeson (fromJSON)
+import qualified Data.Aeson as JSON
+import Data.Aeson.TH
+
+
+class ( PersistRecordBackend junction (YesodPersistBackend UniWorX)
+      , ToJSON (InvitationDBData junction), ToJSON (InvitationTokenData junction)
+      , FromJSON (InvitationDBData junction), FromJSON (InvitationTokenData junction)
+      , PersistRecordBackend (InvitationFor junction) (YesodPersistBackend UniWorX)
+      ) => IsInvitableJunction junction where
+  -- | One side of the junction is always `User`; `InvitationFor junction` is the other
+  type InvitationFor       junction :: *
+  -- | `junction` without `Key User` and `Key (InvitationFor junction)`
+  data InvitableJunction   junction :: *
+  
+  -- | `InvitationData` is all data associated with an invitation except for the `UserEmail` and `InvitationFor junction`
+  --
+  -- Note that this is only the data associated with the invitation; some user input might still be required to construct `InvitableJunction junction`
+  type InvitationData      junction = (dat :: *) | dat -> junction
+  type InvitationData      junction = (InvitationDBData junction, InvitationTokenData junction)
+  -- | `InvitationDBData` is the part of `InvitationData` that is stored confidentially in the database
+  data InvitationDBData    junction :: *
+  -- | `InvitationTokenData` is the part of `InvitationData` that is stored readably within the token
+  data InvitationTokenData junction :: *
+
+  _InvitableJunction :: Iso' junction (UserId, Key (InvitationFor junction), InvitableJunction junction)
+
+  _InvitationData :: Iso' (InvitationData junction) (InvitationDBData junction, InvitationTokenData junction)
+  default _InvitationData :: InvitationData junction ~ (InvitationDBData junction, InvitationTokenData junction)
+                          => Iso' (InvitationData junction) (InvitationDBData junction, InvitationTokenData junction)
+  _InvitationData = id
+
+  -- | If `ephemeralInvitation` is not `Nothing` pending invitations are not stored in the database
+  --
+  -- In this case no invitation data can be stored in the database (@InvitationDBData junction ~ ()@)
+  ephemeralInvitation :: Maybe (AnIso' () (InvitationDBData junction))
+  ephemeralInvitation = Nothing
+
+  {-# MINIMAL _InvitableJunction #-}
+
+_invitationDBData :: IsInvitableJunction junction => Lens' (InvitationData junction) (InvitationDBData junction)
+_invitationDBData = _InvitationData . _1
+_invitationTokenData :: IsInvitableJunction junction => Lens' (InvitationData junction) (InvitationTokenData junction)
+_invitationTokenData = _InvitationData . _2
+
+
+-- | Configuration needed for creating and accepting/declining `Invitation`s
+--
+-- It is advisable to define this once per `junction` in a global constant
+data InvitationConfig junction = InvitationConfig
+  { invitationRoute       :: InvitationFor junction -> InvitationData junction -> YesodDB UniWorX (Route UniWorX)
+    -- ^ Which route calls `invitationR` for this kind of invitation?
+  , invitationResolveFor  :: YesodDB UniWorX (Key (InvitationFor junction))
+    -- ^ Monadically resolve `InvitationFor` during `inviteR`
+    --
+    -- Usually from `requireBearerToken` or `getCurrentRoute`
+  , invitationSubject     :: InvitationFor junction -> InvitationData junction -> SomeMessage UniWorX
+    -- ^ Subject of the e-mail which sends the token to the user
+  , invitationHeading     :: InvitationFor junction -> InvitationData junction -> SomeMessage UniWorX
+    -- ^ Heading of the page which allows the invitee to accept/decline the invitation (`invitationR`
+  , invitationExplanation :: InvitationFor junction -> InvitationData junction -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
+    -- ^ Explanation of what kind of invitation this is (used both in the e-mail and in `invitationR`)
+  , invitationTokenConfig :: InvitationFor junction -> InvitationData junction -> YesodDB UniWorX InvitationTokenConfig
+    -- ^ Parameters for creating the invitation token (`InvitationTokenData` is handled transparently)
+  , invitationRestriction :: InvitationFor junction -> InvitationData junction -> YesodDB UniWorX AuthResult
+    -- ^ Additional restrictions to check before allowing an user to redeem an invitation token
+  , invitationForm        :: InvitationFor junction -> InvitationData junction -> AForm (YesodDB UniWorX) (InvitableJunction junction)
+    -- ^ Assimilate the additional data entered by the redeeming user
+  , invitationSuccessMsg  :: InvitationFor junction -> Entity junction         -> YesodDB UniWorX (SomeMessage UniWorX)
+    -- ^ What to tell the redeeming user after accepting the invitation
+  , invitationUltDest     :: InvitationFor junction -> Entity junction         -> YesodDB UniWorX (SomeRoute UniWorX)
+    -- ^ Where to redirect the redeeming user after accepting the invitation
+  } deriving (Generic, Typeable)
+
+-- | Additional configuration needed for an invocation of `bearerToken`
+data InvitationTokenConfig = InvitationTokenConfig
+  { itAuthority :: UserId
+  , itAddAuth   :: Maybe AuthDNF
+  , itExpiresAt :: Maybe (Maybe UTCTime)
+  , itStartsAt  :: Maybe UTCTime
+  } deriving (Generic, Typeable)
+
+data InvitationTokenRestriction junction = IsInvitableJunction junction => InvitationTokenRestriction
+  { itEmail :: UserEmail
+  , itData  :: InvitationTokenData junction
+  }
+deriving instance Eq (InvitationTokenData junction) => Eq (InvitationTokenRestriction junction)
+deriving instance Ord (InvitationTokenData junction) => Ord (InvitationTokenRestriction junction)
+deriving instance (Read (InvitationTokenData junction), IsInvitableJunction junction) => Read (InvitationTokenRestriction junction)
+deriving instance Show (InvitationTokenData junction) => Show (InvitationTokenRestriction junction)
+
+$(return [])
+
+instance ToJSON (InvitationTokenRestriction junction) where
+  toJSON = $(mkToJSON defaultOptions{ fieldLabelModifier = camelToPathPiece' 1 } ''InvitationTokenRestriction)
+  
+instance IsInvitableJunction junction => FromJSON (InvitationTokenRestriction junction) where
+  parseJSON = $(mkParseJSON defaultOptions{ fieldLabelModifier = camelToPathPiece' 1 } ''InvitationTokenRestriction)
+
+
+sinkInvitations :: forall junction.
+                   IsInvitableJunction junction
+                => InvitationConfig junction
+                -> Sink (UserEmail, Key (InvitationFor junction), InvitationData junction) (YesodJobDB UniWorX) ()
+-- | Register invitations in the database
+--
+-- When an invitation for a certain junction (i.e. an `UserEmail`, `Key
+-- (InvitationFor junction)`-Pair) already exists it's `InvitationData` is
+-- updated, instead.
+--
+-- For new junctions an invitation is sent by e-mail.
+sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lift . sinkInvitations'
+  where
+    determineExists :: Conduit (UserEmail, Key (InvitationFor junction), InvitationData junction)
+                               (YesodJobDB UniWorX)
+                               (Either (InvitationId, InvitationData junction) (UserEmail, Key (InvitationFor junction), InvitationData junction))
+    determineExists
+      | is _Just (ephemeralInvitation @junction)
+      = C.map Right
+      | otherwise
+      = C.mapM $ \inp@(email, fid, dat) ->
+          maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (toJSON fid))
+
+    sinkInvitations' :: [Either (InvitationId, InvitationData junction) (UserEmail, Key (InvitationFor junction), InvitationData junction)]
+                     -> YesodJobDB UniWorX ()
+    sinkInvitations' (partitionEithers -> (existing, new)) = do
+      when (is _Nothing (ephemeralInvitation @junction)) $ do
+        insertMany_ $ map (\(email, fid, dat) -> Invitation email (toJSON fid) (toJSON $ dat ^. _invitationDBData)) new
+        forM_ existing $ \(iid, dat) -> update iid [ InvitationData =. toJSON (dat ^. _invitationDBData) ]
+      forM_ new $ \(jInvitee, fid, dat) -> do
+        app <- getYesod
+        let mr = renderMessage app $ NonEmpty.toList appLanguages
+        ur <- getUrlRenderParams
+
+        fRec <- get404 fid
+        
+        jInviter <- liftHandlerT requireAuthId
+        route <- mapReaderT liftHandlerT $ invitationRoute fRec dat
+        InvitationTokenConfig{..} <- mapReaderT liftHandlerT $ invitationTokenConfig fRec dat
+        protoToken <- bearerToken itAuthority (Just . HashSet.singleton $ urlRoute route) itAddAuth itExpiresAt itStartsAt
+        let token = protoToken & tokenRestrict (urlRoute route) (InvitationTokenRestriction jInvitee $ dat ^. _invitationTokenData)
+        jwt <- encodeToken token
+        jInvitationUrl <- toTextUrl (route, [(toPathPiece GetBearer, toPathPiece jwt)])
+        let jInvitationSubject     = mr $ invitationSubject fRec dat
+            jInvitationExplanation = invitationExplanation fRec dat (toHtml . mr) ur
+
+        queueDBJob JobInvitation{..}
+
+sinkInvitationsF :: forall junction mono.
+                    ( IsInvitableJunction junction
+                    , MonoFoldable mono
+                    , Element mono ~ (UserEmail, Key (InvitationFor junction), InvitationData junction)
+                    )
+                 => InvitationConfig junction
+                 -> mono
+                 -> YesodJobDB UniWorX ()
+-- | Non-conduit version of `sinkInvitations`
+sinkInvitationsF cfg invs = runConduit $ mapM_ yield invs .| sinkInvitations cfg
+
+
+data ButtonInvite = BtnInviteAccept | BtnInviteDecline
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe ButtonInvite
+instance Finite ButtonInvite
+
+nullaryPathPiece ''ButtonInvite $ camelToPathPiece' 2
+embedRenderMessage ''UniWorX ''ButtonInvite id
+
+instance Button UniWorX ButtonInvite where
+  btnClasses BtnInviteAccept = [BCIsButton, BCPrimary]
+  btnClasses BtnInviteDecline = [BCIsButton, BCDanger]
+
+  btnValidate _ BtnInviteAccept  = True
+  btnValidate _ BtnInviteDecline = False
+
+invitationR :: forall junction m.
+               ( IsInvitableJunction junction
+               , MonadHandler m
+               , HandlerSite m ~ UniWorX
+               )
+            => InvitationConfig junction
+            -> m Html
+-- | Generic handler for incoming invitations
+invitationR InvitationConfig{..} = liftHandlerT $ do
+  InvitationTokenRestriction{..} <- maybeM (invalidArgsI [MsgInvitationMissingRestrictions]) return currentTokenRestrictions :: Handler (InvitationTokenRestriction junction)
+  invitee <- requireAuthId
+  Just cRoute <- getCurrentRoute
+
+  (tRoute, (dataWidget, dataEnctype), heading, explanation) <- runDB $ do
+    Entity fid fRec <- invitationResolveFor >>= (\k -> Entity k <$> get404 k)
+    dbData <- case ephemeralInvitation @junction of
+      Nothing -> do
+        Invitation{..} <- entityVal <$> getBy404 (UniqueInvitation itEmail $ toJSON fid)
+        case fromJSON invitationData of
+          JSON.Success dbData -> return dbData
+          JSON.Error   str    -> fail $ "Could not decode invitationData: " <> str
+      Just (cloneIso -> _DBData) -> return $ view _DBData ()
+    let
+      iData :: InvitationData junction
+      iData = review _InvitationData (dbData, itData)
+    guardAuthResult =<< invitationRestriction fRec iData
+    ((dataRes, dataWidget), dataEnctype) <- runFormPost . formEmbedJwtPost . renderAForm FormStandard . wFormToAForm $ do
+      dataRes <- aFormToWForm $ invitationForm fRec iData
+      btnRes <- aFormToWForm . disambiguateButtons $ combinedButtonField (BtnInviteAccept : [ BtnInviteDecline | is _Nothing $ ephemeralInvitation @junction ]) (fslI MsgInvitationAction & bool id (setTooltip MsgInvitationActionTip) (is _Nothing $ ephemeralInvitation @junction))
+      case btnRes of
+        FormSuccess BtnInviteDecline -> return $ FormSuccess Nothing
+        _other -> return $ Just <$> dataRes
+
+    MsgRenderer mr <- getMsgRenderer
+    ur <- getUrlRenderParams
+    let
+      heading = invitationHeading fRec iData
+      explanation = invitationExplanation fRec iData (toHtml . mr) ur
+
+    fmap (, (dataWidget, dataEnctype), heading, explanation) . formResultMaybe dataRes $ \case
+      Nothing -> do
+        addMessageI Info MsgInvitationDeclined
+        deleteBy . UniqueInvitation itEmail $ toJSON fid
+        return . Just $ SomeRoute HomeR
+      Just jData -> do
+        mResult <- insertUniqueEntity $ review _InvitableJunction (invitee, fid, jData)
+        case mResult of
+          Nothing -> invalidArgsI [MsgInvitationCollision]
+          Just res -> do
+            addMessageI Success =<< invitationSuccessMsg fRec res
+            Just <$> invitationUltDest fRec res
+
+  whenIsJust tRoute redirect
+
+  let formWidget = wrapForm dataWidget def
+        { formMethod   = POST
+        , formAction   = Just $ SomeRoute cRoute
+        , formEncoding = dataEnctype
+        , formSubmit   = FormNoSubmit
+        }
+
+  siteLayoutMsg heading $(widgetFile "widgets/invitation-site")
+
+
+-- $procedure
+--
+-- `Invitation`s encode a pending entry of some junction table between some
+-- record and `User` e.g.
+--
+-- > data SheetCorrector = SheetCorrector
+-- >   { sheetCorrectorUser  :: UserId
+-- >   , sheetCorrectorSheet :: SheetId
+-- >   , sheetCorrectorLoad  :: Load
+-- >   }
+--
+-- We split the record, encoding a line in the junction table, into a `(UserId,
+-- InvitationData)`-Pair, storing only part of the `InvitationData` in a
+-- separate table (what we don't store in that table gets encoded into a
+-- `BearerToken`).
+--
+-- After a User, authorized by said token, supplies their `UserId` the record is
+-- completed and `insert`ed into the database.
+--
+-- We also make provisions for storing one side of the junction's `Key`s
+-- (`InvitationFor`) separately from the rest of the `InvitationData` to make
+-- querying for pending invitations easier.
diff --git a/src/Handler/Utils/Tokens.hs b/src/Handler/Utils/Tokens.hs
index e95b16a69..8ca5ad400 100644
--- a/src/Handler/Utils/Tokens.hs
+++ b/src/Handler/Utils/Tokens.hs
@@ -1,5 +1,6 @@
 module Handler.Utils.Tokens
   ( maybeBearerToken, requireBearerToken
+  , currentTokenRestrictions
   ) where
 
 import Import
@@ -25,3 +26,9 @@ requireBearerToken = liftHandlerT $ do
   isWrite <- isWriteRequest currentRoute
   guardAuthResult <=< runDB $ validateToken mAuthId currentRoute isWrite token
   return token
+
+currentTokenRestrictions :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, FromJSON a, ToJSON a) => m (Maybe a)
+currentTokenRestrictions = runMaybeT $ do
+  token <- MaybeT maybeBearerToken
+  route <- MaybeT getCurrentRoute
+  hoistMaybe $ preview (_tokenRestrictionIx route) token
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 51de48a1e..f43f2d864 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -84,6 +84,7 @@ import Control.Monad.Random.Class as Import (MonadRandom(..))
 
 import Text.Blaze.Instances as Import ()
 import Jose.Jwt.Instances as Import ()
+import Jose.Jwt as Import (Jwt)
 import Web.PathPieces.Instances as Import ()
 
 
diff --git a/src/Jobs.hs b/src/Jobs.hs
index c935c79af..b44642d15 100644
--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@@ -62,6 +62,7 @@ import Jobs.Handler.DistributeCorrections
 import Jobs.Handler.SendCourseCommunication
 import Jobs.Handler.LecturerInvitation
 import Jobs.Handler.CorrectorInvitation
+import Jobs.Handler.Invitation
 
   
 data JobQueueException = JInvalid QueuedJobId QueuedJob
diff --git a/src/Jobs/Handler/Invitation.hs b/src/Jobs/Handler/Invitation.hs
new file mode 100644
index 000000000..f9c93828f
--- /dev/null
+++ b/src/Jobs/Handler/Invitation.hs
@@ -0,0 +1,14 @@
+module Jobs.Handler.Invitation
+  ( dispatchJobInvitation
+  ) where
+
+import Import
+
+
+dispatchJobInvitation :: UserId
+                      -> UserEmail
+                      -> Text
+                      -> Text
+                      -> Html
+                      -> Handler ()
+dispatchJobInvitation = error "dispatchJobInvitation"
diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs
index fc399d6a5..4dcf0de35 100644
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@@ -37,6 +37,12 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
          | JobCorrectorInvitation { jInviter :: UserId
                                   , jCorrectorInvitation :: SheetCorrectorInvitation
                                   }
+         | JobInvitation { jInviter :: UserId
+                         , jInvitee :: UserEmail
+                         , jInvitationUrl :: Text
+                         , jInvitationSubject :: Text
+                         , jInvitationExplanation :: Html
+                         }
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                   | NotificationSheetActive { nSheet :: SheetId }
diff --git a/src/Jose/Jwt/Instances.hs b/src/Jose/Jwt/Instances.hs
index 4bf4e3827..0c0c093ef 100644
--- a/src/Jose/Jwt/Instances.hs
+++ b/src/Jose/Jwt/Instances.hs
@@ -9,10 +9,18 @@ import ClassyPrelude.Yesod
 import Jose.Jwt
 
 
+deriving instance Ord Jwt
+deriving instance Read Jwt
+deriving instance Generic Jwt
+deriving instance Typeable Jwt
+
 instance PathPiece Jwt where
   toPathPiece (Jwt bytes) = decodeUtf8 bytes
   fromPathPiece = Just . Jwt . encodeUtf8
 
+instance Hashable Jwt
+
+
 deriving instance Generic JwtError
 deriving instance Typeable JwtError
 
diff --git a/src/Utils.hs b/src/Utils.hs
index 40fa580ee..a5939a40b 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -462,6 +462,12 @@ formResultToMaybe :: Alternative m => FormResult a -> m a
 formResultToMaybe (FormSuccess x) = pure x
 formResultToMaybe  _              = empty
 
+maybeThrow :: (MonadThrow m, Exception e) => e -> Maybe a -> m a
+maybeThrow exc = maybe (throwM exc) return
+
+maybeThrowM :: (MonadThrow m, Exception e) => m e -> Maybe a -> m a
+maybeThrowM excM = maybe (throwM =<< excM) return
+
 ------------
 -- Either --
 ------------
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 25180df04..ec9fc2d86 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -23,6 +23,7 @@ import qualified Data.Set as Set
 import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Reader.Class (MonadReader(..))
 import Control.Monad.Writer.Class (MonadWriter(..))
+import Control.Monad.Trans.RWS (mapRWST)
 
 import Data.List ((!!))
 
@@ -614,6 +615,18 @@ prismAForm p outer form = review p <$> form inner
   where
     inner = outer >>= preview p
 
+-----------------------
+-- Form Manipulation --
+-----------------------
+
+aFormToWForm :: MonadHandler m => AForm m a -> WForm m (FormResult a)
+aFormToWForm = mapRWST mFormToWForm' . over (mapped . _2) ($ []) . aFormToForm
+  where
+    mFormToWForm' f = do
+      ((a, vs), ints, enctype) <- lift f
+      writer ((a, ints, enctype), vs)
+
+
 ---------------------------------------------
 -- Special variants of @mopt@, @mreq@, ... --
 ---------------------------------------------
diff --git a/templates/widgets/invitation-site.hamlet b/templates/widgets/invitation-site.hamlet
new file mode 100644
index 000000000..064e92184
--- /dev/null
+++ b/templates/widgets/invitation-site.hamlet
@@ -0,0 +1,4 @@
+<section>
+  #{explanation}
+<section>
+  ^{formWidget}

From 7f6d30c0d6095d7a5f8684d80f2b4f4160af1f7c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Apr 2019 00:03:41 +0200
Subject: [PATCH 2/6] Invitation e-mails

---
 src/Jobs/Handler/Invitation.hs   | 15 ++++++++++++++-
 templates/mail/invitation.hamlet | 11 +++++++++++
 2 files changed, 25 insertions(+), 1 deletion(-)
 create mode 100644 templates/mail/invitation.hamlet

diff --git a/src/Jobs/Handler/Invitation.hs b/src/Jobs/Handler/Invitation.hs
index f9c93828f..f86256f33 100644
--- a/src/Jobs/Handler/Invitation.hs
+++ b/src/Jobs/Handler/Invitation.hs
@@ -3,6 +3,11 @@ module Jobs.Handler.Invitation
   ) where
 
 import Import
+import Utils.Lens
+import Handler.Utils.Mail
+
+import qualified Data.CaseInsensitive as CI
+import Text.Hamlet
 
 
 dispatchJobInvitation :: UserId
@@ -11,4 +16,12 @@ dispatchJobInvitation :: UserId
                       -> Text
                       -> Html
                       -> Handler ()
-dispatchJobInvitation = error "dispatchJobInvitation"
+dispatchJobInvitation jInviter jInvitee jInvitationUrl jInvitationSubject jInvitationExplanation = do
+  mInviter <- runDB $ get jInviter
+
+  whenIsJust mInviter $ \jInviter' -> mailT def $ do
+    _mailTo .= [Address Nothing $ CI.original jInvitee]
+    replaceMailHeader "Reply-To" . Just . renderAddress $ userAddress jInviter'
+    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+    replaceMailHeader "Subject" $ Just jInvitationSubject
+    addPart ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
diff --git a/templates/mail/invitation.hamlet b/templates/mail/invitation.hamlet
new file mode 100644
index 000000000..ef3b004e5
--- /dev/null
+++ b/templates/mail/invitation.hamlet
@@ -0,0 +1,11 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+  <body>
+    <p>
+      #{jInvitationExplanation}
+    <p>
+      <a href=#{jInvitationUrl}>
+        _{MsgInvitationAcceptDecline}

From 5bc0254f7f757dd73dba51e81586aa20aa4da69c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Apr 2019 01:22:36 +0200
Subject: [PATCH 3/6] Implement lecturer invitations with new system

---
 messages/uniworx/de.msg                |   4 +-
 routes                                 |   2 +-
 src/Handler/Course.hs                  | 142 +++++++++++++------------
 src/Handler/Utils/Invitations.hs       |  72 ++++++++++---
 src/Jobs.hs                            |   1 -
 src/Jobs/Handler/LecturerInvitation.hs |  41 -------
 src/Jobs/Types.hs                      |   3 -
 templates/courseLecInvite.hamlet       |   3 -
 8 files changed, 139 insertions(+), 129 deletions(-)
 delete mode 100644 src/Jobs/Handler/LecturerInvitation.hs
 delete mode 100644 templates/courseLecInvite.hamlet

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 8a6a194bc..509bb2120 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -800,4 +800,6 @@ InvitationMissingRestrictions: Authorisierungs-Token fehlen benötigte Daten
 InvitationCollision: Einladung konnte nicht angenommen werden da ein derartiger Eintrag bereits existiert
 InvitationDeclined: Einladung wurde abgelehnt
 BtnInviteAccept: Einladung annehmen
-BtnInviteDecline: Einladung ablehnen
\ No newline at end of file
+BtnInviteDecline: Einladung ablehnen
+
+LecturerType: Rolle
\ No newline at end of file
diff --git a/routes b/routes
index 0e801e22b..c9af2ca13 100644
--- a/routes
+++ b/routes
@@ -76,7 +76,7 @@
   /                           CShowR          GET             !free
   /register                   CRegisterR          POST        !timeANDcapacity
   /edit                       CEditR          GET POST
-  /lecturer-invite/#UserEmail CLecInviteR     GET POST
+  /lecturer-invite            CLecInviteR     GET POST
   /delete                     CDeleteR        GET POST        !lecturerANDempty
   /users                      CUsersR         GET POST
   /users/#CryptoUUIDUser      CUserR          GET POST        !lecturerANDparticipant
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 5697b7bd4..3cc623819 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -15,6 +15,7 @@ import Handler.Utils.Delete
 import Handler.Utils.Database
 import Handler.Utils.Table.Cells
 import Handler.Utils.Table.Columns
+import Handler.Utils.Invitations
 import Database.Persist.Sql (deleteWhereCount)
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
@@ -37,6 +38,11 @@ import Text.Blaze.Html.Renderer.Text (renderHtml)
 
 import Jobs.Queue
 
+import Data.Aeson hiding (Result(..))
+
+import Text.Hamlet (ihamlet)
+  
+
 -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
 type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School)
 
@@ -500,12 +506,10 @@ courseEditHandler miButtonAction mbCourseForm = do
               , courseDeregisterUntil = cfDeRegUntil res
               }
             whenIsJust insertOkay $ \cid -> do
-                forM_ (cfLecturers res) $ \case
-                  Right (lid, lty) -> insert_  $ Lecturer lid cid lty
-                  Left (lEmail, mLTy) -> do
-                    insert_ $ LecturerInvitation lEmail cid mLTy
-                    queueDBJob . JobLecturerInvitation aid $ LecturerInvitation lEmail cid mLTy
-                insert_ $ CourseEdit aid now cid
+              let (invites, adds) = partitionEithers $ cfLecturers res
+              insertMany_ $ map (\(lid, lty) -> Lecturer lid cid lty) adds
+              sinkInvitationsF lecturerInvitationConfig $ map (\(lEmail, mLty) -> (lEmail, cid, (InvDBDataLecturer mLty, InvTokenDataLecturer))) invites
+              insert_ $ CourseEdit aid now cid
             return insertOkay
           case insertOkay of
             Just _ -> do
@@ -545,16 +549,11 @@ courseEditHandler miButtonAction mbCourseForm = do
                   (Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False
                   Nothing  -> do
                     deleteWhere [LecturerCourse ==. cid]
-                    deleteWhere [LecturerInvitationCourse ==. cid, LecturerInvitationEmail /<-. toListOf (folded . _Left . _1) (cfLecturers res)]
-                    forM_ (cfLecturers res) $ \case
-                      Right (lid, lty) -> insert_  $ Lecturer lid cid lty
-                      Left (lEmail, mLTy) -> do
-                        insertRes <- insertUnique (LecturerInvitation lEmail cid mLTy)
-                        case insertRes of
-                          Just _  ->
-                            queueDBJob . JobLecturerInvitation aid $ LecturerInvitation lEmail cid mLTy
-                          Nothing -> 
-                            updateBy (UniqueLecturerInvitation lEmail cid) [ LecturerInvitationType =. mLTy ]
+                    deleteWhere [InvitationFor ==. invRef @Lecturer cid, InvitationEmail /<-. toListOf (folded . _Left . _1) (cfLecturers res)]
+                    let (invites, adds) = partitionEithers $ cfLecturers res
+                    insertMany_ $ map (\(lid, lty) -> Lecturer lid cid lty) adds
+                    sinkInvitationsF lecturerInvitationConfig $ map (\(lEmail, mLty) -> (lEmail, cid, (InvDBDataLecturer mLty, InvTokenDataLecturer))) invites
+
                     insert_ $ CourseEdit aid now cid
                     addMessageI Success $ MsgCourseEditOk tid ssh csh
                     return True
@@ -568,6 +567,65 @@ courseEditHandler miButtonAction mbCourseForm = do
         }
 
 
+instance IsInvitableJunction Lecturer where
+  type InvitationFor Lecturer = Course
+  data InvitableJunction Lecturer = JunctionLecturer
+    { jLecturerType :: LecturerType
+    } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  data InvitationDBData Lecturer = InvDBDataLecturer
+    { invDBLecturerType :: Maybe LecturerType
+    } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  data InvitationTokenData Lecturer = InvTokenDataLecturer
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+  _InvitableJunction = iso
+    (\Lecturer{..} -> (lecturerUser, lecturerCourse, JunctionLecturer lecturerType))
+    (\(lecturerUser, lecturerCourse, JunctionLecturer lecturerType) -> Lecturer{..})
+
+instance ToJSON (InvitableJunction Lecturer) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+instance FromJSON (InvitableJunction Lecturer) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+
+instance ToJSON (InvitationDBData Lecturer) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
+instance FromJSON (InvitationDBData Lecturer) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
+
+instance ToJSON (InvitationTokenData Lecturer) where
+  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
+instance FromJSON (InvitationTokenData Lecturer) where
+  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
+
+lecturerInvitationConfig :: InvitationConfig Lecturer
+lecturerInvitationConfig = InvitationConfig{..}
+  where
+    invitationRoute Course{..} _ = return . CourseR courseTerm courseSchool courseShorthand $ CLecInviteR
+    invitationResolveFor = do
+      Just (CourseR tid csh ssh CLecInviteR) <- getCurrentRoute
+      getKeyBy404 $ TermSchoolCourseShort tid csh ssh
+    invitationSubject Course{..} _ = SomeMessage $ MsgMailSubjectLecturerInvitation courseTerm courseSchool courseShorthand
+    invitationHeading Course{..} _ = SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
+    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
+    invitationTokenConfig _ _ = do
+      itAuthority <- liftHandlerT requireAuthId
+      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
+    invitationRestriction _ _ = return Authorized
+    invitationForm _ (InvDBDataLecturer mlType, _) = hoistAForm liftHandlerT $ toJunction <$> case mlType of
+      Nothing    -> areq    (selectField optionsFinite) lFs Nothing
+      Just lType -> aforced (selectField optionsFinite) lFs lType
+      where
+        toJunction jLecturerType = JunctionLecturer{..}
+        lFs = fslI MsgLecturerType & setTooltip MsgCourseLecturerRightsIdentical
+    invitationSuccessMsg Course{..} (Entity _ Lecturer{..}) = do
+      MsgRenderer mr <- getMsgRenderer
+      return . SomeMessage $ MsgLecturerInvitationAccepted (mr lecturerType) courseShorthand
+    invitationUltDest Course{..} _ = return . SomeRoute $ CourseR courseTerm courseSchool courseShorthand CShowR
+
+
 data CourseForm = CourseForm
         { cfCourseId   :: Maybe CourseId
         , cfName       :: CourseName
@@ -1131,54 +1189,6 @@ postCCommR tid ssh csh = do
     }
 
  
-data ButtonLecInvite = BtnLecInvAccept | BtnLecInvDecline
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe ButtonLecInvite
-instance Finite ButtonLecInvite
-
-nullaryPathPiece ''ButtonLecInvite $ camelToPathPiece' 3
-embedRenderMessage ''UniWorX ''ButtonLecInvite id
-
-instance Button UniWorX ButtonLecInvite where
-  btnClasses BtnLecInvAccept = [BCIsButton, BCPrimary]
-  btnClasses BtnLecInvDecline = [BCIsButton, BCDanger]
-
-getCLecInviteR, postCLecInviteR :: TermId -> SchoolId -> CourseShorthand -> UserEmail -> Handler Html
+getCLecInviteR, postCLecInviteR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCLecInviteR = postCLecInviteR
-postCLecInviteR tid ssh csh email = do
-  uid <- requireAuthId
-  (Entity cid Course{..}, Entity liId LecturerInvitation{..}) <- runDB $ do
-    cRes@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh
-    iRes <- getBy404 $ UniqueLecturerInvitation email cid
-    return (cRes, iRes)
-
-  ((btnResult, btnInnerWidget), btnEncoding) <- runFormPost . formEmbedJwtPost $ \csrf -> do
-    (ltRes, ltView) <- case lecturerInvitationType of
-      Nothing -> mreq (selectField optionsFinite) "" Nothing
-      Just lType -> mforced (selectField optionsFinite) "" lType
-    (btnRes, btnWdgt) <- buttonForm mempty
-    return ((,) <$> ltRes <*> btnRes, toWidget csrf <> fvInput ltView <> btnWdgt)
-
-  let btnWidget = wrapForm btnInnerWidget def
-        { formEncoding = btnEncoding
-        , formAction = Just . SomeRoute . CourseR tid ssh csh $ CLecInviteR email
-        , formSubmit = FormNoSubmit
-        }
-
-  formResult btnResult $ \case
-    (lType, BtnLecInvAccept) -> do
-      runDB $ do
-        delete liId
-        insert_ $ Lecturer uid cid lType
-      MsgRenderer mr <- getMsgRenderer
-      addMessageI Success $ MsgLecturerInvitationAccepted (mr lType) csh
-      redirect $ CourseR tid ssh csh CShowR
-    (_, BtnLecInvDecline) -> do
-      runDB $
-        delete liId
-      addMessageI Info $ MsgLecturerInvitationDeclined csh
-      redirect HomeR
-
-  siteLayoutMsg (MsgCourseLecInviteHeading $ CI.original courseName) $ do
-    setTitleI . MsgCourseLecInviteHeading $ CI.original courseName
-    $(widgetFile "courseLecInvite")
+postCLecInviteR = invitationR lecturerInvitationConfig
diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs
index 480282060..257881ea1 100644
--- a/src/Handler/Utils/Invitations.hs
+++ b/src/Handler/Utils/Invitations.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
 
 module Handler.Utils.Invitations
   ( -- * Procedure
@@ -6,9 +7,10 @@ module Handler.Utils.Invitations
     -- $procedure
     IsInvitableJunction(..)
   , _invitationDBData, _invitationTokenData
+  , InvitationReference(..), invRef
   , InvitationConfig(..), InvitationTokenConfig(..)
   , sinkInvitations, sinkInvitationsF
-  , invitationR
+  , invitationR', InvitationR(..)
   ) where
 
 import Import
@@ -30,11 +32,15 @@ import Data.Aeson (fromJSON)
 import qualified Data.Aeson as JSON
 import Data.Aeson.TH
 
+import Data.Proxy (Proxy(..))
+import Data.Typeable
+
 
 class ( PersistRecordBackend junction (YesodPersistBackend UniWorX)
       , ToJSON (InvitationDBData junction), ToJSON (InvitationTokenData junction)
       , FromJSON (InvitationDBData junction), FromJSON (InvitationTokenData junction)
       , PersistRecordBackend (InvitationFor junction) (YesodPersistBackend UniWorX)
+      , Typeable junction
       ) => IsInvitableJunction junction where
   -- | One side of the junction is always `User`; `InvitationFor junction` is the other
   type InvitationFor       junction :: *
@@ -72,6 +78,32 @@ _invitationTokenData :: IsInvitableJunction junction => Lens' (InvitationData ju
 _invitationTokenData = _InvitationData . _2
 
 
+data InvitationReference junction = IsInvitableJunction junction => InvRef (Key (InvitationFor junction))
+
+deriving instance Eq (InvitationReference junction)
+deriving instance Ord (InvitationReference junction)
+deriving instance IsInvitableJunction junction => Read (InvitationReference junction)
+deriving instance Show (InvitationReference junction)
+
+instance ToJSON (InvitationReference junction) where
+  toJSON (InvRef fId) = JSON.object
+    [ "type" JSON..= show (typeRep (Proxy @junction))
+    , "key"  JSON..= fId
+    ]
+instance IsInvitableJunction junction => FromJSON (InvitationReference junction) where
+  parseJSON = JSON.withObject "InvitationReference" $ \o -> do
+    table <- o JSON..: "type"
+    key   <- o JSON..: "key"
+
+    unless (table == show (typeRep (Proxy @junction))) $
+      fail "Unexpected table"
+
+    return $ InvRef key
+
+invRef :: forall junction. IsInvitableJunction junction => Key (InvitationFor junction) -> JSON.Value
+invRef = toJSON . InvRef @junction
+
+
 -- | Configuration needed for creating and accepting/declining `Invitation`s
 --
 -- It is advisable to define this once per `junction` in a global constant
@@ -147,13 +179,13 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif
       = C.map Right
       | otherwise
       = C.mapM $ \inp@(email, fid, dat) ->
-          maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (toJSON fid))
+          maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (toJSON $ InvRef @junction fid))
 
     sinkInvitations' :: [Either (InvitationId, InvitationData junction) (UserEmail, Key (InvitationFor junction), InvitationData junction)]
                      -> YesodJobDB UniWorX ()
     sinkInvitations' (partitionEithers -> (existing, new)) = do
       when (is _Nothing (ephemeralInvitation @junction)) $ do
-        insertMany_ $ map (\(email, fid, dat) -> Invitation email (toJSON fid) (toJSON $ dat ^. _invitationDBData)) new
+        insertMany_ $ map (\(email, fid, dat) -> Invitation email (toJSON $ InvRef @junction fid) (toJSON $ dat ^. _invitationDBData)) new
         forM_ existing $ \(iid, dat) -> update iid [ InvitationData =. toJSON (dat ^. _invitationDBData) ]
       forM_ new $ \(jInvitee, fid, dat) -> do
         app <- getYesod
@@ -201,15 +233,15 @@ instance Button UniWorX ButtonInvite where
   btnValidate _ BtnInviteAccept  = True
   btnValidate _ BtnInviteDecline = False
 
-invitationR :: forall junction m.
-               ( IsInvitableJunction junction
-               , MonadHandler m
-               , HandlerSite m ~ UniWorX
-               )
-            => InvitationConfig junction
-            -> m Html
+invitationR' :: forall junction m.
+                ( IsInvitableJunction junction
+                , MonadHandler m
+                , HandlerSite m ~ UniWorX
+                )
+             => InvitationConfig junction
+             -> m Html
 -- | Generic handler for incoming invitations
-invitationR InvitationConfig{..} = liftHandlerT $ do
+invitationR' InvitationConfig{..} = liftHandlerT $ do
   InvitationTokenRestriction{..} <- maybeM (invalidArgsI [MsgInvitationMissingRestrictions]) return currentTokenRestrictions :: Handler (InvitationTokenRestriction junction)
   invitee <- requireAuthId
   Just cRoute <- getCurrentRoute
@@ -218,7 +250,7 @@ invitationR InvitationConfig{..} = liftHandlerT $ do
     Entity fid fRec <- invitationResolveFor >>= (\k -> Entity k <$> get404 k)
     dbData <- case ephemeralInvitation @junction of
       Nothing -> do
-        Invitation{..} <- entityVal <$> getBy404 (UniqueInvitation itEmail $ toJSON fid)
+        Invitation{..} <- entityVal <$> getBy404 (UniqueInvitation itEmail . toJSON $ InvRef @junction fid)
         case fromJSON invitationData of
           JSON.Success dbData -> return dbData
           JSON.Error   str    -> fail $ "Could not decode invitationData: " <> str
@@ -243,7 +275,7 @@ invitationR InvitationConfig{..} = liftHandlerT $ do
     fmap (, (dataWidget, dataEnctype), heading, explanation) . formResultMaybe dataRes $ \case
       Nothing -> do
         addMessageI Info MsgInvitationDeclined
-        deleteBy . UniqueInvitation itEmail $ toJSON fid
+        deleteBy . UniqueInvitation itEmail . toJSON $ InvRef @junction fid
         return . Just $ SomeRoute HomeR
       Just jData -> do
         mResult <- insertUniqueEntity $ review _InvitableJunction (invitee, fid, jData)
@@ -265,6 +297,20 @@ invitationR InvitationConfig{..} = liftHandlerT $ do
   siteLayoutMsg heading $(widgetFile "widgets/invitation-site")
 
 
+class InvitationR a where
+  invitationR :: forall junction.
+                ( IsInvitableJunction junction
+                )
+              => InvitationConfig junction
+              -> a
+
+instance InvitationR (Handler Html) where
+  invitationR = invitationR'
+
+instance InvitationR b => InvitationR (a -> b) where
+  invitationR cfg _ = invitationR cfg
+  
+
 -- $procedure
 --
 -- `Invitation`s encode a pending entry of some junction table between some
diff --git a/src/Jobs.hs b/src/Jobs.hs
index b44642d15..13696ec82 100644
--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@@ -60,7 +60,6 @@ import Jobs.Handler.HelpRequest
 import Jobs.Handler.SetLogSettings
 import Jobs.Handler.DistributeCorrections
 import Jobs.Handler.SendCourseCommunication
-import Jobs.Handler.LecturerInvitation
 import Jobs.Handler.CorrectorInvitation
 import Jobs.Handler.Invitation
 
diff --git a/src/Jobs/Handler/LecturerInvitation.hs b/src/Jobs/Handler/LecturerInvitation.hs
deleted file mode 100644
index e3fd03a6d..000000000
--- a/src/Jobs/Handler/LecturerInvitation.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-module Jobs.Handler.LecturerInvitation
-  ( dispatchJobLecturerInvitation
-  ) where
-
-import Import
-
-import Text.Hamlet
-
-import qualified Data.HashSet as HashSet
-
-import qualified Data.CaseInsensitive as CI
-
-import Utils.Lens
-
-
-dispatchJobLecturerInvitation :: UserId -> LecturerInvitation -> Handler ()
-dispatchJobLecturerInvitation jInviter jLecturerInvitation@LecturerInvitation{..} = do
-  ctx <- runDB . runMaybeT $ do
-    course <- MaybeT $ get lecturerInvitationCourse
-    void . MaybeT $ getByValue jLecturerInvitation
-    user <- MaybeT $ get jInviter
-    return (course, user)
-
-  case ctx of
-    Just (Course{..}, User{..}) -> do
-      let baseRoute = CourseR courseTerm courseSchool courseShorthand $ CLecInviteR lecturerInvitationEmail
-      jwt <- encodeToken =<< bearerToken jInviter (Just $ HashSet.singleton baseRoute) Nothing Nothing Nothing
-      let
-        invitationUrl :: SomeRoute UniWorX
-        invitationUrl = SomeRoute (baseRoute, [(toPathPiece GetBearer, toPathPiece jwt)])
-      invitationUrl' <- toTextUrl invitationUrl
-
-      mailT def $ do
-        _mailTo .= [Address Nothing $ CI.original lecturerInvitationEmail]
-        replaceMailHeader "Reply-To" . Just . renderAddress $ Address (Just userDisplayName) (CI.original userEmail)
-        replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
-        setSubjectI $ MsgMailSubjectLecturerInvitation courseTerm courseSchool courseShorthand
-      
-        addPart ($(ihamletFile "templates/mail/lecturerInvitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    Nothing -> runDB .
-      deleteBy $ UniqueLecturerInvitation lecturerInvitationEmail lecturerInvitationCourse
diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs
index 4dcf0de35..c5a0aa763 100644
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@@ -31,9 +31,6 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
                                       , jSubject :: Maybe Text
                                       , jMailContent :: Html
                                       }
-         | JobLecturerInvitation { jInviter :: UserId
-                                 , jLecturerInvitation :: LecturerInvitation
-                                 }
          | JobCorrectorInvitation { jInviter :: UserId
                                   , jCorrectorInvitation :: SheetCorrectorInvitation
                                   }
diff --git a/templates/courseLecInvite.hamlet b/templates/courseLecInvite.hamlet
deleted file mode 100644
index 408556fb7..000000000
--- a/templates/courseLecInvite.hamlet
+++ /dev/null
@@ -1,3 +0,0 @@
-<p>
-  _{MsgCourseLecInviteExplanation}
-^{btnWidget}

From dfe0b4de5ebb27741f340306d81c571f29808e27 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Apr 2019 01:34:18 +0200
Subject: [PATCH 4/6] Rename fields of InvitationReference

---
 src/Handler/Utils/Invitations.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs
index 257881ea1..ab73a7152 100644
--- a/src/Handler/Utils/Invitations.hs
+++ b/src/Handler/Utils/Invitations.hs
@@ -87,13 +87,13 @@ deriving instance Show (InvitationReference junction)
 
 instance ToJSON (InvitationReference junction) where
   toJSON (InvRef fId) = JSON.object
-    [ "type" JSON..= show (typeRep (Proxy @junction))
-    , "key"  JSON..= fId
+    [ "junction" JSON..= show (typeRep (Proxy @junction))
+    , "record"   JSON..= fId
     ]
 instance IsInvitableJunction junction => FromJSON (InvitationReference junction) where
   parseJSON = JSON.withObject "InvitationReference" $ \o -> do
-    table <- o JSON..: "type"
-    key   <- o JSON..: "key"
+    table <- o JSON..: "junction"
+    key   <- o JSON..: "record"
 
     unless (table == show (typeRep (Proxy @junction))) $
       fail "Unexpected table"

From 2a0bee58b58b469f1a35ce8168ff1caf19c85a54 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Apr 2019 11:17:43 +0200
Subject: [PATCH 5/6] More idiomatic usage of `invRef`

---
 src/Handler/Utils/Invitations.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs
index ab73a7152..0061b730a 100644
--- a/src/Handler/Utils/Invitations.hs
+++ b/src/Handler/Utils/Invitations.hs
@@ -179,13 +179,13 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif
       = C.map Right
       | otherwise
       = C.mapM $ \inp@(email, fid, dat) ->
-          maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (toJSON $ InvRef @junction fid))
+          maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (invRef @junction fid))
 
     sinkInvitations' :: [Either (InvitationId, InvitationData junction) (UserEmail, Key (InvitationFor junction), InvitationData junction)]
                      -> YesodJobDB UniWorX ()
     sinkInvitations' (partitionEithers -> (existing, new)) = do
       when (is _Nothing (ephemeralInvitation @junction)) $ do
-        insertMany_ $ map (\(email, fid, dat) -> Invitation email (toJSON $ InvRef @junction fid) (toJSON $ dat ^. _invitationDBData)) new
+        insertMany_ $ map (\(email, fid, dat) -> Invitation email (invRef @junction fid) (toJSON $ dat ^. _invitationDBData)) new
         forM_ existing $ \(iid, dat) -> update iid [ InvitationData =. toJSON (dat ^. _invitationDBData) ]
       forM_ new $ \(jInvitee, fid, dat) -> do
         app <- getYesod
@@ -250,7 +250,7 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
     Entity fid fRec <- invitationResolveFor >>= (\k -> Entity k <$> get404 k)
     dbData <- case ephemeralInvitation @junction of
       Nothing -> do
-        Invitation{..} <- entityVal <$> getBy404 (UniqueInvitation itEmail . toJSON $ InvRef @junction fid)
+        Invitation{..} <- entityVal <$> getBy404 (UniqueInvitation itEmail $ invRef @junction fid)
         case fromJSON invitationData of
           JSON.Success dbData -> return dbData
           JSON.Error   str    -> fail $ "Could not decode invitationData: " <> str
@@ -275,7 +275,7 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
     fmap (, (dataWidget, dataEnctype), heading, explanation) . formResultMaybe dataRes $ \case
       Nothing -> do
         addMessageI Info MsgInvitationDeclined
-        deleteBy . UniqueInvitation itEmail . toJSON $ InvRef @junction fid
+        deleteBy . UniqueInvitation itEmail $ invRef @junction fid
         return . Just $ SomeRoute HomeR
       Just jData -> do
         mResult <- insertUniqueEntity $ review _InvitableJunction (invitee, fid, jData)

From 22c01d988cdd1d118ace88d5393c75c9e54a947a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Sun, 5 May 2019 16:45:58 +0200
Subject: [PATCH 6/6] Generic invitations for everything

---
 messages/uniworx/de.msg                       |   7 +
 models/courses                                |   6 -
 models/sheets                                 |   7 -
 routes                                        |   3 +-
 src/Handler/Course.hs                         |  10 +-
 src/Handler/Sheet.hs                          | 135 ++++++++++--------
 src/Handler/Tutorial.hs                       | 113 ++++++++++++---
 src/Handler/Utils/Invitations.hs              |  48 +++++--
 src/Jobs.hs                                   |   1 -
 src/Jobs/Handler/CorrectorInvitation.hs       |  42 ------
 src/Jobs/Types.hs                             |   3 -
 src/Model.hs                                  |   3 -
 src/Utils/Lens.hs                             |   2 -
 templates/sheetCorrInvite.hamlet              |   3 -
 templates/tutorial/tutorMassInput/add.hamlet  |   2 +-
 .../tutorMassInput/cellInvitation.hamlet      |   9 ++
 .../tutorial/tutorMassInput/cellKnown.hamlet  |   2 +-
 17 files changed, 233 insertions(+), 163 deletions(-)
 delete mode 100644 src/Jobs/Handler/CorrectorInvitation.hs
 delete mode 100644 templates/sheetCorrInvite.hamlet
 create mode 100644 templates/tutorial/tutorMassInput/cellInvitation.hamlet

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 8ffd3ec53..9079b16da 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -552,6 +552,8 @@ InvitationAcceptDecline: Einladung annehmen/ablehnen
 
 MailSubjectCorrectorInvitation tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: [#{display tid}-#{display ssh}-#{csh}] Einladung zum Korrektor für #{shn}
 
+MailSubjectTutorInvitation tid@TermId ssh@SchoolId csh@CourseShorthand tutn@TutorialName: [#{display tid}-#{display ssh}-#{csh}] Einladung zum Tutor für #{tutn}
+
 SheetGrading: Bewertung
 SheetGradingPoints maxPoints@Points: #{tshow maxPoints} Punkte
 SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten
@@ -817,6 +819,11 @@ CorrectorInvitationDeclined shn@SheetName: Sie haben die Einladung, Korrektor f
 SheetCorrInviteHeading shn@SheetName: Einladung zum Korrektor für #{shn}
 SheetCorrInviteExplanation: Sie wurden eingeladen, Korrektor für ein Übungsblatt zu sein.
 
+TutorInvitationAccepted tutn@TutorialName: Sie wurden als Tutor für #{tutn} eingetragen
+TutorInvitationDeclined tutn@TutorialName: Sie haben die Einladung, Tutor für #{tutn} zu werden, abgelehnt
+TutorInviteHeading tutn@TutorialName: Einladung zum Tutor für #{tutn}
+TutorInviteExplanation: Sie wurden eingeladen, Tutor zu sein.
+
 InvitationAction: Aktion
 InvitationActionTip: Abgelehnte Einladungen können nicht mehr angenommen werden
 InvitationMissingRestrictions: Authorisierungs-Token fehlen benötigte Daten
diff --git a/models/courses b/models/courses
index 45166d7d5..4fcf67d65 100644
--- a/models/courses
+++ b/models/courses
@@ -35,12 +35,6 @@ Lecturer                       -- course ownership
     course       CourseId
     type         LecturerType  default='"lecturer"'
     UniqueLecturer user course -- note: multiple lecturers per course are allowed, but no duplicated rows in this table
-LecturerInvitation json        -- preliminary course ownership for when a token to become `Lecturer` is sent to an email
-    email        (CI Text)
-    course       CourseId
-    type         LecturerType Maybe
-    UniqueLecturerInvitation email course
-    deriving Eq Ord Read Show Generic Typeable
 CourseParticipant                      -- course enrolement
     course       CourseId
     user         UserId
diff --git a/models/sheets b/models/sheets
index 293d75b2f..f8d21a6c2 100644
--- a/models/sheets
+++ b/models/sheets
@@ -35,13 +35,6 @@ SheetCorrector                -- grant corrector role to user for a sheet
     state           CorrectorState default='CorrectorNormal' -- whether a corrector is assigned his load this time (e.g. in case of sickness)
     UniqueSheetCorrector user sheet
     deriving Show Eq Ord
-SheetCorrectorInvitation json
-    email           UserEmail
-    sheet           SheetId
-    load            Load
-    state           CorrectorState
-    UniqueSheetCorrectorInvitation email sheet
-    deriving Show Read Eq Ord Generic Typeable
 SheetFile                     -- a file that is part of an exercise sheet
     sheet           SheetId
     file            FileId
diff --git a/routes b/routes
index 0c6712fff..5ab08b660 100644
--- a/routes
+++ b/routes
@@ -108,7 +108,7 @@
       !/#SubmissionFileType/*FilePath SubDownloadR           GET      !owner !corrector
     /correctors                 SCorrR        GET POST
     /pseudonym                  SPseudonymR   GET POST        !course-registeredANDcorrector-submissions
-    /corrector-invite/#UserEmail SCorrInviteR     GET POST
+    /corrector-invite           SCorrInviteR  GET POST
     !/#SheetFileType/*FilePath  SFileR        GET             !timeANDcourse-registered !timeANDmaterials !corrector
   /tuts                         CTutorialListR GET            !tutor
   /tuts/new                     CTutorialNewR  GET POST
@@ -118,6 +118,7 @@
     /participants             TUsersR         GET POST        !tutor
     /register                 TRegisterR          POST        !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered
     /communication            TCommR          GET POST        !tutor
+    /tutor-invite             TInviteR        GET POST
 
 
 /subs  CorrectionsR GET POST !corrector !lecturer
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 40e49c343..e05481c8a 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -535,7 +535,7 @@ pgCEditR tid ssh csh = do
   courseData <- runDB $ do
       mbCourse     <- getBy (TermSchoolCourseShort tid ssh csh)
       mbLecs       <- for mbCourse $ \course -> map entityVal <$> selectList [LecturerCourse ==. entityKey course] [Asc LecturerType]
-      mbLecInvites <- for mbCourse $ \course -> map entityVal <$> selectList [LecturerInvitationCourse ==. entityKey course] [Asc LecturerInvitationType]
+      mbLecInvites <- for mbCourse $ sourceInvitationsList . entityKey
       return $ (,,) <$> mbCourse <*> mbLecs <*> mbLecInvites
   -- IMPORTANT: both GET and POST Handler must use the same template,
   --    since an Edit is identified via CourseID, which is not embedded in the received form data for security reasons.
@@ -684,8 +684,8 @@ lecturerInvitationConfig = InvitationConfig{..}
     invitationResolveFor = do
       Just (CourseR tid csh ssh CLecInviteR) <- getCurrentRoute
       getKeyBy404 $ TermSchoolCourseShort tid csh ssh
-    invitationSubject Course{..} _ = SomeMessage $ MsgMailSubjectLecturerInvitation courseTerm courseSchool courseShorthand
-    invitationHeading Course{..} _ = SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
+    invitationSubject Course{..} _ = return . SomeMessage $ MsgMailSubjectLecturerInvitation courseTerm courseSchool courseShorthand
+    invitationHeading Course{..} _ = return . SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
     invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
     invitationTokenConfig _ _ = do
       itAuthority <- liftHandlerT requireAuthId
@@ -720,7 +720,7 @@ data CourseForm = CourseForm
         , cfLecturers  :: [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)]
         }
 
-courseToForm :: Entity Course -> [Lecturer] -> [LecturerInvitation] -> CourseForm
+courseToForm :: Entity Course -> [Lecturer] -> [(UserEmail, InvitationDBData Lecturer)] -> CourseForm
 courseToForm (Entity cid Course{..}) lecs lecInvites = CourseForm
     { cfCourseId   = Just cid
     , cfName       = courseName
@@ -736,7 +736,7 @@ courseToForm (Entity cid Course{..}) lecs lecInvites = CourseForm
     , cfRegTo      = courseRegisterTo
     , cfDeRegUntil = courseDeregisterUntil
     , cfLecturers  = [Right (lecturerUser, lecturerType) | Lecturer{..} <- lecs]
-                  ++ [Left (lecturerInvitationEmail, lecturerInvitationType) | LecturerInvitation{..} <- lecInvites ]
+                  ++ [Left (email, mType) | (email, InvDBDataLecturer mType) <- lecInvites ]
     }
 
 makeCourseForm :: (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> Maybe CourseForm -> Form CourseForm
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 8448a5203..478f00a91 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Handler.Sheet where
 
 import Import
@@ -13,6 +15,7 @@ import Handler.Utils.Table.Cells
 import Handler.Utils.SheetType
 import Handler.Utils.Delete
 import Handler.Utils.Form.MassInput
+import Handler.Utils.Invitations
 
 -- import Data.Time
 -- import qualified Data.Text as T
@@ -56,6 +59,9 @@ import Utils.Lens
 import Control.Monad.Random.Class (MonadRandom(..))
 import Utils.Sql
 
+import Data.Aeson hiding (Result(..))
+import Text.Hamlet (ihamlet)
+
 
 {-
   * Implement Handlers
@@ -637,7 +643,7 @@ defaultLoads shid = do
     toMap = foldMap $ \(E.Value uid, E.Value load, E.Value state) -> Map.singleton (Right uid) (state, load)
 
 
-correctorForm :: SheetId -> AForm Handler (Set (Either SheetCorrectorInvitation SheetCorrector))
+correctorForm :: SheetId -> AForm Handler (Set (Either (Invitation' SheetCorrector) SheetCorrector))
 correctorForm shid = wFormToAForm $ do
   Just currentRoute <- liftHandlerT getCurrentRoute
   userId <- liftHandlerT requireAuthId
@@ -647,7 +653,7 @@ correctorForm shid = wFormToAForm $ do
     currentLoads :: DB Loads
     currentLoads = Map.union
       <$> fmap (foldMap $ \(Entity _ SheetCorrector{..}) -> Map.singleton (Right sheetCorrectorUser) (sheetCorrectorState, sheetCorrectorLoad)) (selectList [ SheetCorrectorSheet ==. shid ] [])
-      <*> fmap (foldMap $ \(Entity _ SheetCorrectorInvitation{..}) -> Map.singleton (Left sheetCorrectorInvitationEmail) (sheetCorrectorInvitationState, sheetCorrectorInvitationLoad)) (selectList [ SheetCorrectorInvitationSheet ==. shid ] [])
+      <*> fmap (foldMap $ \(email, InvDBDataSheetCorrector load state) -> Map.singleton (Left email) (state, load)) (sourceInvitationsList shid)
   (defaultLoads', currentLoads') <- liftHandlerT . runDB $ (,) <$> defaultLoads shid <*> currentLoads
 
   isWrite <- liftHandlerT $ isWriteRequest currentRoute
@@ -743,22 +749,20 @@ correctorForm shid = wFormToAForm $ do
              -> Widget
     miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "sheetCorrectors/layout")
 
-    postProcess :: Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)) -> Set (Either SheetCorrectorInvitation SheetCorrector)
+    postProcess :: Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)) -> Set (Either (Invitation' SheetCorrector) SheetCorrector)
     postProcess = Set.fromList . map postProcess' . Map.elems
       where
         sheetCorrectorSheet = shid
-        sheetCorrectorInvitationSheet = shid
 
-        postProcess' :: (Either UserEmail UserId, (CorrectorState, Load)) -> Either SheetCorrectorInvitation SheetCorrector
+        postProcess' :: (Either UserEmail UserId, (CorrectorState, Load)) -> Either (Invitation' SheetCorrector) SheetCorrector
         postProcess' (Right sheetCorrectorUser, (sheetCorrectorState, sheetCorrectorLoad)) = Right SheetCorrector{..}
-        postProcess' (Left sheetCorrectorInvitationEmail, (sheetCorrectorInvitationState, sheetCorrectorInvitationLoad)) = Left SheetCorrectorInvitation{..}
+        postProcess' (Left email, (state, load)) = Left (email, shid, (InvDBDataSheetCorrector load state, InvTokenDataSheetCorrector))
 
   fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) True (Just . Map.fromList . zip [0..] $ Map.toList loads)
 
 getSCorrR, postSCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 postSCorrR = getSCorrR
 getSCorrR tid ssh csh shn = do
-  uid <- requireAuthId
   Entity shid Sheet{..} <- runDB $ fetchSheet tid ssh csh shn
 
   ((res,formWidget), formEnctype) <- runFormPost . identifyForm FIDcorrectors . renderAForm FormStandard $
@@ -769,17 +773,15 @@ getSCorrR tid ssh csh shn = do
     FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
     FormSuccess (autoDistribute, sheetCorrectors) -> runDBJobs $ do
       update shid [ SheetAutoDistribute =. autoDistribute ]
+      
+      let (invites, adds) = partitionEithers $ Set.toList sheetCorrectors
+
       deleteWhere [ SheetCorrectorSheet ==. shid ]
-      deleteWhere [ SheetCorrectorInvitationSheet ==. shid, SheetCorrectorInvitationEmail /<-. toListOf (folded . _Left . _sheetCorrectorInvitationEmail) sheetCorrectors ]
-      forM_ sheetCorrectors $ \case
-        Right shCor -> insert_ shCor
-        Left shCorInv -> do
-          insertRes <- insertBy shCorInv
-          case insertRes of
-            Right _ ->
-              void . queueDBJob $ JobCorrectorInvitation uid shCorInv
-            Left (Entity old _) ->
-               replace old shCorInv
+      insertMany_ adds
+
+      deleteWhere [InvitationFor ==. invRef @SheetCorrector shid, InvitationEmail /<-. toListOf (folded . _1) invites]
+      sinkInvitationsF correctorInvitationConfig invites
+
       addMessageI Success MsgCorrectorsUpdated
     FormMissing -> return ()
 
@@ -791,48 +793,65 @@ getSCorrR tid ssh csh shn = do
       }
 
 
-data ButtonCorrInvite = BtnCorrInvAccept | BtnCorrInvDecline
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe ButtonCorrInvite
-instance Finite ButtonCorrInvite
+instance IsInvitableJunction SheetCorrector where
+  type InvitationFor SheetCorrector = Sheet
+  data InvitableJunction SheetCorrector = JunctionSheetCorrector
+    { jSheetCorrectorLoad :: Load
+    , jSheetCorrectorState :: CorrectorState
+    } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  data InvitationDBData SheetCorrector = InvDBDataSheetCorrector
+    { invDBSheetCorrectorLoad :: Load
+    , invDBSheetCorrectorState :: CorrectorState
+    } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  data InvitationTokenData SheetCorrector = InvTokenDataSheetCorrector
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
-nullaryPathPiece ''ButtonCorrInvite $ camelToPathPiece' 3
-embedRenderMessage ''UniWorX ''ButtonCorrInvite id
+  _InvitableJunction = iso
+    (\SheetCorrector{..} -> (sheetCorrectorUser, sheetCorrectorSheet, JunctionSheetCorrector sheetCorrectorLoad sheetCorrectorState))
+    (\(sheetCorrectorUser, sheetCorrectorSheet, JunctionSheetCorrector sheetCorrectorLoad sheetCorrectorState) -> SheetCorrector{..})
 
-instance Button UniWorX ButtonCorrInvite where
-  btnClasses BtnCorrInvAccept = [BCIsButton, BCPrimary]
-  btnClasses BtnCorrInvDecline = [BCIsButton, BCDanger]
+instance ToJSON (InvitableJunction SheetCorrector) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+instance FromJSON (InvitableJunction SheetCorrector) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
 
-getSCorrInviteR, postSCorrInviteR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> UserEmail -> Handler Html
+instance ToJSON (InvitationDBData SheetCorrector) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+instance FromJSON (InvitationDBData SheetCorrector) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+
+instance ToJSON (InvitationTokenData SheetCorrector) where
+  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 4 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+instance FromJSON (InvitationTokenData SheetCorrector) where
+  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 4 }
+
+correctorInvitationConfig :: InvitationConfig SheetCorrector
+correctorInvitationConfig = InvitationConfig{..}
+  where
+    invitationRoute Sheet{..} _ = do
+      Course{..} <- get404 sheetCourse
+      return $ CSheetR courseTerm courseSchool courseShorthand sheetName SCorrInviteR
+    invitationResolveFor = do
+      Just (CSheetR tid csh ssh shn SCorrInviteR) <- getCurrentRoute
+      fetchSheetId tid csh ssh shn
+    invitationSubject Sheet{..} _ = do
+      Course{..} <- get404 sheetCourse
+      return . SomeMessage $ MsgMailSubjectCorrectorInvitation courseTerm courseSchool courseShorthand sheetName
+    invitationHeading Sheet{..} _ = return . SomeMessage $ MsgSheetCorrInviteHeading sheetName
+    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSheetCorrInviteExplanation}|]
+    invitationTokenConfig _ _ = do
+      itAuthority <- liftHandlerT requireAuthId
+      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
+    invitationRestriction _ _ = return Authorized
+    invitationForm _ (InvDBDataSheetCorrector load state, _) = pure $ JunctionSheetCorrector load state
+    invitationSuccessMsg Sheet{..} _ = return . SomeMessage $ MsgCorrectorInvitationAccepted sheetName
+    invitationUltDest Sheet{..} _ = do
+      Course{..} <- get404 sheetCourse
+      return . SomeRoute $ CSheetR courseTerm courseSchool courseShorthand sheetName SShowR
+
+getSCorrInviteR, postSCorrInviteR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSCorrInviteR = postSCorrInviteR
-postSCorrInviteR tid ssh csh shn email = do
-  uid <- requireAuthId
-  (Entity _ Course{..}, Entity shid Sheet{..}, Entity ciId SheetCorrectorInvitation{..}) <- runDB $ do
-    (sRes@(Entity shid _), cRes) <- fetchSheetCourse tid ssh csh shn
-    iRes <- getBy404 $ UniqueSheetCorrectorInvitation email shid
-    return (cRes, sRes, iRes)
-
-  ((btnResult, btnInnerWidget), btnEncoding) <- runFormPost $ formEmbedJwtPost buttonForm
-
-  let btnWidget = wrapForm btnInnerWidget def
-        { formEncoding = btnEncoding
-        , formAction = Just . SomeRoute . CSheetR tid ssh csh shn $ SCorrInviteR email
-        , formSubmit = FormNoSubmit
-        }
-
-  formResult btnResult $ \case
-    BtnCorrInvAccept -> do
-      runDB $ do
-        delete ciId
-        insert_ $ SheetCorrector uid shid sheetCorrectorInvitationLoad sheetCorrectorInvitationState
-      addMessageI Success $ MsgCorrectorInvitationAccepted shn
-      redirect $ CSheetR tid ssh csh shn SShowR
-    BtnCorrInvDecline -> do
-      runDB $
-        delete ciId
-      addMessageI Info $ MsgCorrectorInvitationDeclined shn
-      redirect HomeR
-
-  siteLayoutMsg (MsgSheetCorrInviteHeading shn) $ do
-    setTitleI $ MsgSheetCorrInviteHeading shn
-    $(widgetFile "sheetCorrInvite")
+postSCorrInviteR = invitationR correctorInvitationConfig
diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs
index 93b09166c..c32de13bb 100644
--- a/src/Handler/Tutorial.hs
+++ b/src/Handler/Tutorial.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Handler.Tutorial where
 
 import Import
@@ -8,6 +10,8 @@ import Handler.Utils.Delete
 import Handler.Utils.Communication
 import Handler.Utils.Form.MassInput
 import Handler.Utils.Form.Occurences
+import Handler.Utils.Invitations
+import Jobs.Queue
 
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils.TH
@@ -22,6 +26,9 @@ import qualified Data.Text as Text
 
 import Utils.Lens
 
+import Data.Aeson hiding (Result(..))
+import Text.Hamlet (ihamlet)
+
 {-# ANN module ("Hlint: ignore Redundant void" :: String) #-}
 
 
@@ -193,6 +200,66 @@ postTCommR tid ssh csh tutn = do
     }
 
 
+instance IsInvitableJunction Tutor where
+  type InvitationFor Tutor = Tutorial
+  data InvitableJunction Tutor = JunctionTutor
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  data InvitationDBData Tutor = InvDBDataTutor
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  data InvitationTokenData Tutor = InvTokenDataTutor
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+  _InvitableJunction = iso
+    (\Tutor{..} -> (tutorUser, tutorTutorial, JunctionTutor))
+    (\(tutorUser, tutorTutorial, JunctionTutor) -> Tutor{..})
+
+instance ToJSON (InvitableJunction Tutor) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+instance FromJSON (InvitableJunction Tutor) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
+
+instance ToJSON (InvitationDBData Tutor) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+instance FromJSON (InvitationDBData Tutor) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+
+instance ToJSON (InvitationTokenData Tutor) where
+  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 4 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+instance FromJSON (InvitationTokenData Tutor) where
+  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 4 }
+
+tutorInvitationConfig :: InvitationConfig Tutor
+tutorInvitationConfig = InvitationConfig{..}
+  where
+    invitationRoute Tutorial{..} _ = do
+      Course{..} <- get404 tutorialCourse
+      return $ CTutorialR courseTerm courseSchool courseShorthand tutorialName TInviteR
+    invitationResolveFor = do
+      Just (CTutorialR tid csh ssh tutn TInviteR) <- getCurrentRoute
+      fetchTutorialId tid csh ssh tutn
+    invitationSubject Tutorial{..} _ = do
+      Course{..} <- get404 tutorialCourse
+      return . SomeMessage $ MsgMailSubjectTutorInvitation courseTerm courseSchool courseShorthand tutorialName
+    invitationHeading Tutorial{..} _ = return . SomeMessage $ MsgTutorInviteHeading tutorialName
+    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgTutorInviteExplanation}|]
+    invitationTokenConfig _ _ = do
+      itAuthority <- liftHandlerT requireAuthId
+      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
+    invitationRestriction _ _ = return Authorized
+    invitationForm _ _ = pure JunctionTutor
+    invitationSuccessMsg Tutorial{..} _ = return . SomeMessage $ MsgCorrectorInvitationAccepted tutorialName
+    invitationUltDest Tutorial{..} _ = do
+      Course{..} <- get404 tutorialCourse
+      return . SomeRoute $ CourseR courseTerm courseSchool courseShorthand CTutorialListR
+
+getTInviteR, postTInviteR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
+getTInviteR = postTInviteR
+postTInviteR = invitationR tutorInvitationConfig
+
+
 data TutorialForm = TutorialForm
   { tfName            :: TutorialName
   , tfType            :: CI Text
@@ -203,7 +270,7 @@ data TutorialForm = TutorialForm
   , tfRegisterFrom    :: Maybe UTCTime
   , tfRegisterTo      :: Maybe UTCTime
   , tfDeregisterUntil :: Maybe UTCTime
-  , tfTutors          :: Set UserId -- awaiting feat/generic-invitations
+  , tfTutors          :: Set (Either UserEmail UserId)
   }
 
 tutorialForm :: CourseId -> Maybe TutorialForm -> Form TutorialForm
@@ -215,29 +282,29 @@ tutorialForm cid template html = do
   let 
     tutorForm = Set.fromList <$> massInputAccumA miAdd' miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' (fslI MsgTutorialTutors & setTooltip MsgMassInputTip) True (Set.toList . tfTutors <$> template)
       where
-        miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([UserId] -> FormResult [UserId])
+        miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
         miAdd' nudge submitView csrf = do
           (addRes, addView) <- mpreq (multiUserField False . Just $ tutUserSuggestions uid) ("" & addName (nudge "email")) Nothing
           let
             addRes'
-              | unresolved <- toListOf (_FormSuccess . folded . _Left) addRes
-              , (fUnresolved : _) <- unresolved
-              = FormFailure [mr $ MsgEMailUnknown fUnresolved]
               | otherwise
               = addRes <&> \newDat oldDat -> if
-                  | (_ : _) <- Set.toList $ setOf (folded . _Right) newDat `Set.intersection` Set.fromList oldDat
+                  | existing <- newDat `Set.intersection` Set.fromList oldDat
+                  , not $ Set.null existing
                     -> FormFailure [mr MsgTutorialTutorAlreadyAdded]
                   | otherwise
-                    -> FormSuccess $ toListOf (folded . _Right) newDat
+                    -> FormSuccess $ Set.toList newDat
           return (addRes', $(widgetFile "tutorial/tutorMassInput/add"))
 
 
-        miCell' :: UserId -> Widget
-        miCell' userId = do
+        miCell' :: Either UserEmail UserId -> Widget
+        miCell' (Left email) =
+          $(widgetFile "tutorial/tutorMassInput/cellInvitation")
+        miCell' (Right userId) = do
           User{..} <- liftHandlerT . runDB $ get404 userId
           $(widgetFile "tutorial/tutorMassInput/cellKnown")
 
-        miLayout' :: MassInputLayout ListLength UserId ()
+        miLayout' :: MassInputLayout ListLength (Either UserEmail UserId) ()
         miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "tutorial/tutorMassInput/layout")
   
   flip (renderAForm FormStandard) html $ TutorialForm
@@ -282,7 +349,7 @@ postCTutorialNewR tid ssh csh = do
   ((newTutResult, newTutWidget), newTutEnctype) <- runFormPost $ tutorialForm cid Nothing
 
   formResult newTutResult $ \TutorialForm{..} -> do
-    insertRes <- runDB $ do
+    insertRes <- runDBJobs $ do
       now <- liftIO getCurrentTime
       insertRes <- insertUnique Tutorial
         { tutorialName            = tfName
@@ -297,9 +364,10 @@ postCTutorialNewR tid ssh csh = do
         , tutorialDeregisterUntil = tfDeregisterUntil
         , tutorialLastChanged     = now
         }
-      forM_ tfTutors $ \tutor -> case insertRes of
-        Just tutid -> void . insert $ Tutor tutid tutor
-        _other     -> return ()
+      whenIsJust insertRes $ \tutid -> do
+        let (invites, adds) = partitionEithers $ Set.toList tfTutors
+        insertMany_ $ map (Tutor tutid) adds
+        sinkInvitationsF tutorInvitationConfig $ map (, tutid, (InvDBDataTutor, InvTokenDataTutor)) invites
       return insertRes
     case insertRes of
       Nothing -> addMessageI Error $ MsgTutorialNameTaken tfName
@@ -329,6 +397,8 @@ postTEditR tid ssh csh tutn = do
       E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
       return $ tutor E.^. TutorUser
 
+    tutorInvites <- sourceInvitationsList tutid
+
     let
       template = TutorialForm
         { tfName            = tutorialName
@@ -340,7 +410,8 @@ postTEditR tid ssh csh tutn = do
         , tfRegisterFrom    = tutorialRegisterFrom
         , tfRegisterTo      = tutorialRegisterTo
         , tfDeregisterUntil = tutorialDeregisterUntil
-        , tfTutors          = Set.fromList tutorIds
+        , tfTutors          = Set.fromList (map Right tutorIds)
+                           <> Set.fromList (map (\(email, InvDBDataTutor) -> Left email) tutorInvites)
         }
 
     return (cid, tutid, template)
@@ -348,7 +419,7 @@ postTEditR tid ssh csh tutn = do
   ((newTutResult, newTutWidget), newTutEnctype) <- runFormPost . tutorialForm cid $ Just template
 
   formResult newTutResult $ \TutorialForm{..} -> do
-    insertRes <- runDB $ do
+    insertRes <- runDBJobs $ do
       now <- liftIO getCurrentTime
       insertRes <- myReplaceUnique tutid Tutorial
         { tutorialName            = tfName
@@ -363,8 +434,14 @@ postTEditR tid ssh csh tutn = do
         , tutorialDeregisterUntil = tfDeregisterUntil
         , tutorialLastChanged     = now
         }
-      deleteWhere [ TutorTutorial ==. tutid ]
-      forM_ tfTutors $ void . insert . Tutor tutid
+      when (is _Nothing insertRes) $ do
+        let (invites, adds) = partitionEithers $ Set.toList tfTutors
+        
+        deleteWhere [ TutorTutorial ==. tutid ]
+        insertMany_ $ map (Tutor tutid) adds
+
+        deleteWhere [ InvitationFor ==. invRef @Tutor tutid, InvitationEmail /<-. invites ]
+        sinkInvitationsF tutorInvitationConfig $ map (, tutid, (InvDBDataTutor, InvTokenDataTutor)) invites
       return insertRes
     case insertRes of
       Just _  -> addMessageI Error $ MsgTutorialNameTaken tfName
diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs
index 0061b730a..a256a7a99 100644
--- a/src/Handler/Utils/Invitations.hs
+++ b/src/Handler/Utils/Invitations.hs
@@ -6,9 +6,11 @@ module Handler.Utils.Invitations
     --
     -- $procedure
     IsInvitableJunction(..)
+  , Invitation'
   , _invitationDBData, _invitationTokenData
   , InvitationReference(..), invRef
   , InvitationConfig(..), InvitationTokenConfig(..)
+  , sourceInvitations, sourceInvitationsList
   , sinkInvitations, sinkInvitationsF
   , invitationR', InvitationR(..)
   ) where
@@ -78,6 +80,9 @@ _invitationTokenData :: IsInvitableJunction junction => Lens' (InvitationData ju
 _invitationTokenData = _InvitationData . _2
 
 
+type Invitation' junction = (UserEmail, Key (InvitationFor junction), InvitationData junction)
+
+
 data InvitationReference junction = IsInvitableJunction junction => InvRef (Key (InvitationFor junction))
 
 deriving instance Eq (InvitationReference junction)
@@ -114,9 +119,9 @@ data InvitationConfig junction = InvitationConfig
     -- ^ Monadically resolve `InvitationFor` during `inviteR`
     --
     -- Usually from `requireBearerToken` or `getCurrentRoute`
-  , invitationSubject     :: InvitationFor junction -> InvitationData junction -> SomeMessage UniWorX
+  , invitationSubject     :: InvitationFor junction -> InvitationData junction -> YesodDB UniWorX (SomeMessage UniWorX)
     -- ^ Subject of the e-mail which sends the token to the user
-  , invitationHeading     :: InvitationFor junction -> InvitationData junction -> SomeMessage UniWorX
+  , invitationHeading     :: InvitationFor junction -> InvitationData junction -> YesodDB UniWorX (SomeMessage UniWorX)
     -- ^ Heading of the page which allows the invitee to accept/decline the invitation (`invitationR`
   , invitationExplanation :: InvitationFor junction -> InvitationData junction -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
     -- ^ Explanation of what kind of invitation this is (used both in the e-mail and in `invitationR`)
@@ -161,7 +166,7 @@ instance IsInvitableJunction junction => FromJSON (InvitationTokenRestriction ju
 sinkInvitations :: forall junction.
                    IsInvitableJunction junction
                 => InvitationConfig junction
-                -> Sink (UserEmail, Key (InvitationFor junction), InvitationData junction) (YesodJobDB UniWorX) ()
+                -> Sink (Invitation' junction) (YesodJobDB UniWorX) ()
 -- | Register invitations in the database
 --
 -- When an invitation for a certain junction (i.e. an `UserEmail`, `Key
@@ -171,9 +176,9 @@ sinkInvitations :: forall junction.
 -- For new junctions an invitation is sent by e-mail.
 sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lift . sinkInvitations'
   where
-    determineExists :: Conduit (UserEmail, Key (InvitationFor junction), InvitationData junction)
+    determineExists :: Conduit (Invitation' junction)
                                (YesodJobDB UniWorX)
-                               (Either (InvitationId, InvitationData junction) (UserEmail, Key (InvitationFor junction), InvitationData junction))
+                               (Either (InvitationId, InvitationData junction) (Invitation' junction))
     determineExists
       | is _Just (ephemeralInvitation @junction)
       = C.map Right
@@ -181,7 +186,7 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif
       = C.mapM $ \inp@(email, fid, dat) ->
           maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (invRef @junction fid))
 
-    sinkInvitations' :: [Either (InvitationId, InvitationData junction) (UserEmail, Key (InvitationFor junction), InvitationData junction)]
+    sinkInvitations' :: [Either (InvitationId, InvitationData junction) (Invitation' junction)]
                      -> YesodJobDB UniWorX ()
     sinkInvitations' (partitionEithers -> (existing, new)) = do
       when (is _Nothing (ephemeralInvitation @junction)) $ do
@@ -201,15 +206,15 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif
         let token = protoToken & tokenRestrict (urlRoute route) (InvitationTokenRestriction jInvitee $ dat ^. _invitationTokenData)
         jwt <- encodeToken token
         jInvitationUrl <- toTextUrl (route, [(toPathPiece GetBearer, toPathPiece jwt)])
-        let jInvitationSubject     = mr $ invitationSubject fRec dat
-            jInvitationExplanation = invitationExplanation fRec dat (toHtml . mr) ur
+        jInvitationSubject <- fmap mr . mapReaderT liftHandlerT $ invitationSubject fRec dat
+        let jInvitationExplanation = invitationExplanation fRec dat (toHtml . mr) ur
 
         queueDBJob JobInvitation{..}
 
 sinkInvitationsF :: forall junction mono.
                     ( IsInvitableJunction junction
                     , MonoFoldable mono
-                    , Element mono ~ (UserEmail, Key (InvitationFor junction), InvitationData junction)
+                    , Element mono ~ Invitation' junction
                     )
                  => InvitationConfig junction
                  -> mono
@@ -218,6 +223,25 @@ sinkInvitationsF :: forall junction mono.
 sinkInvitationsF cfg invs = runConduit $ mapM_ yield invs .| sinkInvitations cfg
 
 
+
+sourceInvitations :: forall junction.
+                     IsInvitableJunction junction
+                  => Key (InvitationFor junction)
+                  -> Source (YesodDB UniWorX) (UserEmail, InvitationDBData junction)
+sourceInvitations forKey = selectSource [InvitationFor ==. invRef @junction forKey] [] .| C.mapM decode
+  where
+    decode (Entity _ (Invitation email _ invitationData))
+      = case fromJSON invitationData of
+          JSON.Success dbData -> return (email, dbData)
+          JSON.Error   str    -> fail $ "Could not decode invitationData: " <> str
+
+sourceInvitationsList :: forall junction.
+                         IsInvitableJunction junction
+                      => Key (InvitationFor junction)
+                      -> YesodDB UniWorX [(UserEmail, InvitationDBData junction)]
+sourceInvitationsList forKey = runConduit $ sourceInvitations forKey .| C.foldMap pure
+
+
 data ButtonInvite = BtnInviteAccept | BtnInviteDecline
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Universe ButtonInvite
@@ -268,9 +292,8 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
 
     MsgRenderer mr <- getMsgRenderer
     ur <- getUrlRenderParams
-    let
-      heading = invitationHeading fRec iData
-      explanation = invitationExplanation fRec iData (toHtml . mr) ur
+    heading <- invitationHeading fRec iData
+    let explanation = invitationExplanation fRec iData (toHtml . mr) ur
 
     fmap (, (dataWidget, dataEnctype), heading, explanation) . formResultMaybe dataRes $ \case
       Nothing -> do
@@ -282,6 +305,7 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
         case mResult of
           Nothing -> invalidArgsI [MsgInvitationCollision]
           Just res -> do
+            deleteBy . UniqueInvitation itEmail $ invRef @junction fid
             addMessageI Success =<< invitationSuccessMsg fRec res
             Just <$> invitationUltDest fRec res
 
diff --git a/src/Jobs.hs b/src/Jobs.hs
index 799c1689c..fd0b08c60 100644
--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@@ -59,7 +59,6 @@ import Jobs.Handler.HelpRequest
 import Jobs.Handler.SetLogSettings
 import Jobs.Handler.DistributeCorrections
 import Jobs.Handler.SendCourseCommunication
-import Jobs.Handler.CorrectorInvitation
 import Jobs.Handler.Invitation
 
   
diff --git a/src/Jobs/Handler/CorrectorInvitation.hs b/src/Jobs/Handler/CorrectorInvitation.hs
deleted file mode 100644
index 76e0d26c2..000000000
--- a/src/Jobs/Handler/CorrectorInvitation.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-module Jobs.Handler.CorrectorInvitation
-  ( dispatchJobCorrectorInvitation
-  ) where
-
-import Import
-
-import Text.Hamlet
-
-import qualified Data.HashSet as HashSet
-
-import qualified Data.CaseInsensitive as CI
-
-import Utils.Lens
-
-
-dispatchJobCorrectorInvitation :: UserId -> SheetCorrectorInvitation -> Handler ()
-dispatchJobCorrectorInvitation jInviter jCorrectorInvitation@SheetCorrectorInvitation{..} = do
-  ctx <- runDB . runMaybeT $ do
-    sheet <- MaybeT $ get sheetCorrectorInvitationSheet
-    course <- MaybeT . get $ sheetCourse sheet
-    void . MaybeT $ getByValue jCorrectorInvitation
-    user <- MaybeT $ get jInviter
-    return (sheet, course, user)
-
-  case ctx of
-    Just (Sheet{..}, Course{..}, User{..}) -> do
-      let baseRoute = CSheetR courseTerm courseSchool courseShorthand sheetName $ SCorrInviteR sheetCorrectorInvitationEmail
-      jwt <- encodeToken =<< bearerToken jInviter (Just $ HashSet.singleton baseRoute) Nothing Nothing Nothing
-      let
-        invitationUrl :: SomeRoute UniWorX
-        invitationUrl = SomeRoute (baseRoute, [(toPathPiece GetBearer, toPathPiece jwt)])
-      invitationUrl' <- toTextUrl invitationUrl
-
-      mailT def $ do
-        _mailTo .= [Address Nothing $ CI.original sheetCorrectorInvitationEmail]
-        replaceMailHeader "Reply-To" . Just . renderAddress $ Address (Just userDisplayName) (CI.original userEmail)
-        replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
-        setSubjectI $ MsgMailSubjectCorrectorInvitation courseTerm courseSchool courseShorthand sheetName
-      
-        addPart ($(ihamletFile "templates/mail/correctorInvitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    Nothing -> runDB .
-      deleteBy $ UniqueSheetCorrectorInvitation sheetCorrectorInvitationEmail sheetCorrectorInvitationSheet
diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs
index c5a0aa763..01800048e 100644
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@@ -31,9 +31,6 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
                                       , jSubject :: Maybe Text
                                       , jMailContent :: Html
                                       }
-         | JobCorrectorInvitation { jInviter :: UserId
-                                  , jCorrectorInvitation :: SheetCorrectorInvitation
-                                  }
          | JobInvitation { jInviter :: UserId
                          , jInvitee :: UserEmail
                          , jInvitationUrl :: Text
diff --git a/src/Model.hs b/src/Model.hs
index 6ae0a2f0c..703b78d71 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -41,8 +41,5 @@ deriving instance Eq (Unique Tutorial)
 -- Automatically generated (i.e. numeric) ids are already taken care of
 deriving instance Binary (Key Term)
 
-instance Hashable LecturerInvitation
-instance Hashable SheetCorrectorInvitation
-
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index 52780e335..7a7c6a4db 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -98,8 +98,6 @@ makePrisms ''HandlerContents
 
 makePrisms ''ErrorResponse
 
-makeLenses_ ''SheetCorrectorInvitation
-
 makeLenses_ ''SubmissionMode
 
 makePrisms ''E.Value
diff --git a/templates/sheetCorrInvite.hamlet b/templates/sheetCorrInvite.hamlet
deleted file mode 100644
index 8e51c7358..000000000
--- a/templates/sheetCorrInvite.hamlet
+++ /dev/null
@@ -1,3 +0,0 @@
-<p>
-  _{MsgSheetCorrInviteExplanation}
-^{btnWidget}
diff --git a/templates/tutorial/tutorMassInput/add.hamlet b/templates/tutorial/tutorMassInput/add.hamlet
index cf4cc6e72..bdf6da247 100644
--- a/templates/tutorial/tutorMassInput/add.hamlet
+++ b/templates/tutorial/tutorMassInput/add.hamlet
@@ -1,5 +1,5 @@
 $newline never
-<td>
+<td colspan=2>
   #{csrf}
   ^{fvInput addView}
 <td>
diff --git a/templates/tutorial/tutorMassInput/cellInvitation.hamlet b/templates/tutorial/tutorMassInput/cellInvitation.hamlet
new file mode 100644
index 000000000..27c423ad1
--- /dev/null
+++ b/templates/tutorial/tutorMassInput/cellInvitation.hamlet
@@ -0,0 +1,9 @@
+$newline never
+<td>
+  <span style="font-family: monospace">
+    #{email}
+<td>
+  <div .tooltip>
+    <div .tooltip__handle>
+    <div .tooltip__content>
+      _{MsgEmailInvitationWarning}
diff --git a/templates/tutorial/tutorMassInput/cellKnown.hamlet b/templates/tutorial/tutorMassInput/cellKnown.hamlet
index c6c6cc2ad..5ea4cca6f 100644
--- a/templates/tutorial/tutorMassInput/cellKnown.hamlet
+++ b/templates/tutorial/tutorMassInput/cellKnown.hamlet
@@ -1,3 +1,3 @@
 $newline never
-<td>
+<td colspan=2>
   ^{nameEmailWidget userEmail userDisplayName userSurname}