From a5121f0d3e7a77695a6198057afd23f5f86ff174 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Mon, 4 Apr 2022 15:19:17 +0200
Subject: [PATCH] feat(lms): enable upload handlers for all upload routes

---
 src/Handler/LMS/Result.hs   | 24 +++++++++++++-----------
 src/Handler/LMS/Userlist.hs | 25 +++++++++++++------------
 2 files changed, 26 insertions(+), 23 deletions(-)

diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs
index 276468909..6a6fdd7a4 100644
--- a/src/Handler/LMS/Result.hs
+++ b/src/Handler/LMS/Result.hs
@@ -208,9 +208,7 @@ postLmsResultR sid qsh = do
 
 -- Direct File Upload/Download
 
---saveResultCsv :: (PersistUniqueWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend) =>
---                    Key Qualification -> LmsResultTableCsv -> ReaderT backend m ()
-saveResultCsv :: QualificationId -> Int -> LmsResultTableCsv -> DB Int
+saveResultCsv :: QualificationId -> Int -> LmsResultTableCsv -> JobDB Int
 saveResultCsv qid i LmsResultTableCsv{..} = do
     now <- liftIO getCurrentTime
     void $ upsert 
@@ -236,11 +234,13 @@ postLmsResultUploadR sid qsh = do
     FormSuccess file -> do
       -- content <- fileSourceByteString file 
       -- return $ Just (fileName file, content)          
-      nr <- runDB $ do 
+      nr <- runDBJobs $ do 
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh 
-        runConduit $ fileSource file 
-          .| decodeCsv
-          .| foldMC (saveResultCsv qid) 0
+        nr <- runConduit $ fileSource file 
+                .| decodeCsv
+                .| foldMC (saveResultCsv qid) 0
+        queueDBJob $ JobLmsResults qid
+        return nr
       addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen")
       redirect $ LmsResultR sid qsh 
     FormFailure errs -> do
@@ -262,11 +262,13 @@ postLmsResultDirectR sid qsh = do
   (_params, files) <- runRequestBody 
   case files of
     [(fhead,file)] -> do
-      nr <- runDB $ do 
+      nr <- runDBJobs $ do 
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh 
-        runConduit $ fileSource file
-          .| decodeCsv
-          .| foldMC (saveResultCsv qid) 0
+        nr <- runConduit $ fileSource file
+                .| decodeCsv
+                .| foldMC (saveResultCsv qid) 0
+        queueDBJob $ JobLmsResults qid
+        return nr
       addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen für Result mit Header ") <> fhead
     []     -> addMessage Error "Es wurde keine Datei übermittelt."
     _other -> addMessage Error "Es darf nur genau eine Datei übermittelt werden."
diff --git a/src/Handler/LMS/Userlist.hs b/src/Handler/LMS/Userlist.hs
index 32238bf12..63c173715 100644
--- a/src/Handler/LMS/Userlist.hs
+++ b/src/Handler/LMS/Userlist.hs
@@ -206,10 +206,9 @@ postLmsUserlistR sid qsh = do
 
 
 -- Direct File Upload/Download
-
---saveUserlistCsv :: (PersistUniqueWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend) =>
---                    Key Qualification -> LmsUserlistTableCsv -> ReaderT backend m ()
-saveUserlistCsv :: QualificationId -> Int -> LmsUserlistTableCsv -> DB Int
+--  saveUserlistCsv :: (PersistUniqueWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend, Enum b) =>
+--                      Key Qualification -> b -> LmsUserlistTableCsv -> ReaderT backend m b
+saveUserlistCsv :: QualificationId -> Int -> LmsUserlistTableCsv -> JobDB Int
 saveUserlistCsv qid i LmsUserlistTableCsv{..} = do
     now <- liftIO getCurrentTime
     void $ upsert 
@@ -233,11 +232,11 @@ postLmsUserlistUploadR sid qsh = do
   ((result,widget), enctype) <- runFormPost makeUserlistUploadForm
   case result of 
     FormSuccess file -> do
-      nr <- runDB $ do 
+      nr <- runDBJobs $ do 
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh 
-        runConduit $ fileSource file 
-          .| decodeCsv
-          .| foldMC (saveUserlistCsv qid) 0
+        nr <- runConduit $ fileSource file .| decodeCsv .| foldMC (saveUserlistCsv qid) 0
+        queueDBJob $ JobLmsUserlist qid
+        return nr
       addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen")
       redirect $ LmsUserlistR sid qsh 
     FormFailure errs -> do
@@ -259,11 +258,13 @@ postLmsUserlistDirectR sid qsh = do
   (_params, files) <- runRequestBody 
   case files of
     [(fhead,file)] -> do
-      nr <- runDB $ do 
+      nr <- runDBJobs $ do 
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh 
-        runConduit $ fileSource file
-          .| decodeCsv
-          .| foldMC (saveUserlistCsv qid) 0
+        nr <- runConduit $ fileSource file
+                .| decodeCsv
+                .| foldMC (saveUserlistCsv qid) 0
+        queueDBJob $ JobLmsUserlist qid
+        return nr
       addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen für Userlit mit Header ") <> fhead
     []     -> addMessage Error "Es wurde keine Datei übermittelt."
     _other -> addMessage Error "Es darf nur genau eine Datei übermittelt werden."