fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Steffen Jost 2022-05-18 12:42:01 +02:00
parent a755bd0be6
commit 412fa9c381
3 changed files with 41 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/Handler/LMS/Result.hs
View File

@ -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

28
src/Handler/LMS/Userlist.hs
View File

@ -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
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

2
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -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"