Cleanup submission download
This commit is contained in:
Gregor Kleen
parent
fee96e448f
commit
99832c1286
@ -131,6 +131,8 @@ NrColumn: Nr
|
||||
SelectColumn: Auswahl
|
||||
|
||||
CorrDownload: Herunterladen
|
||||
CorrUploadField: Korrekturen
|
||||
CorrUpload: Korrekturen hochladen
|
||||
CorrSetCorrector: Korrektor zuweisen
|
||||
CorrAutoSetCorrector: Korrekturen verteilen
|
||||
NatField xyz@Text: #{xyz} muss eine natürliche Zahl sein!
|
||||
|
||||
19
routes
19
routes
@ -56,26 +56,19 @@
|
||||
!/ex/new SheetNewR GET POST
|
||||
/ex/#Text SheetR:
|
||||
/show SShowR GET !timeANDregistered !timeANDmaterials !corrector
|
||||
!/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector
|
||||
/edit SEditR GET POST
|
||||
/delete SDelR GET POST
|
||||
!/sub/new SubmissionNewR GET POST !timeANDregistered
|
||||
!/sub/own SubmissionOwnR GET !free
|
||||
/sub/new SubmissionNewR GET POST !timeANDregistered
|
||||
/sub/own SubmissionOwnR GET !free
|
||||
!/sub/#{ZIPArchiveName SubmissionId} SubmissionDownloadArchiveR GET !owner !corrector
|
||||
!/sub/#CryptoFileNameSubmission SubmissionR GET POST !owner !corrector
|
||||
!/sub/#CryptoFileNameSubmission/*FilePath SubmissionDownloadSingleR GET !owner !corrector
|
||||
/correctors SCorrR GET POST
|
||||
/subs SSubsR GET POST
|
||||
!/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector
|
||||
|
||||
/corrections CorrectionsR GET POST !free
|
||||
|
||||
|
||||
-- TODO below
|
||||
!/#{ZIPArchiveName SubmissionId} SubmissionDownloadArchiveR GET !deprecated
|
||||
!/#CryptoFileNameSubmission/*FilePath SubmissionDownloadSingleR GET !deprecated
|
||||
|
||||
/submission SubmissionListR GET !deprecated
|
||||
/submission/#CryptoUUIDSubmission SubmissionDemoR GET POST !deprecated
|
||||
/submissions.zip SubmissionDownloadMultiArchiveR POST !deprecated
|
||||
-- TODO above
|
||||
|
||||
!/#UUID CryptoUUIDDispatchR GET !free -- just redirect
|
||||
!/*{CI FilePath} CryptoFileNameDispatchR GET !free
|
||||
-- !/*{CI FilePath} CryptoFileNameDispatchR GET !free -- Disabled until preliminary check for valid cID exists
|
||||
|
||||
@ -610,8 +610,6 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CSheetR tid csh shn SubmissionNewR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
|
||||
breadcrumb (CSheetR tid csh shn SubmissionOwnR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
|
||||
breadcrumb (CSheetR tid csh shn (SubmissionR _)) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
|
||||
-- Deprecated below
|
||||
breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
|
||||
-- Others
|
||||
breadcrumb _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
|
||||
|
||||
|
||||
@ -192,7 +192,7 @@ data ActionCorrectionsData = CorrDownloadData
|
||||
correctionsR :: _ -> _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget)) -> Handler TypedContent
|
||||
correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
|
||||
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator
|
||||
((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
|
||||
((actionRes, table), tableEncoding) <- runFormPost . identForm FIDcorrectorTable $ \csrf -> do
|
||||
((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
|
||||
(actionRes, action) <- multiAction actions
|
||||
return ((,) <$> actionRes <*> selectionRes, table <> action)
|
||||
|
||||
@ -205,7 +205,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
(Nothing, Just smid) -- no new files, existing submission partners updated
|
||||
-> return smid
|
||||
(Just files, _) -- new files
|
||||
-> runConduit $ transPipe lift files .| extractRatings .| sinkSubmission shid uid ((,False) <$> msmid)
|
||||
-> runConduit $ transPipe lift files .| extractRatings .| sinkSubmission uid (maybe (Left shid) Right msmid) False
|
||||
_ -> error "Impossible, because of definition of `makeSubmissionForm`"
|
||||
-- Determine members of pre-registered group
|
||||
groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
|
||||
@ -240,7 +240,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ())
|
||||
colonnadeFiles cid = mconcat
|
||||
-- [ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> textCell $ toPathPiece ftype
|
||||
[ sortable (Just "path") "Dateiname" $ anchorCell (\(Entity _ File{..}) -> SubmissionDownloadSingleR cid fileTitle)
|
||||
[ sortable (Just "path") "Dateiname" $ anchorCell (\(Entity _ File{..}) -> CSheetR tid csh shn $ SubmissionDownloadSingleR cid fileTitle)
|
||||
(\(Entity _ File{..}) -> str2widget fileTitle)
|
||||
, sortable (Just "time") "Modifikation" $ \(Entity _ File{..}) -> stringCell $ formatTimeGerWDT fileModified
|
||||
]
|
||||
@ -267,7 +267,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
$maybe arCid <- mArCid
|
||||
<hr>
|
||||
<h2>
|
||||
<a href=@{SubmissionDownloadArchiveR arCid}>Archiv
|
||||
<a href=@{CSheetR tid csh shn (SubmissionDownloadArchiveR arCid)}>Archiv
|
||||
$forall (name,time) <- lastEdits
|
||||
<div>last edited by #{name} at #{formatTimeGerDTlong time}
|
||||
$maybe fileTable <- mFileTable
|
||||
@ -276,14 +276,15 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
|]
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
getSubmissionDownloadSingleR :: CryptoFileNameSubmission -> FilePath -> Handler TypedContent
|
||||
getSubmissionDownloadSingleR cID path = do
|
||||
getSubmissionDownloadSingleR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> FilePath -> Handler TypedContent
|
||||
getSubmissionDownloadSingleR tid csh shn cID path = do
|
||||
submissionID <- decrypt cID
|
||||
|
||||
runDB $ do
|
||||
shid <- fetchSheetId tid csh shn
|
||||
Submission{..} <- get404 submissionID
|
||||
when (shid /= submissionSheet) $ invalidArgsI [MsgSubmissionWrongSheet]
|
||||
|
||||
isRating <- maybe False (== submissionID) <$> isRatingFile path
|
||||
case isRating of
|
||||
True -> do
|
||||
@ -304,11 +305,16 @@ getSubmissionDownloadSingleR cID path = do
|
||||
[Entity _ File{ fileContent = Just c }] -> return $ TypedContent (defaultMimeLookup fileName) (toContent c)
|
||||
_ -> notFound
|
||||
|
||||
getSubmissionDownloadArchiveR :: ZIPArchiveName SubmissionId -> Handler TypedContent
|
||||
getSubmissionDownloadArchiveR (ZIPArchiveName cID) = do
|
||||
getSubmissionDownloadArchiveR :: TermId -> Text -> Text -> ZIPArchiveName SubmissionId -> Handler TypedContent
|
||||
getSubmissionDownloadArchiveR tid csh shn (ZIPArchiveName cID) = do
|
||||
submissionID <- decrypt cID
|
||||
cUUID <- encrypt submissionID
|
||||
respondSourceDB "application/zip" $ do
|
||||
lift $ do
|
||||
shid <- fetchSheetId tid csh shn
|
||||
Submission{..} <- get404 submissionID
|
||||
when (shid /= submissionSheet) $ invalidArgsI [MsgSubmissionWrongSheet]
|
||||
|
||||
rating <- lift $ getRating submissionID
|
||||
case rating of
|
||||
Nothing -> lift notFound
|
||||
@ -317,151 +323,3 @@ getSubmissionDownloadArchiveR (ZIPArchiveName cID) = do
|
||||
fileEntitySource' = submissionFileSource submissionID =$= Conduit.map entityVal >> yieldM (ratingFile cID rating')
|
||||
info = ZipInfo { zipComment = Text.encodeUtf8 . tshow $ ciphertext (cUUID :: CryptoUUIDSubmission) }
|
||||
fileEntitySource' =$= produceZip info =$= Conduit.map toFlushBuilder
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------------------------------------------------------------------------------------
|
||||
------------------------- DEMO BELOW
|
||||
|
||||
|
||||
submissionTable :: MForm Handler (FormResult [SubmissionId], Widget)
|
||||
submissionTable = do
|
||||
subs <- lift . runDB $ E.select . E.from $ \(sub `E.InnerJoin` sheet `E.InnerJoin` course) -> do
|
||||
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
||||
E.on $ sheet E.^. SheetId E.==. sub E.^. SubmissionSheet
|
||||
|
||||
return (sub, sheet, course)
|
||||
|
||||
cryptedSubs <- forM subs $ \s@(Entity submissionId _, _, _) ->
|
||||
(,,) <$> encrypt submissionId <*> encrypt submissionId <*> pure s
|
||||
|
||||
let
|
||||
anchorCourse (_, _, (_, _, Entity _ Course{..})) = CourseR courseTerm courseShorthand CShowR
|
||||
courseText (_, _, (_, _, Entity _ Course{..})) = toWidget courseName
|
||||
anchorSubmission (_, cUUID, _) = SubmissionDemoR cUUID
|
||||
submissionText (cID, _, _) = toWidget . toPathPiece . CI.foldedCase $ ciphertext cID
|
||||
colonnade = mconcat
|
||||
[ headed "Abgabe-ID" $ Yesod.anchorCell anchorSubmission submissionText
|
||||
, headed "Kurs" $ Yesod.anchorCell anchorCourse courseText
|
||||
, headed "Blatt" $ \(_, _, (_, Entity _ Sheet{..}, _)) -> Yesod.textCell $ sheetName
|
||||
]
|
||||
toExternal :: (CryptoFileNameSubmission, CryptoUUIDSubmission, a) -> Handler CryptoUUIDSubmission
|
||||
toExternal (_, cID, _) = return cID
|
||||
fromExternal :: CryptoUUIDSubmission -> Handler SubmissionId
|
||||
fromExternal = decrypt
|
||||
headedRowSelector toExternal fromExternal (HA.class_ "table table-striped table-hover") colonnade cryptedSubs
|
||||
|
||||
|
||||
getSubmissionListR, postSubmissionListR :: Handler Html
|
||||
getSubmissionListR = postSubmissionListR
|
||||
postSubmissionListR = do
|
||||
((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderAForm FormStandard $ (,)
|
||||
<$> areq checkBoxField "Dies sind Korrekturen" (Just False)
|
||||
<*> fileAFormReq "Archiv"
|
||||
<* submitButton
|
||||
|
||||
runDB $ do
|
||||
case uploadResult of
|
||||
FormMissing -> return ()
|
||||
FormFailure _ -> addMessage "warning" "Bitte Eingabe korrigieren."
|
||||
FormSuccess (isUpdate, fInfo) -> do
|
||||
userId <- lift requireAuthId
|
||||
let feed :: SubmissionId -> SubmissionContent -> StateT (Map SubmissionId (ResumableSink SubmissionContent (YesodDB UniWorX) SubmissionId)) (YesodDB UniWorX) ()
|
||||
feed sId val = do
|
||||
mSink <- gets $ Map.lookup sId
|
||||
sink <- case mSink of
|
||||
Just sink -> return sink
|
||||
Nothing -> do
|
||||
Submission{..} <- lift $ get404 sId
|
||||
return . newResumableSink $ sinkSubmission submissionSheet userId (Just (sId, isUpdate))
|
||||
sink' <- lift $ yield val ++$$ sink
|
||||
case sink' of
|
||||
Left _ -> error "sinkSubmission returned prematurely"
|
||||
Right nSink -> modify $ Map.insert sId nSink
|
||||
sinkSubmissions :: Sink SubmissionContent (YesodDB UniWorX) ()
|
||||
sinkSubmissions = do
|
||||
sinks <- execStateC Map.empty . awaitForever $ \case
|
||||
v@(Right (sId, _)) -> lift $ feed sId v
|
||||
(Left f@File{..}) -> case splitDirectories fileTitle of
|
||||
(cID:rest)
|
||||
| not (null rest) -> do
|
||||
sId <- decrypt (CryptoID $ CI.mk cID :: CryptoFileNameSubmission)
|
||||
lift . feed sId $ Left f{ fileTitle = joinPath rest }
|
||||
| otherwise -> return ()
|
||||
[] -> invalidArgs ["Encountered file/directory with empty name"]
|
||||
lift $ mapM_ (void . closeResumableSink) sinks
|
||||
|
||||
runConduit $ fileSource fInfo =$= void consumeZip =$= extractRatings =$= void sinkSubmissions
|
||||
|
||||
(subTable, selectEncoding) <- generateFormPost . identifyForm "selection" . withFragment $ submissionTable
|
||||
|
||||
defaultLayout $(widgetFile "submission-list")
|
||||
|
||||
|
||||
|
||||
postSubmissionDownloadMultiArchiveR :: Handler TypedContent
|
||||
postSubmissionDownloadMultiArchiveR = do
|
||||
((selectResult, _), _) <- runFormPost . withFragment $ submissionTable
|
||||
|
||||
case selectResult of
|
||||
FormMissing -> invalidArgs ["Missing submission numbers"]
|
||||
FormFailure errs -> invalidArgs errs
|
||||
FormSuccess ids -> submissionMultiArchive (Set.fromList ids)
|
||||
|
||||
|
||||
|
||||
|
||||
getSubmissionDemoR, postSubmissionDemoR :: CryptoUUIDSubmission -> Handler Html
|
||||
getSubmissionDemoR = postSubmissionDemoR
|
||||
postSubmissionDemoR cID = do
|
||||
submissionId <- decrypt cID
|
||||
|
||||
((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderAForm FormStandard $ (,)
|
||||
<$> areq checkBoxField "Dies ist eine Korrektur" (Just False)
|
||||
<*> fileAFormReq "Datei"
|
||||
<* submitButton
|
||||
|
||||
(submission, files) <- runDB $ do
|
||||
submission <- do
|
||||
submission@Submission{..} <- get404 submissionId
|
||||
case uploadResult of
|
||||
FormMissing -> return submission
|
||||
FormFailure _ -> submission <$ addMessage "warning" "Bitte Eingabe korrigieren."
|
||||
FormSuccess (isUpdate, fInfo) -> do
|
||||
userId <- lift requireAuthId
|
||||
let mimeType = defaultMimeLookup (fileName fInfo)
|
||||
source
|
||||
| mimeType == "application/zip" = fileSource fInfo =$= void consumeZip
|
||||
| otherwise = do
|
||||
let fileTitle = Text.unpack $ fileName fInfo
|
||||
fileModified <- liftIO getCurrentTime
|
||||
yieldM $ do
|
||||
fileContent <- Just <$> runConduit (fileSource fInfo =$= foldC)
|
||||
return File{..}
|
||||
submissionId' <- runConduit $ source =$= extractRatings =$= sinkSubmission submissionSheet userId (Just (submissionId, isUpdate))
|
||||
get404 submissionId'
|
||||
|
||||
files <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
|
||||
E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
|
||||
E.where_ (sf E.^. SubmissionFileSubmission E.==. E.val submissionId)
|
||||
E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
|
||||
return (f, sf)
|
||||
return (submission, files)
|
||||
|
||||
let
|
||||
Rating'{..} = Rating'
|
||||
{ ratingPoints = submissionRatingPoints submission
|
||||
, ratingComment = submissionRatingComment submission
|
||||
, ratingTime = submissionRatingTime submission
|
||||
}
|
||||
|
||||
cID' <- encrypt submissionId
|
||||
let
|
||||
archiveBaseName = CI.foldedCase $ ciphertext (cID' :: CryptoFileNameSubmission)
|
||||
archiveName = archiveBaseName <.> "zip"
|
||||
|
||||
defaultLayout $(widgetFile "submission")
|
||||
|
||||
@ -52,7 +52,7 @@ import Control.Monad.Writer.Class
|
||||
-- Unique Form Identifiers to avoid accidents --
|
||||
------------------------------------------------
|
||||
|
||||
data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission | FIDsettings | FIDcorrectors
|
||||
data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission | FIDsettings | FIDcorrectors | FIDcorrectorTable | FIDcorrectionsUpload
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show)
|
||||
|
||||
|
||||
|
||||
@ -9,6 +9,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
|
||||
|
||||
module Handler.Utils.Submission
|
||||
@ -20,13 +21,13 @@ module Handler.Utils.Submission
|
||||
, sinkSubmission
|
||||
) where
|
||||
|
||||
import Import hiding ((.=))
|
||||
import Import hiding ((.=), joinPath)
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens.Extras (is)
|
||||
import Utils.Lens
|
||||
|
||||
import Control.Monad.State hiding (forM_, mapM_)
|
||||
import Control.Monad.State hiding (forM_, mapM_,foldM)
|
||||
import qualified Control.Monad.Random as Rand
|
||||
|
||||
import Data.Maybe
|
||||
@ -49,6 +50,9 @@ import Handler.Utils.Zip
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import qualified Data.Conduit.List as Conduit
|
||||
import Data.Conduit.ResumableSink
|
||||
|
||||
import System.FilePath
|
||||
|
||||
|
||||
data AssignSubmissionException = NoCorrectorsByProportion
|
||||
@ -185,9 +189,9 @@ data SubmissionSinkException = DuplicateFileTitle FilePath
|
||||
|
||||
instance Exception SubmissionSinkException
|
||||
|
||||
sinkSubmission :: SheetId
|
||||
-> UserId
|
||||
-> Maybe (SubmissionId, Bool {-^ Is this a correction -})
|
||||
sinkSubmission :: UserId
|
||||
-> Either SheetId SubmissionId
|
||||
-> Bool -- ^ Is this a correction
|
||||
-> Sink SubmissionContent (YesodDB UniWorX) SubmissionId
|
||||
-- ^ Replace the currently saved files for the given submission (either
|
||||
-- corrected files or original ones, depending on arguments) with the supplied
|
||||
@ -197,25 +201,28 @@ sinkSubmission :: SheetId
|
||||
-- are deleted (or marked as deleted in the case of this being a correction).
|
||||
--
|
||||
-- A 'Submission' is created if no 'SubmissionId' is supplied
|
||||
sinkSubmission sheetId userId mExists = do
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
submissionSheet = sheetId
|
||||
submissionRatingPoints = Nothing
|
||||
submissionRatingComment = Nothing
|
||||
submissionRatingBy = Nothing
|
||||
submissionRatingTime = Nothing
|
||||
|
||||
(sId, isUpdate) <- lift $ maybe ((, False) <$> (insert Submission{..} >>= (\sid -> sid <$ insert (SubmissionEdit userId now sid)))) return mExists
|
||||
|
||||
sinkSubmission userId mExists isUpdate = do
|
||||
sId <- lift $ case mExists of
|
||||
Left sheetId -> do
|
||||
let
|
||||
submissionSheet = sheetId
|
||||
submissionRatingPoints = Nothing
|
||||
submissionRatingComment = Nothing
|
||||
submissionRatingBy = Nothing
|
||||
submissionRatingTime = Nothing
|
||||
sId <- insert Submission{..}
|
||||
-- now <- liftIO getCurrentTime
|
||||
-- insert $ SubmissionEdit userId now sId -- This is done automatically during 'sinkSubmission'' iff the given submission is nonempty
|
||||
return sId
|
||||
Right sId -> return sId
|
||||
|
||||
sId <$ sinkSubmission' sId isUpdate
|
||||
where
|
||||
tell = modify . mappend
|
||||
|
||||
sinkSubmission' :: SubmissionId
|
||||
-> Bool -- ^ Is this a correction
|
||||
-> Sink SubmissionContent (YesodDB UniWorX) ()
|
||||
-> Bool -- ^ Is this a correction
|
||||
-> Sink SubmissionContent (YesodDB UniWorX) ()
|
||||
sinkSubmission' submissionId isUpdate = lift . finalize <=< execStateLC mempty . Conduit.mapM_ $ \case
|
||||
Left file@(File{..}) -> do
|
||||
$logDebugS "sinkSubmission" . tshow $ (submissionId, fileTitle)
|
||||
@ -363,3 +370,43 @@ sinkSubmission sheetId userId mExists = do
|
||||
, SubmissionRatingBy =. Nothing
|
||||
, SubmissionRatingComment =. Nothing
|
||||
]
|
||||
|
||||
sinkMultiSubmission :: UserId
|
||||
-> Bool {-^ Are these corrections -}
|
||||
-> Sink SubmissionContent (YesodDB UniWorX) (Set SubmissionId)
|
||||
|
||||
-- ^ Expects all supplied 'SubmissionContent' to contain an encrypted 'SubmissionId' and replaces the currently saved files for the respective submissions (either corrected files or original ones, depending on arguments) with the supplied 'SubmissionContent'.
|
||||
--
|
||||
-- Files that don't occur in the 'SubmissionContent' but are in the database are deleted (or marked as deleted in the case of this being a correction).
|
||||
sinkMultiSubmission userId isUpdate = do
|
||||
let
|
||||
feed :: SubmissionId
|
||||
-> SubmissionContent
|
||||
-> StateT
|
||||
(Map SubmissionId (ResumableSink SubmissionContent (YesodDB UniWorX) SubmissionId))
|
||||
(YesodDB UniWorX)
|
||||
()
|
||||
feed sId val = do
|
||||
mSink <- gets $ Map.lookup sId
|
||||
sink <- case mSink of
|
||||
Just sink -> return sink
|
||||
Nothing -> do
|
||||
-- Submission{..} <- lift $ get404 sId
|
||||
return . newResumableSink $ sinkSubmission userId (Right sId) isUpdate
|
||||
sink' <- lift $ yield val ++$$ sink
|
||||
case sink' of
|
||||
Left _ -> error "sinkSubmission returned prematurely"
|
||||
Right nSink -> modify $ Map.insert sId nSink
|
||||
sinks <- execStateLC Map.empty . awaitForever $ \case
|
||||
v@(Right (sId, _)) -> lift $ feed sId v
|
||||
(Left f@File{..}) -> do
|
||||
let
|
||||
tryDecrypt :: FilePath -> _ (Either CryptoIDError SubmissionId)
|
||||
tryDecrypt (CI.mk -> ciphertext) = try $ decrypt (CryptoID{..} :: CryptoFileNameSubmission)
|
||||
acc (Just cID, fp) segment = return (Just cID, fp ++ [segment])
|
||||
acc (Nothing , fp) segment = do
|
||||
msId <- tryDecrypt segment
|
||||
return . either (const id) (set _1 . Just) msId $ (Nothing, fp)
|
||||
(msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle
|
||||
lift . maybe (const $ return ()) feed msId $ Left f{ fileTitle = fileTitle' }
|
||||
fmap Map.keysSet . lift $ mapM (void . closeResumableSink) sinks
|
||||
|
||||
@ -36,10 +36,7 @@
|
||||
<a href=@{TermEditR}>Neues Semester anlegen
|
||||
|
||||
<li .list-group-item>
|
||||
<a href=@{CourseNewR}>Kurse anlegen
|
||||
|
||||
<li .list-group-item>
|
||||
<a href=@{SubmissionListR}>Dateien hochladen und abrufen
|
||||
<a href=@{CourseNewR}>Kurse anlegen
|
||||
|
||||
<hr>
|
||||
<div .container>
|
||||
|
||||
@ -2,4 +2,4 @@
|
||||
<form method=POST enctype=#{tableEncoding}>
|
||||
^{table}
|
||||
<button type=submit>
|
||||
Do stuff
|
||||
_{MsgBtnSubmit}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user