Merge branch 'master' into 'live'

Deploy submission cleanup

See merge request !52
This commit is contained in:
Gregor Kleen 2018-07-10 13:57:13 +02:00
commit 3560b2ae5e
4 changed files with 15 additions and 13 deletions

4
routes
View File

@ -64,10 +64,10 @@
/subs SSubsR GET POST /subs SSubsR GET POST
/subs/new SubmissionNewR GET POST !timeANDregistered /subs/new SubmissionNewR GET POST !timeANDregistered
/subs/own SubmissionOwnR GET !free -- just redirect /subs/own SubmissionOwnR GET !free -- just redirect
/sub/#CryptoFileNameSubmission SubmissionR !corrector: /sub/#CryptoFileNameSubmission SubmissionR !correctorANDisRead:
/ SubShowR GET POST !ownerANDtime !ownerANDisRead / SubShowR GET POST !ownerANDtime !ownerANDisRead
/archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner /archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner
/correction CorrectionR GET POST !ownerANDisRead /correction CorrectionR GET POST !corrector !ownerANDisRead
!/#SubmissionFileType/*FilePath SubDownloadR GET !owner !/#SubmissionFileType/*FilePath SubDownloadR GET !owner
/correctors SCorrR GET POST /correctors SCorrR GET POST
!/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector !/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector

View File

@ -246,6 +246,8 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
Nothing -> return () Nothing -> return ()
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True
-- Maybe construct a table to display uploaded archive files -- Maybe construct a table to display uploaded archive files
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ()) let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ())
colonnadeFiles cid = mconcat colonnadeFiles cid = mconcat
@ -355,7 +357,8 @@ getSubArchiveR tid csh shn cID@CryptoID{..} (ZIPArchiveName sfType) = do
fileSource' = do fileSource' = do
fileSource .| Conduit.map entityVal fileSource .| Conduit.map entityVal
maybe (return ()) (yieldM . ratingFile cID) rating when (sfType == SubmissionCorrected) $
maybe (return ()) (yieldM . ratingFile cID) rating
zipComment = Text.encodeUtf8 . pack $ CI.foldedCase ciphertext zipComment = Text.encodeUtf8 . pack $ CI.foldedCase ciphertext

View File

@ -285,15 +285,12 @@ instance Default Theme where
derivePersistField "Theme" derivePersistField "Theme"
newtype ZIPArchiveName obj = ZIPArchiveName obj newtype ZIPArchiveName obj = ZIPArchiveName { unZIPArchiveName :: obj }
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
instance PathPiece obj => PathPiece (ZIPArchiveName obj) where instance PathPiece obj => PathPiece (ZIPArchiveName obj) where
fromPathPiece (map CI.mk . unpack -> s) fromPathPiece = fmap ZIPArchiveName . fromPathPiece <=< (stripSuffix `on` CI.foldCase) ".zip"
| Just s' <- stripSuffix (map CI.mk ".zip") s = fromPathPiece . pack $ map CI.original s' toPathPiece = (<> ".zip") . toPathPiece . unZIPArchiveName
| otherwise = Nothing
toPathPiece (ZIPArchiveName obj) = toPathPiece obj <> ".zip"
newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String } newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String }
deriving (Eq, Ord, Read, Show, ToJSON, FromJSON, PersistField, PersistFieldSql) deriving (Eq, Ord, Read, Show, ToJSON, FromJSON, PersistField, PersistFieldSql)

View File

@ -1,7 +1,8 @@
$maybe cID <- mcid $maybe cID <- mcid
<section style="padding-bottom:1em; margin-bottom:1em; border-bottom:1px solid black;"> <section>
<h2> <h2>
<a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv <a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv
(<a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))}>Original</a>)
$if not (null lastEdits) $if not (null lastEdits)
<h3>_{MsgLastEdits} <h3>_{MsgLastEdits}
<ul> <ul>
@ -11,6 +12,7 @@ $maybe cID <- mcid
<h3>_{MsgSubmissionFiles} <h3>_{MsgSubmissionFiles}
^{fileTable} ^{fileTable}
<section> $if maySubmit
<form .form-horizontal method=post action=@{actionUrl} enctype=#{formEnctype}> <section>
^{formWidget} <form .form-horizontal method=post action=@{actionUrl} enctype=#{formEnctype}>
^{formWidget}