diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index 05d5f1ee5..8f5a86d83 100644 --- a/src/Handler/LMS/Result.hs +++ b/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 - return nr - --addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen für Result mit Header ") <> fhead - sendResponseStatus ok200 ("Success."::Text) - [] -> --do - --addMessage Error "Es wurde keine Datei übermittelt." - sendResponseStatus badRequest400 ("No files received."::Text) - _other -> --do - --addMessage Error "Es darf nur genau eine Datei übermittelt werden." - sendResponseStatus badRequest400 ("Too many files received."::Text) + case enr of + Left (e :: SomeException) -> do + $logWarnS "LMS" $ "Result upload failed parsing: " <> tshow e + sendResponseStatus badRequest400 $ "Exception: " <> tshow e + Right nr -> do + let msg = "Success. LMS Result 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 = "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 diff --git a/src/Handler/LMS/Userlist.hs b/src/Handler/LMS/Userlist.hs index 63c173715..8a69b7196 100644 --- a/src/Handler/LMS/Userlist.hs +++ b/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 - 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." - redirect $ LmsUserlistR sid qsh \ No newline at end of file + case enr of + Left (e :: SomeException) -> do + $logWarnS "LMS" $ "Userlist upload failed parsing: " <> tshow e + sendResponseStatus badRequest400 $ "Exception: " <> tshow e + Right nr -> do + 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 + \ No newline at end of file diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 3edbda8ef..8ca116ae7 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/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"