chore(lms): direct routes send response code instead of redirect

src/Handler/LMS/Result.hs

@@ -262,19 +262,26 @@ postLmsResultDirectR sid qsh = do
   (_params, files) <- runRequestBody 
   case files of
     [(fhead,file)] -> do
-      nr <- runDBJobs $ do 
+      runDBJobs $ do 
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh 
-        nr <- runConduit $ fileSource file
+        enr <- try $ runConduit $ fileSource file
                 .| decodeCsv
                 .| foldMC (saveResultCsv qid) 0
-        queueDBJob $ JobLmsResults qid
+        case enr of 
-        return nr
+          Left (e :: SomeException) -> do
-      --addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen für Result mit Header ") <> fhead
+            $logWarnS "LMS" $ "Result upload failed parsing: " <> tshow e
-      sendResponseStatus ok200 ("Success."::Text)
+            sendResponseStatus badRequest400 $ "Exception: " <> tshow e
-    []     -> --do
+          Right nr -> do               
-      --addMessage Error "Es wurde keine Datei übermittelt."
+            let msg = "Success. LMS Result upload file " <> fileName file <> " containing " <> tshow nr <> " rows for header " <> fhead
-      sendResponseStatus badRequest400 ("No files received."::Text)
+            $logWarnS "LMS" msg -- TODO: change to Info Level in the future
-    _other -> --do
+            queueDBJob $ JobLmsResults qid
-      --addMessage Error "Es darf nur genau eine Datei übermittelt werden."
+            sendResponseStatus ok200 msg
-      sendResponseStatus badRequest400 ("Too many files received."::Text)
+    []     -> do
+      let msg = "Result upload file missing."
+      $logWarnS "LMS" msg 
+      sendResponseStatus badRequest400 msg 
+    _other -> do
+      let msg = "Result upload received multiple files; all ignored."
+      $logWarnS "LMS" msg 
+      sendResponseStatus badRequest400 msg 
   

src/Handler/LMS/Userlist.hs

@@ -258,14 +258,26 @@ postLmsUserlistDirectR sid qsh = do
   (_params, files) <- runRequestBody 
   case files of
     [(fhead,file)] -> do
-      nr <- runDBJobs $ do 
+      runDBJobs $ do 
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh 
-        nr <- runConduit $ fileSource file
+        enr <- try $ runConduit $ fileSource file
                 .| decodeCsv
                 .| foldMC (saveUserlistCsv qid) 0
-        queueDBJob $ JobLmsUserlist qid
+        case enr of 
-        return nr
+          Left (e :: SomeException) -> do
-      addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen für Userlit mit Header ") <> fhead
+            $logWarnS "LMS" $ "Userlist upload failed parsing: " <> tshow e
-    []     -> addMessage Error "Es wurde keine Datei übermittelt."
+            sendResponseStatus badRequest400 $ "Exception: " <> tshow e
-    _other -> addMessage Error "Es darf nur genau eine Datei übermittelt werden."
+          Right nr -> do               
-  redirect $ LmsUserlistR sid qsh 
+            let msg = "Success. LMS Userlist upload file " <> fileName file <> " containing " <> tshow nr <> " rows for header " <> fhead
+            $logWarnS "LMS" msg -- TODO: change to Info Level in the future
+            queueDBJob $ JobLmsResults qid
+            sendResponseStatus ok200 msg
+    []     -> do
+      let msg = "Userlist upload file missing."
+      $logWarnS "LMS" msg 
+      sendResponseStatus badRequest400 msg 
+    _other -> do
+      let msg = "Userlist upload received multiple files; all ignored."
+      $logWarnS "LMS" msg 
+      sendResponseStatus badRequest400 msg 
+  

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -27,6 +27,7 @@ dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = use
     <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
 
   let qname = CI.original qualificationName
+  $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " about expiry of qualification " <> qname
   replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
   setSubjectI $ MsgMailSubjectQualificationExpiry qname
   
@@ -47,6 +48,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
     <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
   let qname = CI.original qualificationName  
       -- content = $(i18nWidgetFile "qualification/renewal")
+  $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualifiaction " <> qname
   if | checkEmailOk userEmail -> userMailT jRecipient $ do
         
         replaceMailHeader "Auto-Submitted" $ Just "auto-generated"