refactor SubmissionR
This commit is contained in:
Gregor Kleen
parent
aea5ef41d1
commit
44776e1506
4
routes
4
routes
@ -50,7 +50,9 @@
|
||||
/#SheetFileType/#FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector
|
||||
/edit SEditR GET POST
|
||||
/delete SDelR GET POST
|
||||
!/submission/#SubmissionMode SubmissionR GET POST !timeANDregistered !owner
|
||||
!/sub/new SubmissionNewR GET POST !timeANDregistered
|
||||
!/sub/own SubmissionOwnR GET !free
|
||||
!/sub/#CryptoUUIDSubmission SubmissionR GET POST !owner !corrector
|
||||
|
||||
|
||||
!/#UUID CryptoUUIDDispatchR GET !free -- just redirect
|
||||
|
||||
@ -245,7 +245,7 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
|
||||
resMap :: Map CourseId (Set SheetId)
|
||||
resMap = Map.fromListWith Set.union [ (cid, Set.singleton sid) | (E.Value cid, E.Value sid) <- resList ]
|
||||
case route of
|
||||
CSheetR _ _ _ (SubmissionR (ExistingSubmission cID)) -> maybeT (unauthorizedI MsgUnauthorizedSubmissionCorrector) $ do
|
||||
CSheetR _ _ _ (SubmissionR cID) -> maybeT (unauthorizedI MsgUnauthorizedSubmissionCorrector) $ do
|
||||
sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
Submission{..} <- MaybeT . lift $ get sid
|
||||
guard $ maybe False (== authId) submissionRatingBy
|
||||
@ -271,7 +271,7 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
|
||||
case subRoute of
|
||||
SFileR SheetHint _ -> guard $ maybe False (<= cTime) sheetHintFrom
|
||||
SFileR SheetSolution _ -> guard $ maybe False (<= cTime) sheetSolutionFrom
|
||||
SubmissionR NewSubmission -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
|
||||
SubmissionNewR -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
|
||||
_ -> guard $ maybe False (<= cTime) sheetVisibleFrom
|
||||
return Authorized
|
||||
r -> do
|
||||
@ -303,12 +303,12 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
|
||||
unauthorizedI MsgUnauthorized
|
||||
)
|
||||
,("owner", APDB $ \case
|
||||
CSheetR _ _ _ (SubmissionR (ExistingSubmission cID)) -> exceptT return return $ do
|
||||
CSheetR _ _ _ (SubmissionR cID) -> exceptT return return $ do
|
||||
sid <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSubmissionOwner) (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
|
||||
void . maybeMExceptT (unauthorizedI MsgUnauthorizedSubmissionOwner) . getBy $ UniqueSubmissionUser authId sid
|
||||
return Authorized
|
||||
CSheetR _ _ _ (SubmissionR NewSubmission) -> unauthorizedI MsgUnauthorizedSubmissionOwner
|
||||
CSheetR _ _ _ SubmissionNewR -> unauthorizedI MsgUnauthorizedSubmissionOwner
|
||||
r -> do
|
||||
$logErrorS "AccessControl" $ "'!owner' used on route that doesn't support it: " <> tshow r
|
||||
unauthorizedI MsgUnauthorized
|
||||
@ -652,10 +652,16 @@ pageActions (CourseR tid csh SheetListR) =
|
||||
]
|
||||
pageActions (CSheetR tid csh shn SShowR) =
|
||||
[ PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Abgabe anlegen"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SubmissionNewR
|
||||
, menuItemAccessCallback' = return True -- TODO: check that no submission already exists
|
||||
}
|
||||
, PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Abgabe"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn (SubmissionR NewSubmission)
|
||||
, menuItemAccessCallback' = return True
|
||||
, menuItemRoute = CSheetR tid csh shn SubmissionOwnR
|
||||
, menuItemAccessCallback' = return True -- TODO: check that a submission already exists
|
||||
}
|
||||
]
|
||||
pageActions TermShowR =
|
||||
|
||||
@ -38,7 +38,7 @@ instance CryptoRoute UUID SubmissionId where
|
||||
Sheet{..} <- get404 shid
|
||||
Course{..} <- get404 sheetCourse
|
||||
return (courseTerm, courseShorthand, sheetName)
|
||||
return $ CSheetR tid csh shn $ SubmissionR $ SubmissionMode $ Just cID
|
||||
return $ CSheetR tid csh shn $ SubmissionR cID
|
||||
|
||||
|
||||
class Dispatch ciphertext (x :: [*]) where
|
||||
|
||||
@ -74,10 +74,33 @@ makeSubmissionForm msmid unpackZips grouping buddies = identForm FIDsubmission $
|
||||
aforced' f fs (Just (Just v)) = Just <$> aforced f fs v
|
||||
aforced' _ _ _ = error "Cannot happen since groupNr==0 if grouping/=Arbitrary"
|
||||
|
||||
getSubmissionNewR, postSubmissionNewR :: TermId -> Text -> Text -> Handler Html
|
||||
getSubmissionNewR = postSubmissionNewR
|
||||
postSubmissionNewR tid csh shn = submissionHelper tid csh shn NewSubmission
|
||||
|
||||
getSubmissionR, postSubmissionR :: TermId -> Text -> Text -> SubmissionMode -> Handler Html
|
||||
|
||||
getSubmissionR, postSubmissionR :: TermId -> Text -> Text -> CryptoUUIDSubmission -> Handler Html
|
||||
getSubmissionR = postSubmissionR
|
||||
postSubmissionR tid csh shn (SubmissionMode mcid) = do
|
||||
postSubmissionR tid csh shn cid = submissionHelper tid csh shn $ ExistingSubmission cid
|
||||
|
||||
getSubmissionOwnR :: TermId -> Text -> Text -> Handler Html
|
||||
getSubmissionOwnR tid csh shn = do
|
||||
authId <- requireAuthId
|
||||
sid <- runDB $ do
|
||||
shid <- fetchSheetId tid csh shn
|
||||
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
|
||||
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
|
||||
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val authId
|
||||
E.&&. submission E.^. SubmissionSheet E.==. E.val shid
|
||||
return $ submission E.^. SubmissionId
|
||||
case submissions of
|
||||
((E.Value sid):_) -> return sid
|
||||
[] -> notFound
|
||||
cID <- encrypt sid
|
||||
redirect . CourseR tid csh . SheetR shn $ SubmissionR cID
|
||||
|
||||
submissionHelper :: TermId -> Text -> Text -> SubmissionMode -> Handler Html
|
||||
submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
uid <- requireAuthId
|
||||
msmid <- traverse decrypt mcid
|
||||
(Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do
|
||||
@ -112,7 +135,7 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
|
||||
(E.Value smid:_) -> do
|
||||
cID <- encrypt smid
|
||||
addMessageI "info" $ MsgSubmissionAlreadyExists
|
||||
redirect $ CSheetR tid csh shn $ SubmissionR $ SubmissionMode $ Just cID
|
||||
redirect $ CSheetR tid csh shn $ SubmissionR cID
|
||||
(Just smid) -> do
|
||||
shid' <- submissionSheet <$> get404 smid
|
||||
when (shid /= shid') $ invalidArgsI [MsgSubmissionWrongSheet]
|
||||
@ -203,7 +226,7 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
|
||||
_other -> return Nothing
|
||||
|
||||
case mCID of
|
||||
Just cID -> redirect $ CSheetR tid csh shn $ SubmissionR $ SubmissionMode $ Just cID
|
||||
Just cID -> redirect $ CSheetR tid csh shn $ SubmissionR cID
|
||||
Nothing -> return ()
|
||||
|
||||
mArCid <- fmap ZIPArchiveName <$> traverse encrypt msmid
|
||||
|
||||
Loading…
Reference in New Issue
Block a user