Merge branch 'master' into 'live'

iframe-based dynamic modals Closes #226, #217, and #223 See merge request !91
2018-11-09 13:20:31 +01:00 · 2018-11-09 13:20:31 +01:00 · f4df3b110e
commit f4df3b110e
parent d654310120 d2194d5605
12 changed files with 177 additions and 88 deletions
--- a/.gitignore
+++ b/.gitignore
@ -30,5 +30,4 @@ src/Handler/Course.SnapCustom.hs
 /instance
 .stack-work-*
 .directory
-tags
-.vscode
+tags
--- a/.vscode/tasks.json
+++ b/.vscode/tasks.json
@ -0,0 +1,35 @@
+{  
+  "version": "2.0.0",
+  "tasks": [
+    {
+      "label": "build",
+      "type": "shell",
+      "command": "./build.sh",
+      "group": {
+        "kind": "build",
+        "isDefault": true
+      },
+      "presentation": {
+        "echo": true,
+        "reveal": "silent",
+        "focus": false,
+        "panel": "dedicated",
+        "showReuseMessage": false
+      }
+    },
+    {
+      "label": "start",
+      "type": "shell",
+      "command": "./start.sh",
+      "group": "build",
+      "presentation": {
+        "echo": true,
+        "reveal": "silent",
+        "focus": false,
+        "panel": "dedicated",
+        "showReuseMessage": false
+      },
+      "problemMatcher": []
+    }
+  ]
+}
--- a/config/submission-blacklist
+++ b/config/submission-blacklist
@ -10,3 +10,8 @@ $# Ignoriere rekursiv alle Ordner __MACOSX und ihren Inhalt

 $# Ignoriere rekursiv alle Dateien .DS_Store (Mac OS)
 **/.DS_Store
+
+$# Ignoriere VI-Style-Backup-Files
+**/*~
+$# Ignoriere Emacs-Style-Backup-Files
+**/.#*#
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -346,7 +346,7 @@ MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie kön

 MailSubjectSheetSoonInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden
 MailSheetSoonInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze.
-MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfristt für #{sheetName} in #{csh} abgelaufen
+MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfrist für #{sheetName} in #{csh} abgelaufen
 MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Die Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet.
 MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{display n} Abgaben wurden Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt.
 MailEditNotifications: Benachrichtigungen ein-/ausschalten
--- a/24
+++ b/24
@ -10,20 +10,20 @@
 --  Admins always have access to entities within their assigned schools.
 --
 --  Access Tags:
--    !free       -- free for all
--    !lecturer   -- lecturer    for this course (or the school, if route is not connected to a course)
--    !corrector  -- corrector   for this sheet  (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course)
--    !registered -- participant for this course (no effect outside of courses)
--    !owner      -- part of the group of owners of this submission
--    !capacity   -- course this route is associated with has at least one unit of participant capacity
+--    !free        -- free for all
+--    !lecturer    -- lecturer    for this course (or the school, if route is not connected to a course)
+--    !corrector   -- corrector   for this sheet  (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course)
+--    !registered  -- participant for this course (no effect outside of courses)
+--    !owner       -- part of the group of owners of this submission
+--    !capacity    -- course this route is associated with has at least one unit of participant capacity
 --
--    !materials  -- only if course allows all materials to be free (no meaning outside of courses)
--    !time       -- access depends on time somehow
--    !isRead     -- only if it is read-only access (i.e. GET but not POST)
--    !isWrite    -- only if it is write access     (i.e. POST only) why needed???
--
--    !deprecated -- like free, but logs and gives a warning; entirely disabled in production
+--    !materials   -- only if course allows all materials to be free (no meaning outside of courses)
+--    !time        -- access depends on time somehow
+--    !isRead      -- only if it is read-only access (i.e. GET but not POST)
+--    !isWrite     -- only if it is write access     (i.e. POST only) why needed???
 --
+--    !deprecated  -- like free, but logs and gives a warning; entirely disabled in production
+--    !development -- like free, but only for development builds 

 /static StaticR Static appStatic                              !free
 /auth   AuthR   Auth   getAuth                                !free
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -16,6 +16,8 @@ import Auth.PWHash
 import Auth.Dummy
 import Jobs.Types

+import Handler.Utils.Templates (siteModalId, modalParameter)
+
 import qualified Network.Wai as W (pathInfo)

 import Yesod.Default.Util   (addStaticContentExternal)
@ -697,8 +699,14 @@ siteLayout headingOverride widget = do
  master <- getYesod
  let AppSettings { appUserDefaults = UserDefaultConf{..}, .. } = appSettings master

-  applySystemMessages
-  mmsgs  <- getMessages
+  isModal <- isJust <$> siteModalId
+  $logDebugS "siteLayout" $ "isModal = " <> tshow isModal
+
+  mmsgs <- if
+    | isModal -> return []
+    | otherwise -> do
+        applySystemMessages
+        getMessages

  mcurrentRoute <- getCurrentRoute

--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@ -180,8 +180,7 @@ getSheetListR tid ssh csh = do
                    mkRoute = do
                      cid' <- mkCid
                      return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
-                    protoCell = anchorCellM mkRoute $(widgetFile "widgets/rating")
-                in protoCell & cellContents %~ (<* tell (sheetTypeSum sheetType submissionRatingPoints))
+                in anchorCellM mkRoute $(widgetFile "widgets/rating")
      , sortable Nothing -- (Just "percent") 
                        (i18nCell MsgRatingPercent)
          $ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of
@ -196,23 +195,7 @@ getSheetListR tid ssh csh = do
      ]
    psValidator = def
      & defaultSorting [("submission-since", SortAsc)]
-  ------------------------------------------------------
-  -- ISSUE #223
-  -- The following line does not work; something is wrong with the tell in line 189 above.
-  -- (SheetTypeSummary{..}, table) <- dbTable psValidator $ DBTable
-  --
-  -- If fixed, remove the following workaround code:
-  SheetTypeSummary{..} <- do
-    rows <- runDB $ E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do
-      E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
-      E.on $  (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
-        E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
-      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
-      return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
-    return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows
-  (_, table) <- dbTable psValidator $ DBTable
-  -- END ISSUE #223
-  -----------------------------------------------------
+  ((), table) <- dbTable psValidator $ DBTable
    { dbtSQLQuery  = sheetData
    , dbtColonnade = sheetCol
    , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
@ -245,6 +228,15 @@ getSheetListR tid ssh csh = do
    , dbtStyle     = def
    , dbtIdent     = "sheets" :: Text
    }
+  -- Collect summary over all Sheets, not just the ones shown due to pagination:
+  SheetTypeSummary{..} <- do
+    rows <- runDB $ E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do
+      E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
+      E.on $  (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
+        E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
+      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+      return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
+    return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows
  defaultLayout $ do
    $(widgetFile "sheetList")
    $(widgetFile "widgets/sheetTypeSummary")
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@ -47,22 +47,27 @@ import System.FilePath
 -- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.


-makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
-makeSubmissionForm msmid uploadMode grouping buddies = identForm FIDsubmission $ \html -> do
+makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> NonEmpty UserEmail -> Form (Maybe (Source Handler File), NonEmpty UserEmail)
+makeSubmissionForm msmid uploadMode grouping (self :| buddies) = identForm FIDsubmission $ \html -> do
    let
      fileUploadForm = case uploadMode of
        NoUpload -> pure Nothing
        (Upload unpackZips) -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
    flip (renderAForm FormStandard) html $ (,)
      <$> fileUploadForm
-      <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
-                                    | g <- [1..(max (fromIntegral groupNr) $ length buddies)] -- groupNr might have decreased meanwhile
-                                    | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
-                                    ])
+      <*> ( (:|) 
+        -- #227 Part I: change aforced to areq if the user is the lecturer or an admin (lecturer can upload for students)
+        <$> aforced ciField (fslpI (MsgSubmissionMember 1) "user@campus.lmu.de" ) self
+        <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
+                                      | g <- [2..(fromIntegral groupNr)]
+                                      | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
+                                      ])
+        )
      <*  submitButton
  where
    (groupNr, editableBuddies)
-      | Arbitrary{..} <- grouping = (pred maxParticipants, True) -- pred to account for the person submitting
+      | Arbitrary{..} <- grouping = (maxParticipants, True) 
+      | RegisteredGroups <- grouping = (fromIntegral $ length buddies, False)
      | otherwise = (0, False)

    aforced' f fs (Just (Just v)) = Just <$> aforced f fs v
@ -95,7 +100,7 @@ getSubmissionOwnR tid ssh csh shn = do

 submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
 submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
-  uid       <- requireAuthId
+  (Entity uid userData) <- requireAuth
  msmid     <- traverse decrypt mcid
  actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
  maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc.
@ -141,7 +146,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
          invalidArgsI [MsgSubmissionWrongSheet]
        -- fetch buddies from current submission
        (Any isOwner, buddies) <- do
-          submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
+          submitters <- 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]
@ -149,7 +154,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
          let breakUserFromBuddies (E.Value userID, E.Value email)
                | uid == userID  =  (Any True ,      [])
                | otherwise      =  (Any False, [email])
-          return $ foldMap breakUserFromBuddies submittors
+          return $ foldMap breakUserFromBuddies submitters

        lastEdits <- do
            raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
@ -163,13 +168,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
              return (userName, submissionEdit E.^. SubmissionEditTime)
            forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
        return (csheet,buddies,lastEdits)
-  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping buddies
+  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping (userEmail userData :| buddies)
  mCID <- runDBJobs $ do
    res' <- case res of
      FormMissing              -> return   FormMissing
      (FormFailure failmsgs)   -> return $ FormFailure failmsgs
-      (FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
-      (FormSuccess (mFiles,gEMails@(_:_))) -- Validate AdHoc Group Members
+      -- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
+      (FormSuccess (mFiles,_submitter:|[])) -> return $ FormSuccess (mFiles,[]) -- Type change
+      (FormSuccess (mFiles,_submitter:|gEMails@(_:_))) -- Validate AdHoc Group Members
        | Arbitrary{..} <- sheetGrouping -> do
          -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
          let prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool))
--- a/src/Handler/Utils/Templates.hs
+++ b/src/Handler/Utils/Templates.hs
@ -7,6 +7,12 @@ import Import.NoFoundation
 lipsum :: WidgetT site IO ()
 lipsum = $(widgetFile "widgets/lipsum")

+modalParameter :: Text
+modalParameter = "_modal"
+
+siteModalId :: MonadHandler m => m (Maybe Text)
+siteModalId = lookupGetParam modalParameter
+
 modal :: WidgetT site IO () -> Either (Route site) (WidgetT site IO ()) -> WidgetT site IO ()
 modal modalTrigger modalContent = do
  let modalDynamic = isLeft modalContent
--- a/templates/default-layout.hamlet
+++ b/templates/default-layout.hamlet
@ -1,16 +1,19 @@
-<!-- navigation -->
-^{navbar}
+$if not isModal
+  <!-- navigation -->
+  ^{navbar}

 <div .main>

-  <!-- secondary navigation at the side -->
-  ^{asidenav}
+  $if not isModal
+    <!-- secondary navigation at the side -->
+    ^{asidenav}

  <div .main__content>

-    <!-- breadcrumbs -->
-    $if not $ Just HomeR == mcurrentRoute
-      ^{breadcrumbsWgt}
+    $if not isModal
+      <!-- breadcrumbs -->
+      $if not $ Just HomeR == mcurrentRoute
+        ^{breadcrumbsWgt}

    <div .main__content-body>

@ -20,17 +23,17 @@
            <a .breadcrumbs__link href="@{fst back}">#{snd back}  -->
          ^{headline}

-      <!-- prime page actions -->
-      ^{pageactionprime}
+      $if not isModal
+        <!-- prime page actions -->
+        ^{pageactionprime}

-      <!-- alerts -->
-      <div .alerts>
-        $forall (status, msg) <- mmsgs
-          $with status2 <- bool status "info" (status == "")
-            <div class="alert alert-#{status2}">
-              <div .alert__content>
-                #{msg}
+        <!-- alerts -->
+        <div .alerts>
+          $forall (status, msg) <- mmsgs
+            $with status2 <- bool status "info" (status == "")
+              <div class="alert alert-#{status2}">
+                <div .alert__content>
+                  #{msg}

      <!-- actual content -->
-
      ^{widget}
--- a/templates/standalone/modal.julius
+++ b/templates/standalone/modal.julius
@ -7,7 +7,7 @@
    var overlay = document.createElement('div');
    var closer = document.createElement('div');
    var trigger = document.querySelector('#' + modal.dataset.trigger);
-    var origParent = modal.parentNode;
+    // var origParent = modal.parentNode;

    function open(event) {
      // disable modals for narrow screens
@ -16,8 +16,8 @@
      }
      modal.classList.add('modal--open');
      overlay.classList.add('modal__overlay');
-      document.body.insertBefore(modal, null);
-      document.body.insertBefore(overlay, modal);
+      // document.body.insertBefore(modal, null);
+       document.body.insertBefore(overlay, modal);
      overlay.classList.add('modal__overlay--open');

      if (modal.dataset.closeable === 'true') {
@ -39,13 +39,15 @@
    function close(event) {
      if (typeof event === 'undefined' || event.target === closer || event.target === overlay) {
        overlay.remove();
-        origParent.insertBefore(modal, null);
+        // origParent.insertBefore(modal, null);
        modal.classList.remove('modal--open');
        closer.removeEventListener('click', close, false);
      }
    };

    function setup() {
+       document.body.insertBefore(modal, null);
+
      // every modal can be openend via document-wide event, see openOnEvent
      document.addEventListener('modal-open', openOnEvent, false);
      // if modal has trigger assigned to it open modal on click
@ -55,24 +57,48 @@
      }

      if (modal.dataset.dynamic === 'True') {
+        // var dynamicContentURL = trigger.getAttribute('href');
+        // console.log(dynamicContentURL);
+        // if (dynamicContentURL.length > 0) {
+        //   fetch(dynamicContentURL, {
+        //     credentials: 'same-origin',
+        //   }).then(function(response) {
+        //     return response.text();
+        //   }).then(function(body) {
+        //     var modalContent = document.createElement('div');
+        //     modalContent.innerHTML = body;
+        //     var main = modalContent.querySelector('.main__content-body');
+        //     if (main) {
+        //       modal.appendChild(main);
+        //     } else {
+        //       replaceMe.innerHTML = body;
+        //     }
+        //   });
+        // }
+
        var dynamicContentURL = trigger.getAttribute('href');
        console.log(dynamicContentURL);
-        if (dynamicContentURL.length > 0) {
-          fetch(dynamicContentURL, {
-            credentials: 'same-origin',
-          }).then(function(response) {
-            return response.text();
-          }).then(function(body) {
-            var modalContent = document.createElement('div');
-            modalContent.innerHTML = body;
-            var main = modalContent.querySelector('.main__content-body');
-            if (main) {
-              modal.appendChild(main);
-            } else {
-              replaceMe.innerHTML = body;
-            }
-          });
+        var frame = document.createElement('iframe');
+        frame.setAttribute('id', "frame-" + modal.getAttribute('id'));
+        modal.insertBefore(frame, null);
+
+        frame.onload = function() {
+            frame.style.visibility = 'hidden';
+            frame.style.height = '0';
+
+            var doc = frame.contentDocument ? frame.contentDocument : frame.contentWindow.document;
+            var body = doc.body, html = doc.documentElement;
+            var height = Math.max( body.scrollHeight, body.offsetHeight, html.clientHeight, html.scrollHeight, html.offsetHeight );
+
+            frame.style.height = "calc(" + (height + "px") + " + 1em)";
+            frame.style.visibility = 'visible';
+
+            doc.querySelectorAll("form").forEach(function(form) {
+                form.setAttribute("target", "_top");
+            });
        }
+
+        frame.setAttribute('src', dynamicContentURL + "?" + #{String modalParameter});
      }
      // tell further modals, that this one already got initialized
      modal.classList.add('js-modal-initialized');
--- a/templates/standalone/modal.lucius
+++ b/templates/standalone/modal.lucius
@ -14,15 +14,23 @@
  padding: 20px;
  padding-right: 65px;
  overflow: auto;
-  opacity: 0;
  transition: all .15s ease;
  pointer-events: none;
+  opacity: 0;

  &.modal--open {
    opacity: 1;
+    pointer-events: auto;
    z-index: 200;
    transform: translate(-50%, -50%) scale(1, 1);
-    pointer-events: all;
+  }
+
+  iframe {
+    height: calc(60vh);
+    width: 100%;
+    border-style: none;
+    scroll: auto;
+    overflow: auto;
  }
 }

@ -50,10 +58,11 @@
  width: 100%;
  background-color: transparent;
  z-index: -1;
-  opacity: 0;
  transition: all .2s ease;
+  display: none;

  &.modal__overlay--open {
+    display: block;
    z-index: 199;
    opacity: 1;
    background-color: rgba(0, 0, 0, 0.4);