-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Submission.Helper
  ( submissionHelper
  ) where

import Import

import Jobs

import Handler.Utils
import Handler.Utils.Submission
import Handler.Utils.Invitations

import Handler.Submission.Helper.ArchiveTable

import Data.Maybe (fromJust)

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

import qualified Data.Set as Set
import Data.Map ((!), (!?))
import qualified Data.Map as Map
import qualified Data.Text as Text

import Text.Blaze (Markup)
import qualified Data.Aeson.Types as JSON
import Data.Aeson.Lens

import Handler.Submission.SubmissionUserInvite

import qualified Data.Conduit.Combinators as C


makeSubmissionForm :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m)
                   => CourseId -> SheetId -> Maybe (Entity AuthorshipStatementDefinition) -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId)
                   -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult (Maybe FileUploads, Set (Either UserEmail UserId), Maybe AuthorshipStatementDefinitionId), Widget))
makeSubmissionForm cid shid mASDefinition msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderWForm FormStandard $ do
  uploadRes <- aFormToWForm uploadForm
  submittorsRes <- submittorsForm'
  lecturerIsSubmittor <- case submittorsRes of
    FormSuccess subs -> maybe False ((`Set.member` subs) . Right) <$> maybeAuthId
    _other -> return False
  authorshipStatementRes <- authorshipStatementForm lecturerIsSubmittor
  return $ (,,) <$> uploadRes <*> submittorsRes <*> authorshipStatementRes
  where
    -- TODO(AuthorshipStatements): for lecturer: optionally only invite (co-)submittors instead of adding directly; so they will be forced to make authorship statements
    -- also take care that accepting the invite (optionally) remains possible even after the submission deadline (for creating submissions for course users as a lecturer)
    
    authorshipStatementForm :: Bool -> WForm (ReaderT SqlBackend m) (FormResult (Maybe AuthorshipStatementDefinitionId))
    authorshipStatementForm lecturerIsSubmittor = maybeT (return $ FormSuccess Nothing) $ do
      asd <- hoistMaybe mASDefinition
      let authorshipStatementForm' = apopt (acceptAuthorshipStatementField asd) (fslI MsgSubmissionAuthorshipStatement & setTooltip MsgSubmissionAuthorshipStatementTip) Nothing
      authorshipStatementRes <- lift . hoist (hoist liftHandler) $ if
        | isLecturer
          -> optionalActionW authorshipStatementForm' (fslI MsgSubmissionLecturerAuthorshipStatement & setTooltip MsgSubmissionLecturerAuthorshipStatementTip) (Just False)
        | otherwise
          -> fmap Just <$> aFormToWForm authorshipStatementForm'
      if
        | FormSuccess Nothing <- authorshipStatementRes
        , lecturerIsSubmittor -> formFailure [MsgSubmissionLecturerAuthorshipStatementRequiredBecauseSubmittor]
        | otherwise -> return authorshipStatementRes

    uploadForm :: AForm (ReaderT SqlBackend m) (Maybe FileUploads)
    uploadForm = hoistAForm liftHandler $ if
      | is _NoUpload uploadMode -> pure Nothing
      | is _Nothing msmid -> uploadForm'
      | otherwise -> join <$> optionalActionNegatedA uploadForm' (fslI MsgSubmissionFilesUnchanged & setTooltip MsgSubmissionFilesUnchangedTip) (Just False)

    uploadForm' = fileUploadForm (not isLecturer) (fslI . bool MsgSubmissionFile MsgSubmissionArchive) uploadMode mPrev
    
    miCell' :: Markup -> Either UserEmail UserId -> Widget
    miCell' csrf (Left email) = do
      invWarnMsg <- messageIconI Info IconEmail $ if
        | isLecturer -> MsgEmailInvitationWarningCourseParticipants
        | otherwise  -> MsgEmailInvitationWarningPrevCoSubmittors
      $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
    miCell' csrf (Right uid) = do
      (usr, hasSubmitted) <- liftHandler . runDB $ do
        user <- getJust uid
        hasSubmitted <- E.selectExists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
          E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
          E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
               E.&&. submission E.^. SubmissionSheet E.==. E.val shid
          whenIsJust msmid $ \smid -> 
            E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
        return (user, hasSubmitted)
      knownWarning <- runMaybeT $
        guardOnM hasSubmitted $ messageIconI Error IconSubmissionUserDuplicate MsgSubmissionUserDuplicateWarning
      $(widgetFile "widgets/massinput/submissionUsers/cellKnown")

    miLayout :: ListLength
             -> Map ListPosition (Either UserEmail UserId, FormResult ()) -- ^ massInput state
             -> Map ListPosition Widget -- ^ Cell widgets
             -> Map ListPosition (FieldView UniWorX) -- ^ Deletion buttons
             -> Map (Natural, ListPosition) Widget -- ^ Addition widgets
             -> Widget
    miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/submissionUsers/layout")

    miIdent :: Text
    miIdent = "submittors"

    courseUsers :: E.SqlQuery (E.SqlExpr (Entity User))
    courseUsers = E.from $ \(user `E.InnerJoin` participant) -> do
      E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
      E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
           E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      E.orderBy [E.asc $ user E.^. UserEmail]
      return user
    previousCoSubmittors :: UserId -> E.SqlQuery (E.SqlExpr (Entity User))
    previousCoSubmittors uid = E.from $ \(user `E.InnerJoin` submissionUser `E.InnerJoin` submission `E.InnerJoin` sheet) -> do
      E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
       E.&&. sheet E.^. SheetCourse E.==. E.val cid
      E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
      E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
      E.where_ . E.exists . E.from $ \submissionUser' ->
        E.where_ $ submissionUser' E.^. SubmissionUserUser E.==. E.val uid
             E.&&. submissionUser' E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
      E.where_ . E.exists . E.from $ \participant ->
        E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
             E.&&. participant E.^. CourseParticipantUser E.==. user E.^. UserId
             E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      E.orderBy [E.asc $ user E.^. UserEmail]
      return user

    addField :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => UserId -> Field m' (Set (Either UserEmail UserId))
    addField uid = multiUserInvitationField . MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationPrevCoSubmittors) $ previousCoSubmittors uid
    addFieldLecturer, addFieldAuthorshipStatements :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Field m' (Set (Either UserEmail UserId))
    addFieldLecturer = multiUserInvitationField $ MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationCourseParticipants) courseUsers
    addFieldAuthorshipStatements = multiUserInvitationField MUIAlwaysInvite

    addFieldSettings :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> FieldSettings UniWorX
    addFieldSettings mr = fslpI MsgSubmissionMembers $ mr MsgLdapIdentificationOrEmail
    submittorSettings, singleSubSettings :: FieldSettings UniWorX
    submittorSettings = fslI MsgSubmissionMembers
    singleSubSettings = fslI MsgSubmissionMember

    maxSize | Arbitrary{..} <- grouping = Just maxParticipants
            | otherwise = Nothing
    mayEdit = is _Arbitrary grouping

    submittorSettings'
      | maxSize > Just 1 = submittorSettings
      | otherwise        = singleSubSettings

    miButtonAction' :: forall p. PathPiece p => Maybe (Route UniWorX) -> p -> Maybe (SomeRoute UniWorX)
    miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag)

    submittorsForm' :: WForm (ReaderT SqlBackend m) (FormResult (Set (Either UserEmail UserId)))
    submittorsForm' = maybeT submittorsForm $ do
      restr <- MaybeT (liftHandler $ maybeCurrentBearerRestrictions @Value) >>= hoistMaybe . preview (_Object . ix "submittors" . _Array)
      let _Submittor = prism (either toJSON toJSON) $ \x -> first (const x) $ JSON.parseEither (\x' -> fmap Right (parseJSON x') <|> fmap Left (parseJSON x')) x
      submittors <- fmap (pure @FormResult @[Either UserEmail CryptoUUIDUser]) . forM (toList restr) $ hoistMaybe . preview _Submittor
      fmap Set.fromList <$> forMOf (traverse . traverse . _Right) submittors decrypt


    submittorsForm :: WForm (ReaderT SqlBackend m) (FormResult (Set (Either UserEmail UserId)))
    submittorsForm
      | isLecturer = do -- Form is being used by lecturer; allow Everything™
        let
          miAdd :: (Text -> Text) -> FieldView UniWorX -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]), Widget))
          miAdd nudge btn csrf = do
            MsgRenderer mr <- getMsgRenderer
            (addRes, addView) <- mpreq addFieldLecturer (addFieldSettings mr & addName (nudge "emails")) Nothing
            let addRes' = addRes <&> \newData oldData -> if
                  | existing <- newData `Set.intersection` Set.fromList oldData
                  , not $ Set.null existing
                    -> FormFailure [mr MsgSubmissionUserAlreadyAdded]
                  | otherwise
                    -> FormSuccess $ Set.toList newData
            return (addRes', $(widgetFile "widgets/massinput/submissionUsers/add"))

        mRoute <- getCurrentRoute
        submittors <- massInputAccumW miAdd (miCell' mempty) (miButtonAction' mRoute) miLayout miIdent submittorSettings True (Just $ Set.toList prefillUsers)
        MsgRenderer mr <- getMsgRenderer
        return $ submittors >>= \submittors' -> if
          | null submittors' -> FormFailure [mr MsgSubmissionUsersEmpty]
          | otherwise -> FormSuccess $ Set.fromList submittors'
      | otherwise = do
        uid <- liftHandler requireAuthId
        mRoute <- getCurrentRoute
        let doAuthorshipStatements = is _Just mASDefinition

        prefillUsers' <- lift . lift . fmap catMaybes . for (Set.toList prefillUsers) $ \case
          Right uid' | doAuthorshipStatements
                     , uid /= uid'
                       -> fmap (Left . userEmail) <$> get uid'
          other -> return $ pure other

        let
          miAdd :: ListPosition
                -> Natural
                -> ListLength
                -> (Text -> Text)
                -> FieldView UniWorX
                -> Maybe (Markup -> MForm (ReaderT SqlBackend m) (FormResult (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))), Widget))
          miAdd dim pos liveliness nudge btn = guardOn (miAllowAdd dim pos liveliness) $ \csrf -> do
            MsgRenderer mr <- getMsgRenderer
            (addRes, addView) <- if
              | doAuthorshipStatements
                -> mpreq addFieldAuthorshipStatements (addFieldSettings mr & addName (nudge "emails") & setTooltip MsgSubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements) Nothing
              | otherwise
                -> mpreq (addField uid) (addFieldSettings mr & addName (nudge "emails")) Nothing
            let addRes' = addRes <&> \newData oldData -> if
                  | existing <- newData `Set.intersection` setOf folded oldData
                  , not $ Set.null existing
                    -> FormFailure [mr MsgSubmissionUserAlreadyAdded]
                  | otherwise -> let numStart = maybe 0 (succ . fst) $ Map.lookupMax oldData
                                  in FormSuccess . Map.fromList . zip [numStart..] $ Set.toList newData
            return (addRes', $(widgetFile "widgets/massinput/submissionUsers/add"))

          miCell :: ListPosition
                 -> Either UserEmail UserId
                 -> Maybe ()
                 -> (Text -> Text)
                 -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult (), Widget))
          miCell _ dat _ _ csrf = return (FormSuccess (), miCell' csrf dat)

          miDelete :: Map ListPosition (Either UserEmail UserId)
                   -> ListPosition
                   -> MaybeT (MForm (ReaderT SqlBackend m)) (Map ListPosition ListPosition)
          miDelete dat delPos = do
            guard mayEdit
            guard $ Map.size dat > 1

            -- User may drop from submission only if it already exists; no directly creating submissions for other people
            guard $ Just (Right uid) /= dat !? delPos || isJust msmid

            miDeleteList dat delPos

          miAllowAdd :: ListPosition
                     -> Natural
                     -> ListLength
                     -> Bool
          miAllowAdd _ _ l = mayEdit && maybe False ((l <) . fromIntegral) maxSize

          miAddEmpty _ _ _ = Set.empty

          miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
          miButtonAction = miButtonAction' mRoute

          postProcess :: Map ListPosition (Either UserEmail UserId, ()) -> Set (Either UserEmail UserId)
          postProcess valMap
            | is _Just msmid
            , resultUsers == prefillUsers
            = resultUsers
            | Just maxSize' <- maxSize
            , fromIntegral maxSize' >= Set.size resultUsers
            = resultUsers
            | Just maxSize' <- maxSize
            = let resultUsers' = Set.take (fromIntegral maxSize') resultUsers
               in if | Set.member (Right uid) resultUsers' -> resultUsers'
                     | otherwise -> Set.insert (Right uid) $ Set.take (pred $ fromIntegral maxSize') resultUsers'
            | otherwise = Set.singleton $ Right uid
            where resultUsers = setOf (folded . _1) valMap
        -- when (maxSize > Just 1) $
        --   wformMessage =<< messageI Info MsgCosubmittorTip
        fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ prefillUsers')

submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe CryptoFileNameSubmission -> Handler Html
submissionHelper tid ssh csh shn mcid = do
  muid <- maybeAuthId
  msmid     <- traverse decrypt mcid
  actionUrl <- fromMaybe (error "submissionHelper called from 404-handler") <$> getCurrentRoute

  let
    getSheetInfo = do
      csheet@(Entity shid Sheet{..})  <- fetchSheet tid ssh csh shn
      mASDefinition <- getSheetAuthorshipStatement csheet
      maySubmit  <- (== Authorized) <$> evalAccessDB actionUrl True
      isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True

      case (msmid, sheetGrouping) of
        (Nothing, Arbitrary maxBuddies) -> do
          -- fetch buddies from previous submission in this course
          buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
            E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
            let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` subUser `E.InnerJoin` submissionEdit) -> do
                  E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId)
                  E.on (subUser        E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId)
                  E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet)
                  E.where_ $ E.just (subUser E.^. SubmissionUserUser) E.==. E.val muid
                        E.&&. sheet   E.^.        SheetCourse E.==. E.val sheetCourse
                  E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
                  E.limit 1
                  return $ submission E.^. SubmissionId
            E.where_ $  submissionUser E.^. SubmissionUserSubmission `E.in_` oldids
                  E.&&. E.just (submissionUser E.^. SubmissionUserUser) E.!=. E.val muid
            E.orderBy  [E.asc $ user E.^. UserEmail]
            return $ user E.^. UserId
          return ( csheet
                 , buddies
                   & map (Right . E.unValue)
                   & Set.fromList
                   & assertM' ((<= maxBuddies) . fromIntegral . Set.size . bool id (maybe id (Set.insert . Right) muid) (not isLecturer))
                   & fromMaybe Set.empty
                 , []
                 , maySubmit
                 , isLecturer
                 , not isLecturer
                 , Nothing, Nothing
                 , mASDefinition
                 )
        (Nothing, RegisteredGroups) -> do
          buddies <- E.select . E.from $ \(submissionGroup `E.InnerJoin` user) -> do
            E.on . E.exists . E.from $ \submissionGroupUser ->
              E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. user E.^. UserId
                   E.&&. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
            E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val sheetCourse
            E.where_ . E.exists . E.from $ \submissionGroupUser ->
              E.where_ $ E.just (submissionGroupUser E.^. SubmissionGroupUserUser) E.==. E.val muid
                   E.&&. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
            E.where_ $ E.just (user E.^. UserId) E.!=. E.val muid
            E.where_ . E.not_ . E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
              E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
              E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
                   E.&&. submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId

            E.orderBy [E.asc $ user E.^. UserEmail]

            return $ user E.^. UserId

          return ( csheet
                 , buddies
                   & map (Right . E.unValue)
                   & Set.fromList
                 , []
                 , maySubmit
                 , isLecturer
                 , not isLecturer
                 , Nothing, Nothing
                 , mASDefinition
                 )
        (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer, Nothing, Nothing, mASDefinition)
        (Just smid, _) -> do
          void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)

          sub@Submission{..} <- get404 smid
          let shid' = submissionSheet
          unless (shid == shid') $
            invalidArgsI [MsgSubmissionWrongSheet]
          -- fetch buddies from current submission
          (Any isOwner, buddies) <- do
            submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
              E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
              E.where_ $  submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
              E.orderBy  [E.asc $ user E.^. UserEmail]
              return $ user E.^. UserId
            let breakUserFromBuddies (E.Value userID)
                  | muid == Just userID =  (Any True , mempty                      )
                  | otherwise           =  (mempty   , Set.singleton $ Right userID)

            invites <- sourceInvitationsF smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email)

            return . over _2 (Set.union invites) $ foldMap breakUserFromBuddies submittors

          lastEdits <- do
              raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
                E.on $ E.just (user E.^. UserId) E.==. submissionEdit E.^. SubmissionEditUser
                E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
                E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
                -- E.limit numberOfSubmissionEditDates -- DEPRECATED we always show all edit times
                let userName = if isOwner || maySubmit
                                then E.just $ user E.^. UserDisplayName
                                else E.nothing
                return (userName, submissionEdit E.^. SubmissionEditTime)
              forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time

          corrector <- join <$> traverse getEntity submissionRatingBy

          return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner,Just sub,corrector,mASDefinition)

  -- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...)
  -- Therefore we do not restrict upload behaviour in any way in that case
  ((formWidget', formEnctype), mAct) <- runDBJobs . setSerializable $ do
    (Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- hoist lift getSheetInfo
    let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1)
    ((res, formWidget'), formEnctype) <- hoist lift . runFormPost . makeSubmissionForm sheetCourse shid mASDefinition msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies

    -- Calling `msgSubmissionErrors` within a `runDB` is okay as long as we handle `transactionUndo` ourselves iff it returns nothing
    mAct' <- msgSubmissionErrors $ do
      submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
        E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
        E.where_ $ E.just (submissionUser E.^. SubmissionUserUser) E.==. E.val muid
             E.&&. submission     E.^. SubmissionSheet    E.==. E.val shid
        return $ submission E.^. SubmissionId
      case (msmid, submissions) of
        (Nothing, E.Value smid : _) -> do
          cID <- encrypt smid
          addMessageI Info MsgSubmissionAlreadyExists
          redirect $ CSubmissionR tid ssh csh shn cID SubShowR
        _other -> return ()

      when (    is _Nothing muid
             && is _Nothing msubmission
             && not isLecturer
           )
        notAuthenticated

      -- Determine old submission users
      subUsersOld <- if
        | Just smid <- msmid -> Set.union
            <$> (setOf (folded . _entityVal . _submissionUserUser . to Right) <$> selectList [SubmissionUserSubmission ==. smid] [])
            <*> (sourceInvitationsF smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email))
        | otherwise -> return Set.empty

      res' <- case res of
        FormMissing              -> return   FormMissing
        (FormFailure failmsgs)   -> return $ FormFailure failmsgs
        (FormSuccess res'@(_, groupMembers, _))
          | groupMembers == subUsersOld -> return $ FormSuccess res'
          | isLecturer -> return $ FormSuccess res'
          | Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members
            let (gEMails, gIds) = partitionEithers $ Set.toList groupMembers
                prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map UserEmail (Maybe (UserId, Bool, Bool))
                prep ps = Map.fromList $ map (, Nothing) gEMails ++ [(m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
            participants <- fmap prep . E.select . E.from $ \user -> do
              E.where_ $ (user E.^. UserId) `E.in_` E.valList gIds
              let
                isParticipant = E.exists . E.from $ \courseParticipant -> do
                  E.where_ $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
                       E.&&. courseParticipant E.^. CourseParticipantCourse E.==. E.val sheetCourse
                hasSubmitted = E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
                  E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
                  E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
                       E.&&. submission E.^. SubmissionSheet E.==. E.val shid
                  case msmid of -- Multiple `E.where_`-Statements are merged with `&&` in esqueleto 2.5.3
                    Nothing   -> return ()
                    Just smid -> E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
              return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted))

            $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants

            mr <- getMessageRender
            let
              failmsgs = (concat :: [[Text]] -> [Text])
                [ flip Map.foldMapWithKey participants $ \email -> \case
                    -- Nothing            -> pure . mr $ MsgEMailUnknown email
                    (Just (_,False,_)) -> pure . mr $ MsgNotAParticipant email tid csh
                    (Just (_,_, True)) -> pure . mr $ MsgSubmissionAlreadyExistsFor email
                    _other             -> mempty
                , case fromIntegral (Map.size participants) `compare` maxParticipants of
                    GT | not isLecturer -> pure $ mr MsgTooManyParticipants
                    _ -> mempty
                ]
            return $ if null failmsgs
              then FormSuccess res'
              else FormFailure failmsgs
          | otherwise -> return $ FormSuccess res'


      formResultMaybe res' $ \(mFiles, adhocMembers, mASDId) -> do
        now <- liftIO getCurrentTime

        smid <- case (mFiles, msmid) of
          (Nothing, Just smid)   -- no new files, existing submission partners updated
            -> return smid
          (Just files, _) -> -- new files
            runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkSubmission muid (maybe (Left shid) Right msmid) False
          (Nothing, Nothing) -- new submission, no file upload requested
            -> do
              sid <- insert Submission
                { submissionSheet = shid
                , submissionRatingPoints   = Nothing
                , submissionRatingComment  = Nothing
                , submissionRatingBy       = Nothing
                , submissionRatingAssigned = Nothing
                , submissionRatingTime     = Nothing
                }
              audit $ TransactionSubmissionEdit sid shid

              insert_ $ SubmissionEdit muid now sid

              return sid

        -- Determine new submission users
        subUsers <- if
          | isLecturer -> return adhocMembers
          | RegisteredGroups <- sheetGrouping -> do
              -- Determine members of pre-registered group
              groupUids <- fmap (setFromList . map (Right . E.unValue)) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
                E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup
                E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
                E.where_ $ E.just (submissionGroupUser E.^. SubmissionGroupUserUser) E.==. E.val muid
                    E.&&.  submissionGroup     E.^. SubmissionGroupCourse   E.==. E.val sheetCourse

                E.where_ . E.not_ . E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
                  E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
                  E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
                       E.&&. submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser' E.^. SubmissionGroupUserUser
                  E.where_ $ submission E.^. SubmissionId E.!=. E.val smid

                return $ submissionGroupUser' E.^. SubmissionGroupUserUser
              -- SubmissionUser for all group members (pre-registered & ad-hoc)
              return $ maybe id (Set.insert . Right) muid groupUids
          | otherwise -> return adhocMembers

        -- Since invitations carry no data we only need to consider changes to
        -- the set of users/invited emails
        -- Otherwise we would have to update old invitations (via
        -- `sinkInvitationsF`) because their associated @DBData@ might have
        -- changed

        forM_ (subUsers `setSymmDiff` subUsersOld) $ \change -> if
          -- change is a new user being added to the submission users => send invitation / insert
          | change `Set.member` subUsers -> case change of
            Left subEmail -> do
              -- user does not exist yet => send invitation
              sinkInvitationsF submissionUserInvitationConfig [(subEmail, smid, (InvDBDataSubmissionUser, InvTokenDataSubmissionUser))]
              return ()
            Right subUid -> do
              -- user exists and has an id => insert as SubmissionUser and audit
              insert_ $ SubmissionUser subUid smid
              audit $ TransactionSubmissionUserEdit smid subUid
              unless (Just subUid == muid) $
                queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated subUid smid
          -- change is an old user that is not a submission user anymore => delete invitation / delete
          | otherwise -> case change of
            Left subEmail -> deleteInvitation @SubmissionUser smid subEmail
            Right subUid  -> do
              deleteBy $ UniqueSubmissionUser subUid smid
              audit $ TransactionSubmissionUserDelete smid subUid
              unless (Just subUid == muid) $
                queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid

        hasAuthorshipStatement <- maybeT (return True) $ do
          uid <- hoistMaybe muid
          asDId <- hoistMaybe mASDId
          lift $ exists [AuthorshipStatementSubmissionStatement ==. asDId, AuthorshipStatementSubmissionSubmission ==. smid, AuthorshipStatementSubmissionUser ==. uid]
  
        forM_ mASDId $ \asdId -> do
          uid <- maybe notAuthenticated return muid
          insert_ $ AuthorshipStatementSubmission asdId smid uid now


        if | is _Nothing msmid          -> addMessageI Success MsgSubmissionCreated
           | is _Just mFiles            -> addMessageI Success MsgSubmissionUpdated
           | subUsers == subUsersOld
           , not hasAuthorshipStatement -> addMessageI Success MsgSubmissionUpdatedAuthorshipStatement
           | subUsers == subUsersOld    -> addMessageI Info    MsgSubmissionUnchanged
           | otherwise                  -> addMessageI Success MsgSubmissionUsersUpdated

        cID <- encrypt smid
        let showRoute = CSubmissionR tid ssh csh shn cID SubShowR
        mayShow <- hoist lift $ hasReadAccessTo showRoute

        return . Just $ if
          | mayShow   -> redirect showRoute
          | otherwise -> redirect $ CSheetR tid ssh csh shn SShowR

    case mAct' of
      Nothing -> ((formWidget', formEnctype), Nothing) <$ E.transactionUndo -- manual rollback because we are calling `msgSubmissionErrors` within a `runDB`
      Just mAct -> return ((formWidget', formEnctype), mAct)

  sequence_ mAct
  let formWidget = wrapForm' BtnHandIn formWidget' def
        { formAction = Just $ SomeRoute actionUrl
        , formEncoding = formEnctype
        }

  ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector, _), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, (subUsers, subUsersVisible), isLecturer, isOwner, doAuthorshipStatements) <- runDB $ do
    sheetInfo@(Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- getSheetInfo

    (showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> do
      showCorrection <- hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
      correctionInvisible <- correctionInvisibleWidget tid ssh csh shn cid subEnt

      return (showCorrection, correctionInvisible)

    -- Maybe construct a table to display uploaded archive files
    mFileTable' <- for msmid $ mkSubmissionArchiveTable tid ssh csh shn showCorrection
    let filesCorrected = maybe False (view _1) mFileTable'
        mFileTable = view _2 <$> mFileTable'

    sheetTypeDesc <- sheetTypeDescription sheetCourse sheetType

    multipleSubmissionWarnWidget <- runMaybeT $ do
      subId <- hoistMaybe msmid
      cID <- hoistMaybe mcid
      guardM . lift $ orM
        [ hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubDelR
        , hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubShowR
        , hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
        , hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
        ]
      guardM . lift . E.selectExists . E.from $ \(submissionUser `E.InnerJoin` (otherSubmissionUser `E.InnerJoin` submission)) -> do
        E.on $ otherSubmissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
        E.on $ submissionUser E.^. SubmissionUserSubmission E.!=. otherSubmissionUser E.^. SubmissionUserSubmission
         E.&&. submissionUser E.^. SubmissionUserUser E.==. otherSubmissionUser E.^. SubmissionUserUser
        E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
             E.&&. submission E.^. SubmissionId E.!=. E.val subId
             E.&&. submissionUser E.^. SubmissionUserSubmission E.==. E.val subId
      return $ notification NotificationBroad =<< messageIconI Warning IconSubmissionUserDuplicate MsgSubmissionSomeUsersDuplicateWarning

    subUsers <- maybeT (return []) $ do
      subId <- hoistMaybe msmid
      lift $ buddies
        & bool id (maybe id (Set.insert . Right) muid) isOwner
        & Set.toList
        & mapMOf (traverse . _Right) (\uid -> (,,) <$> (encrypt uid :: DB CryptoUUIDUser) <*> getJust uid <*> getUserAuthorshipStatement mASDefinition subId uid)
        & fmap (sortOn . over _Right $ (,,,) <$> views _2 userSurname <*> views _2 userDisplayName <*> views _2 userEmail <*> view _1)

    subUsersVisible <- orM
      [ return isOwner
      , return isLecturer
      , return $ not sheetAnonymousCorrection
      , hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
      ]

    return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, (subUsers, subUsersVisible), isLecturer, isOwner, is _Just mASDefinition)

  -- TODO(AuthorshipStatements): discuss whether to display prompt for user to update their authorship statement, if lecturer changed it

  let (title, heading)
        | Just cID <- mcid, maySubmit, not isLecturer || isOwner = (MsgSubmissionTitle tid ssh csh shn cID, MsgSubmissionHeadingEdit tid ssh csh shn cID)
        | Just cID <- mcid = (MsgSubmissionTitle tid ssh csh shn cID, MsgSubmissionHeadingShow tid ssh csh shn cID)
        | otherwise = (MsgSubmissionTitleNew tid ssh csh shn, MsgSubmissionHeadingNew tid ssh csh shn)
  
  siteLayoutMsg heading $ do
    setTitleI title
    (urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID
      -> let mkUrl sft = toTextUrl . CSubmissionR tid ssh csh shn cID $ SubArchiveR sft
          in liftHandler . runDB $ (,) <$> mkUrl SubmissionCorrected <*> mkUrl SubmissionOriginal
    tr <- getTranslate
    let correctionWdgt = guardOnM (showCorrection && maybe False submissionRatingTouched msubmission) ((,) <$> msubmission <*> mcid) <&> \(Submission{..}, cid) ->
          let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment
           in $(widgetFile "correction-user")
          where submissionRatingTouched sub@Submission{..} = or
                  [ submissionRatingDone sub
                  , is _Just submissionRatingPoints, is _Just submissionRatingComment
                  ]
        correctionVisibleWarnWidget = guardOnM (is _Just msubmission && is _Just mcid && showCorrection) correctionInvisible
        asStatusExplain = $(i18nWidgetFiles "authorship-statement-submission-explanation")
        asStatuses = setOf (folded . _Right . _3) subUsers
          & Set.union (Set.fromList [ASExists, ASMissing])
          & Set.toList
          & mapMaybe (\stmt -> (stmt, ) <$> asStatusExplain Map.!? toPathPiece stmt)
        asStatusExplainWdgt = $(widgetFile "widgets/authorship-statement-submission-explanation")
    $(widgetFile "submission")
