s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

Teacher can see results of his students'

Browse Source
This commit is contained in:
Filip Gralinski 2020-03-28 21:18:05 +01:00
parent 3bbbff7291
commit f6b696cffa
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Handler/Query.hs
View File

@ -34,7 +34,7 @@ import Data.SplitIntoCrossTabs
rawCommitQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a] rawCommitQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a]
rawCommitQuery sha1Prefix = rawCommitQuery sha1Prefix =
rawSql "SELECT ?? FROM submission WHERE is_public AND cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"] rawSql "SELECT ?? FROM submission WHERE cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
rawOutQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a] rawOutQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a]
rawOutQuery sha1Prefix = rawOutQuery sha1Prefix =
@ -48,9 +48,8 @@ groupBySecond lst = map putOut $ groupOn (fsiSubmissionId . fst) lst
findSubmissions :: Text -> Handler [(FullSubmissionInfo, [SHA1])] findSubmissions :: Text -> Handler [(FullSubmissionInfo, [SHA1])]
findSubmissions sha1Prefix = do findSubmissions sha1Prefix = do
mauthId <- maybeAuth mauthId <- maybeAuth
submissions <- runDB $ case mauthId of allSubmissions <- runDB $ rawCommitQuery sha1Prefix
Just (Entity authId _) -> rawSql "SELECT ?? FROM submission WHERE (is_public OR submitter = ?) AND cast(commit as text) like ?" [toPersistValue authId, PersistText $ "\\\\x" ++ sha1Prefix ++ "%"] submissions <- filterM (\sub -> runDB $ checkWhetherVisible (entityVal sub) (entityKey <$> mauthId)) allSubmissions
Nothing -> rawCommitQuery sha1Prefix
justSubmissions' <- mapM getFullInfo submissions justSubmissions' <- mapM getFullInfo submissions
let justSubmissions = map (\s -> (s, [])) justSubmissions' let justSubmissions = map (\s -> (s, [])) justSubmissions'
@ -196,7 +195,9 @@ getViewVariantR variantId = do
(submissionChallenge theSubmission) (submissionChallenge theSubmission)
let tests = sortBy (flip testComparator) tests' let tests = sortBy (flip testComparator) tests'
if submissionIsPublic theSubmission || Just (submissionSubmitter theSubmission) == (entityKey <$> mauthId) isViewable <- runDB $ checkWhetherVisible theSubmission (entityKey <$> mauthId)
if isViewable
then then
do do
fullSubmissionInfo <- getFullInfo (Entity theSubmissionId theSubmission) fullSubmissionInfo <- getFullInfo (Entity theSubmissionId theSubmission)
@ -236,17 +237,19 @@ paramsTable = mempty
viewOutput :: TableEntry -> [Entity Test] -> (SHA1, Text) -> WidgetFor App () viewOutput :: TableEntry -> [Entity Test] -> (SHA1, Text) -> WidgetFor App ()
viewOutput entry tests (outputHash, testSet) = do viewOutput entry tests (outputHash, testSet) = do
mauthId <- maybeAuthId
let tests'@(mainTest:_) = filter (\e -> (testName $ entityVal e) == testSet) tests let tests'@(mainTest:_) = filter (\e -> (testName $ entityVal e) == testSet) tests
let outputSha1AsText = fromSHA1ToText $ outputHash let outputSha1AsText = fromSHA1ToText $ outputHash
let variant = variantName $ entityVal $ tableEntryVariant entry let variant = variantName $ entityVal $ tableEntryVariant entry
let theStamp = submissionStamp $ entityVal $ tableEntrySubmission entry let theStamp = submissionStamp $ entityVal $ tableEntrySubmission entry
let isPublic = submissionIsPublic $ entityVal $ tableEntrySubmission entry isViewable <- handlerToWidget $ runDB $ checkWhetherVisible (entityVal $ tableEntrySubmission entry) mauthId
challenge <- handlerToWidget $ runDB $ get404 $ submissionChallenge $ entityVal $ tableEntrySubmission entry challenge <- handlerToWidget $ runDB $ get404 $ submissionChallenge $ entityVal $ tableEntrySubmission entry
let isNonSensitive = challengeSensitive challenge == Just False let isNonSensitive = challengeSensitive challenge == Just False
let shouldBeShown = not ("test-" `isInfixOf` testSet) && isPublic && isNonSensitive let shouldBeShown = not ("test-" `isInfixOf` testSet) && isViewable && isNonSensitive
let mainMetric = testMetric $ entityVal mainTest let mainMetric = testMetric $ entityVal mainTest
@ -272,6 +275,7 @@ viewOutput entry tests (outputHash, testSet) = do
gesTestName = (T.unpack testSet), gesTestName = (T.unpack testSet),
gesSelector = Nothing, gesSelector = Nothing,
gesOutFile = outFile, gesOutFile = outFile,
gesAltOutFiles = Nothing,
gesExpectedFile = "expected.tsv", gesExpectedFile = "expected.tsv",
gesInputFile = "in.tsv", gesInputFile = "in.tsv",
gesMetrics = [mainMetric], gesMetrics = [mainMetric],