{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.Submission where

import Import

import Jobs

import Utils.Lens

-- import Yesod.Form.Bootstrap3

import Handler.Utils
import Handler.Utils.Delete
import Handler.Utils.Submission
import Handler.Utils.Table.Cells
import Handler.Utils.Invitations

-- import Control.Monad.Trans.Maybe
-- import Control.Monad.State.Class
-- import Control.Monad.Trans.State.Strict (StateT)

import Data.Monoid (Any(..))
import Data.Maybe (fromJust)
-- import qualified Data.Maybe
import qualified Data.Text.Encoding as Text

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E (unsafeSqlFunction)

import qualified Data.Conduit.List as Conduit
-- import Data.Conduit.ResumableSink

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

import Text.Blaze (Markup)
import Data.Aeson hiding (Result(..))
import Text.Hamlet (ihamlet)

-- import Colonnade hiding (bool, fromMaybe)
-- import qualified Yesod.Colonnade as Yesod
-- import qualified Text.Blaze.Html5.Attributes as HA

-- DEPRECATED: We always show all edits!
-- numberOfSubmissionEditDates :: Int64
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.


instance IsInvitableJunction SubmissionUser where
  type InvitationFor SubmissionUser = Submission
  data InvitableJunction SubmissionUser = JunctionSubmissionUser
    deriving (Eq, Ord, Read, Show, Generic, Typeable)
  data InvitationDBData SubmissionUser = InvDBDataSubmissionUser
    deriving (Eq, Ord, Read, Show, Generic, Typeable)
  data InvitationTokenData SubmissionUser = InvTokenDataSubmissionUser
    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _InvitableJunction = iso
    (\SubmissionUser{..} -> (submissionUserUser, submissionUserSubmission, JunctionSubmissionUser))
    (\(submissionUserUser, submissionUserSubmission, JunctionSubmissionUser) -> SubmissionUser{..})

instance ToJSON (InvitableJunction SubmissionUser) where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
instance FromJSON (InvitableJunction SubmissionUser) where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }

instance ToJSON (InvitationDBData SubmissionUser) where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
instance FromJSON (InvitationDBData SubmissionUser) where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }

instance ToJSON (InvitationTokenData SubmissionUser) where
  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
instance FromJSON (InvitationTokenData SubmissionUser) where
  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }

submissionUserInvitationConfig :: InvitationConfig SubmissionUser
submissionUserInvitationConfig = InvitationConfig{..}
  where
    invitationRoute (Entity subId Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      Course{..} <- getJust sheetCourse
      cID <- encrypt subId
      return $ CSubmissionR courseTerm courseSchool courseShorthand sheetName cID SInviteR
    invitationResolveFor = do
      Just (CSubmissionR _tid _ssh _csh _shn cID SInviteR) <- getCurrentRoute
      subId <- decrypt cID
      bool notFound (return subId) =<< existsKey subId
    invitationSubject (Entity _ Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      Course{..} <- getJust sheetCourse
      return . SomeMessage $ MsgMailSubjectSubmissionUserInvitation courseTerm courseSchool courseShorthand sheetName
    invitationHeading (Entity _ Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      return . SomeMessage $ MsgSubmissionUserInviteHeading sheetName
    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSubmissionUserInviteExplanation}|]
    invitationTokenConfig (Entity _ Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      Course{..} <- getJust sheetCourse
      itAuthority <- liftHandlerT requireAuthId
      itAddAuth <- either throwM (return . Just) $ routeAuthTags (CSheetR courseTerm courseSchool courseShorthand sheetName SubmissionNewR)
      let itExpiresAt = Nothing
          itStartsAt = Nothing
      return InvitationTokenConfig{..}
    invitationRestriction _ _ = return Authorized
    invitationForm _ _ _ = pure (JunctionSubmissionUser, ())
    invitationInsertHook _ _ _ _ = id
    invitationSuccessMsg (Entity _ Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      return . SomeMessage $ MsgSubmissionUserInvitationAccepted sheetName
    invitationUltDest (Entity subId Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      Course{..} <- getJust sheetCourse
      cID <- encrypt subId
      return . SomeRoute $ CSubmissionR courseTerm courseSchool courseShorthand sheetName cID SubShowR


makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe (Source Handler File), Set (Either UserEmail UserId))
makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
  <$> fileUploadForm
  <*> wFormToAForm submittorsForm
  where
    fileUploadForm = case uploadMode of
      NoUpload
        -> pure Nothing
      UploadAny{..}
        -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips extensionRestriction) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
      UploadSpecific{..}
        -> mergeFileSources <$> sequenceA (map specificFileForm . Set.toList $ toNullable specificFiles)

    specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe (Source Handler File))
    specificFileForm spec@UploadSpecificFile{..}
      = bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) specificFileRequired (specificFileField spec) (fsl specificFileLabel) Nothing

    mergeFileSources :: [Maybe (Source Handler File)] -> Maybe (Source Handler File)
    mergeFileSources (catMaybes -> sources) = case sources of
      [] -> Nothing
      fs -> Just $ sequence_ fs

    miCell' :: Markup -> Either UserEmail UserId -> Widget
    miCell' csrf (Left email) = $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
    miCell' csrf (Right uid) = do
      User{..} <- liftHandlerT . runDB $ getJust uid
      $(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.orderBy [E.asc $ user E.^. UserEmail]
      return user

    addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Bool -> Field m (Set (Either UserEmail UserId))
    addField isAdmin = multiUserField True $ courseUsers <$ guard isAdmin

    addFieldSettings, submittorSettings, singleSubSettings :: FieldSettings UniWorX
    addFieldSettings  = fslI MsgSubmissionMembers
    submittorSettings = fslI MsgSubmissionMembers & setTooltip MsgMassInputTip
    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
      | isLecturer = do-- Form is being used by lecturer; allow Everything™
        let
          miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
          miAdd nudge btn csrf = do
            MsgRenderer mr <- getMsgRenderer
            (addRes, addView) <- mpreq (addField True) (addFieldSettings & 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 <- liftHandlerT requireAuthId
        mRoute <- getCurrentRoute

        let
          miAdd :: ListPosition
                -> Natural
                -> (Text -> Text)
                -> FieldView UniWorX
                -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
          miAdd _ _ nudge btn = Just $ \csrf -> do
            MsgRenderer mr <- getMsgRenderer
            (addRes, addView) <- mpreq (addField True) (addFieldSettings & 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)
                 -> Form ()
          miCell _ dat _ _ csrf = return (FormSuccess (), miCell' csrf dat)

          miDelete :: Map ListPosition (Either UserEmail UserId)
                   -> ListPosition
                   -> MaybeT (MForm Handler) (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 $ maybe True (/= 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 = setOf $ folded . _1
        fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers)


getSubmissionNewR, postSubmissionNewR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSubmissionNewR = postSubmissionNewR
postSubmissionNewR tid ssh csh shn = submissionHelper tid ssh csh shn Nothing


getSubShowR, postSubShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSubShowR = postSubShowR
postSubShowR tid ssh csh shn cid = submissionHelper tid ssh csh shn $ Just cid

getSubmissionOwnR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSubmissionOwnR tid ssh csh shn = do
  authId <- requireAuthId
  sid <- runDB $ do
    shid <- fetchSheetId tid ssh csh shn
    submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
      E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
      E.where_ $ submissionUser E.^. SubmissionUserUser   E.==. E.val authId
           E.&&. submission     E.^. SubmissionSheet    E.==. E.val shid
      return $ submission E.^. SubmissionId
    case submissions of
      (E.Value sid : _) -> return sid
      []      -> notFound
  cID <- encrypt sid
  redirect $ CSubmissionR tid ssh csh shn cID SubShowR

submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe CryptoFileNameSubmission -> Handler Html
submissionHelper tid ssh csh shn mcid = do
  uid <- requireAuthId
  msmid     <- traverse decrypt mcid
  Just actionUrl <- getCurrentRoute

  (Entity shid Sheet{..}, buddies, lastEdits, maySubmit, isLecturer, isOwner)  <- runDB $ do
    csheet@(Entity shid Sheet{..})  <- fetchSheet tid ssh csh shn
    maySubmit  <- (== Authorized) <$> evalAccessDB actionUrl True
    isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True
    case msmid of
      Nothing     -> do
        submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
          E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
          E.where_ $ submissionUser E.^. SubmissionUserUser   E.==. E.val uid
               E.&&. submission     E.^. SubmissionSheet    E.==. E.val shid
          return $ submission E.^. SubmissionId
        -- logDebugS "Submission.DUPLICATENEW" (tshow submissions)
        case submissions of
          []    -> 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_ $  subUser E.^. SubmissionUserUser E.==. E.val uid
                          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.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
              E.orderBy  [E.asc $ user E.^. UserEmail]
              return $ user E.^. UserId
            return (csheet, Set.fromList $ map (Right . E.unValue) buddies, [], maySubmit, isLecturer, not isLecturer)
          (E.Value smid:_) -> do
            cID <- encrypt smid
            addMessageI Info MsgSubmissionAlreadyExists
            redirect $ CSubmissionR tid ssh csh shn cID SubShowR
      (Just smid) -> do
        void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)

        shid' <- submissionSheet <$> get404 smid
        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)
                | uid == userID  =  (Any True , mempty                      )
                | otherwise      =  (mempty   , Set.singleton $ Right userID)

          invites <- sourceInvitationsList 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 (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
        return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner)
  -- @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
  ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies
  let formWidget = wrapForm' BtnHandIn formWidget' def
        { formAction = Just $ SomeRoute actionUrl
        , formEncoding = formEnctype
        }

  mCID <- fmap join . msgSubmissionErrors . runDBJobs $ do
    res' <- case res of
      FormMissing              -> return   FormMissing
      (FormFailure failmsgs)   -> return $ FormFailure failmsgs
      -- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
      (FormSuccess res'@(_, groupMembers))
        | Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members
          -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
          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.filter (maybe True $ \(i,_,_) -> i /= uid) . 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
                  LT -> mempty
                  _  -> pure $ mr MsgTooManyParticipants
              ]
          return $ if null failmsgs
            then FormSuccess res'
            else FormFailure failmsgs
        | otherwise -> return $ FormSuccess res'


    case res' of
      (FormSuccess (mFiles, adhocMembers)) -> do
        smid <- do
          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 uid (maybe (Left shid) Right msmid) False
            (Nothing, Nothing) -- new submission, no file upload requested
              -> insert Submission
                  { submissionSheet = shid
                  , submissionRatingPoints   = Nothing
                  , submissionRatingComment  = Nothing
                  , submissionRatingBy       = Nothing
                  , submissionRatingAssigned = Nothing
                  , submissionRatingTime     = Nothing
                  }
          subUsers <- if
            | isLecturer -> return adhocMembers
            | otherwise -> 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_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
                      E.&&.  submissionGroup     E.^. SubmissionGroupCourse   E.==. E.val sheetCourse
                  return $ submissionGroupUser' E.^. SubmissionGroupUserUser
                -- SubmissionUser for all group members (pre-registered & ad-hoc)
                return $ groupUids `Set.union` adhocMembers
          let (subEmails, subUids) = partitionEithers $ Set.toList subUsers

          deleteWhere [SubmissionUserSubmission ==. smid]
          deleteWhere [InvitationFor ==. invRef @SubmissionUser smid, InvitationEmail /<-. subEmails]
          insertMany_ $ map (flip SubmissionUser smid) subUids
          sinkInvitationsF submissionUserInvitationConfig $ map (\lEmail -> (lEmail, smid, (InvDBDataSubmissionUser, InvTokenDataSubmissionUser))) subEmails
          addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated
                                   | otherwise        -> MsgSubmissionUpdated
          return smid
        cID <- encrypt smid
        return $ Just cID
      (FormFailure msgs) -> Nothing <$ forM_ msgs (addMessage Warning . toHtml)
      _other -> return Nothing

  case mCID of
    Just cID -> redirect $ CSubmissionR tid ssh csh shn cID SubShowR
    Nothing  -> return ()

  -- Maybe construct a table to display uploaded archive files
  let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ())
      colonnadeFiles cid = mconcat
        [ sortable (Just "path") (i18nCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
              Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr)
              origIsFile = fmap (isJust . fileContent . entityVal . snd) mOrig
              corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
              Just isFile = origIsFile <|> corrIsFile
            in if
              | Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
                                                      [whamlet|#{fileTitle'}|]
              | otherwise               -> textCell $ bool (<> "/") id isFile fileTitle'
        , sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of
            Nothing -> cell mempty
            Just (_, Entity _ File{..})
              | isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
                                                 [whamlet|_{MsgFileCorrected}|]
              | otherwise -> i18nCell MsgCorrected
        , sortable (Just "time") (i18nCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
              origTime = fileModified . entityVal . snd <$> mOrig
              corrTime = fileModified . entityVal . snd <$> mCorr
              Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
            in dateTimeCell fileTime
        ]
      coalesce :: ((Maybe (Entity SubmissionFile), Maybe (Entity File)), (Maybe (Entity SubmissionFile), Maybe (Entity File))) -> (Maybe (Entity SubmissionFile, Entity File), Maybe (Entity SubmissionFile, Entity File))
      coalesce ((ma, mb), (mc, md)) = ((,) <$> ma <*> mb, (,) <$> mc <*> md)
      submissionFiles :: _ -> _ -> E.SqlQuery _
      submissionFiles smid ((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) = do
        E.on $ f2 E.?. FileId E.==. sf2 E.?. SubmissionFileFile
        E.on $ f1 E.?. FileTitle E.==. f2 E.?. FileTitle
         E.&&. sf1 E.?. SubmissionFileSubmission E.==. sf2 E.?. SubmissionFileSubmission
         E.&&. sf1 E.?. SubmissionFileId E.!=. sf2 E.?. SubmissionFileId
         E.&&. sf2 E.?. SubmissionFileIsDeletion E.==. E.val (Just False)
        E.on $ f1 E.?. FileId E.==. sf1 E.?. SubmissionFileFile

        E.where_ $ (sf1 E.?. SubmissionFileIsUpdate E.==. E.val (Just False) E.||. E.isNothing (sf1 E.?. SubmissionFileIsUpdate))
             E.&&. (sf2 E.?. SubmissionFileIsUpdate E.==. E.val (Just True)  E.||. E.isNothing (sf2 E.?. SubmissionFileIsUpdate))
             E.&&. (sf2 E.?. SubmissionFileIsDeletion E.==. E.val (Just False)  E.||. E.isNothing (sf2 E.?. SubmissionFileIsDeletion))
             E.&&. (sf1 E.?. SubmissionFileSubmission E.==. E.val (Just smid) E.||. sf2 E.?. SubmissionFileSubmission E.==. E.val (Just smid))

        return ((sf1, f1), (sf2, f2))
      smid2ArchiveTable (smid,cid) = DBTable
        { dbtSQLQuery = submissionFiles smid
        , dbtRowKey = \((_ `E.InnerJoin` f1) `E.FullOuterJoin` (_ `E.InnerJoin` f2)) -> (f1 E.?. FileId, f2 E.?. FileId)
        , dbtColonnade = colonnadeFiles cid
        , dbtProj = return . dbrOutput
        , dbtStyle = def
        , dbtIdent = "files" :: Text
        , dbtSorting = Map.fromList
          [ ( "path"
            , SortColumn $ \((_sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (_sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle]
            )
          , ( "time"
            , SortColumn $ \((_sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (_sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
            )
          ]
        , dbtFilter = mempty
        , dbtFilterUI = mempty
        , dbtParams = def
        , dbtCsvEncode = noCsvEncode
        , dbtCsvDecode = Nothing
        }
  mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid

  defaultLayout $ do
    setTitleI $ MsgSubmissionEditHead tid ssh csh shn
    let urlArchive  cID = CSubmissionR tid ssh csh shn cID $ SubArchiveR SubmissionCorrected
        urlOriginal cID = CSubmissionR tid ssh csh shn cID $ SubArchiveR SubmissionOriginal
    $(widgetFile "submission")

getSInviteR, postSInviteR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSInviteR = postSInviteR
postSInviteR = invitationR submissionUserInvitationConfig


getSubDownloadR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
getSubDownloadR tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
  (submissionID, isRating) <- runDB $ do
    submissionID <- submissionMatchesSheet tid ssh csh shn cID

    isRating <- (== Just submissionID) <$> isRatingFile path

    when (isUpdate || isRating) $
      guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False

    return (submissionID, isRating)

  case isRating of
    True
      | isUpdate -> runDB $ do
          file <- runMaybeT $ lift . ratingFile cID =<< MaybeT (getRating submissionID)
          maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
      | otherwise -> notFound
    False -> do
      let results = (.| Conduit.map entityVal) . E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> do
            E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
            E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
                 E.&&. f E.^. FileTitle E.==. E.val path
                 E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
                 E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
                 -- E.&&. E.not_ (E.isNothing $ f E.^. FileContent) -- This is fine, we just return 204
            return f

      serveOneFile results

getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> Handler TypedContent
getSubArchiveR tid ssh csh shn cID sfType = do
  when (sfType == SubmissionCorrected) $
    guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False

  let filename
        | SubmissionOriginal <- sfType = toPathPiece cID <> "-" <> toPathPiece sfType
        | otherwise = toPathPiece cID

      source = do
        submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
        rating <- lift $ getRating submissionID

        case sfType of
          SubmissionOriginal -> (.| Conduit.map entityVal) . E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> do
            E.on $ f E.^. FileId E.==. sf E.^. SubmissionFileFile
            E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
                 E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
            return f
          _ -> submissionFileSource submissionID .| Conduit.map entityVal

        when (sfType == SubmissionCorrected) $
          maybe (return ()) (yieldM . ratingFile cID) rating

  serveSomeFiles (unpack filename <.> "zip") source

getSubDelR, postSubDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSubDelR = postSubDelR
postSubDelR tid ssh csh shn cID = do
  subId <- runDB $ submissionMatchesSheet tid ssh csh shn cID
  deleteR $ (submissionDeleteRoute $ Set.singleton subId)
    { drAbort = SomeRoute $ CSubmissionR tid ssh csh shn cID SubShowR
    , drSuccess = SomeRoute $ CSheetR tid ssh csh shn SShowR
    }


getCorrectionsDownloadR :: Handler TypedContent
getCorrectionsDownloadR = do -- download all assigned and open submissions
  uid <- requireAuthId
  subs <- runDB $ selectKeysList
            [ SubmissionRatingBy   ==. Just uid
            , SubmissionRatingTime ==. Nothing
            ] []
  when (null subs) $ do
    addMessageI Info MsgNoOpenSubmissions
    redirect CorrectionsR
  submissionMultiArchive $ Set.fromList subs


getSubAssignR, postSubAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSubAssignR = postSubAssignR
postSubAssignR tid ssh csh shn cID = do
  let actionUrl = CSubmissionR tid ssh csh shn cID SubAssignR
  sId <- decrypt cID
  (currentCorrector, sheetCorrectors) <- runDB $ do
    Submission{submissionRatingBy, submissionSheet} <- get404 sId
    sheetCorrectors <- map (sheetCorrectorUser . entityVal) <$> selectList [SheetCorrectorSheet ==. submissionSheet] []
    userCorrector <- traverse getJustEntity submissionRatingBy
    return (userCorrector, maybe id (:) submissionRatingBy sheetCorrectors)

  $logDebugS "SubAssignR" $ tshow currentCorrector
  let correctorField  = selectField $ optionsPersistCryptoId [UserId <-. sheetCorrectors] [Asc UserSurname, Asc UserDisplayName] userDisplayName
  ((corrResult, corrForm'), corrEncoding) <- runFormPost . renderAForm FormStandard $
        aopt correctorField (fslI MsgCorrector) (Just currentCorrector)
  formResult corrResult $ \(fmap entityKey -> mbUserId) -> do
    when (mbUserId /= fmap entityKey currentCorrector) . runDB $ do
      now <- liftIO getCurrentTime
      update sId  [ SubmissionRatingBy =. mbUserId
                  , SubmissionRatingAssigned =. (now <$ mbUserId)
                  ]
      addMessageI Success MsgCorrectorUpdated
    redirect actionUrl
  let corrForm = wrapForm' BtnSave corrForm' def
        { formAction = Just $ SomeRoute actionUrl
        , formEncoding = corrEncoding
        , formSubmit = FormSubmit
        }
  defaultLayout $ do
      setTitleI MsgCorrectorAssignTitle
      $(widgetFile "submission-assign")
