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

feat(lms): enable upload handlers for all upload routes

Browse Source
This commit is contained in:
Steffen Jost 2022-04-04 15:19:17 +02:00
parent 9483a0fc15
commit a5121f0d3e
2 changed files with 26 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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