Repo details are not shown by default

This commit is contained in:
Filip Gralinski 2021-08-21 16:54:54 +02:00
parent 9f4942a657
commit 324107c89c
7 changed files with 31 additions and 32 deletions

View File

@ -83,12 +83,11 @@ getPossibleAchievements userId submissionId = do
doEditSubmission formWidget formEnctype submissionId mVariantId = do doEditSubmission formWidget formEnctype submissionId mVariantId = do
submission <- runDB $ get404 submissionId submission <- runDB $ get404 submissionId
submissionFull <- getFullInfo (Entity submissionId submission) submissionFull <- getFullInfo (Entity submissionId submission)
let view = queryResult submissionFull (Entity userId _) <- requireAuth
let view = queryResult (Just userId) submissionFull
tagsAvailableAsJSON <- runDB $ getAvailableTagsAsJSON tagsAvailableAsJSON <- runDB $ getAvailableTagsAsJSON
(Entity userId _) <- requireAuth
achievements <- runDB $ getPossibleAchievements userId submissionId achievements <- runDB $ getPossibleAchievements userId submissionId
variantParams <- case mVariantId of variantParams <- case mVariantId of

View File

@ -149,7 +149,6 @@ 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
allSubmissions <- runDB $ rawCommitQuery sha1Prefix allSubmissions <- runDB $ rawCommitQuery sha1Prefix
justSubmissions' <- mapM getFullInfo allSubmissions justSubmissions' <- mapM getFullInfo allSubmissions
let justSubmissions = map (\s -> (s, [])) justSubmissions' let justSubmissions = map (\s -> (s, [])) justSubmissions'
@ -275,6 +274,8 @@ isFullQuery query = length query == 40
processQuery :: Text -> Handler Html processQuery :: Text -> Handler Html
processQuery query = do processQuery query = do
mUserId <- maybeAuthId
submissions' <- findSubmissions query submissions' <- findSubmissions query
let submissions = map fst submissions' let submissions = map fst submissions'
defaultLayout $ do defaultLayout $ do
@ -365,7 +366,6 @@ data ViewVariantData = ViewVariantData {
fetchViewVariantData :: VariantId -> Handler ViewVariantData fetchViewVariantData :: VariantId -> Handler ViewVariantData
fetchViewVariantData variantId = do fetchViewVariantData variantId = do
mauthId <- maybeAuth
variant <- runDB $ get404 variantId variant <- runDB $ get404 variantId
let theSubmissionId = variantSubmission variant let theSubmissionId = variantSubmission variant
theSubmission <- runDB $ get404 theSubmissionId theSubmission <- runDB $ get404 theSubmissionId
@ -423,6 +423,8 @@ nullSHA1 = fromTextToSHA1 "da39a3ee5e6b4b0d3255bfef95601890afd80709"
doViewVariantTestR :: Diff VariantId -> TestId -> Handler Html doViewVariantTestR :: Diff VariantId -> TestId -> Handler Html
doViewVariantTestR variantId testId = do doViewVariantTestR variantId testId = do
mUserId <- maybeAuthId
testSelected <- runDB $ get404 testId testSelected <- runDB $ get404 testId
let testSelectedEnt = Entity testId testSelected let testSelectedEnt = Entity testId testSelected
@ -504,7 +506,7 @@ maximumNumberOfItemsToBeShown :: Int
maximumNumberOfItemsToBeShown = 40 maximumNumberOfItemsToBeShown = 40
getOut :: Maybe UserId -> TableEntry -> WidgetFor App (Maybe (FilePath, FilePath)) getOut :: Maybe UserId -> TableEntry -> WidgetFor App (Maybe (FilePath, FilePath))
getOut mauthId entry = do getOut _ entry = do
let variant = variantName $ entityVal $ tableEntryVariant entry let variant = variantName $ entityVal $ tableEntryVariant entry
let isViewable = True let isViewable = True
@ -691,8 +693,16 @@ adjustNumberOfColumnsShown maximumNumberOfColumns tests = adjustNumberOfColumnsS
minimumNumberOfTests = 2 minimumNumberOfTests = 2
submissionHeader :: Diff (FullSubmissionInfo, Maybe Text) -> WidgetFor App () canFullInfoBeShown (OneThing (fsi, _)) mUserId = checkWhetherVisible (fsiSubmission fsi) mUserId
submissionHeader param = canFullInfoBeShown (TwoThings (fsiA, _) (fsiB, _)) mUserId = do
checkA <- checkWhetherVisible (fsiSubmission fsiA) mUserId
checkB <- checkWhetherVisible (fsiSubmission fsiB) mUserId
return (checkA && checkB)
submissionHeader :: Maybe UserId -> Diff (FullSubmissionInfo, Maybe Text) -> WidgetFor App ()
submissionHeader mUserId param = do
showFullInfo <- handlerToWidget $ runDB $ canFullInfoBeShown param mUserId
$(widgetFile "submission-header") $(widgetFile "submission-header")
where variantSettings = ("out", ()) where variantSettings = ("out", ())
submission = fst <$> param submission = fst <$> param
@ -707,9 +717,8 @@ submissionHeader param =
submissionToSubmissionUrl submission' = getReadOnlySubmissionUrl (fsiScheme submission') (fsiChallengeRepo submission') $ challengeName $ fsiChallenge submission' submissionToSubmissionUrl submission' = getReadOnlySubmissionUrl (fsiScheme submission') (fsiChallengeRepo submission') $ challengeName $ fsiChallenge submission'
submissionToBrowsableUrl submission' = browsableGitRepoBranch (fsiScheme submission') (fsiChallengeRepo submission') (challengeName $ fsiChallenge submission') (getPublicSubmissionBranch $ fsiSubmissionId submission') submissionToBrowsableUrl submission' = browsableGitRepoBranch (fsiScheme submission') (fsiChallengeRepo submission') (challengeName $ fsiChallenge submission') (getPublicSubmissionBranch $ fsiSubmissionId submission')
queryResult :: Maybe UserId -> FullSubmissionInfo -> WidgetFor App ()
queryResult :: FullSubmissionInfo -> WidgetFor App () queryResult mUserId submission = do
queryResult submission = do
$(widgetFile "query-result") $(widgetFile "query-result")
queryForm :: Form Text queryForm :: Form Text

View File

@ -295,19 +295,9 @@ statusCellWidget challengeName repoScheme challengeRepo (submissionId, submissio
Nothing Nothing
getInfoLink :: Submission -> Maybe UserId -> Maybe (Route App) getInfoLink :: Submission -> Maybe UserId -> Maybe (Route App)
getInfoLink submission mauthId = if checkSimpleVisibility submission mauthId getInfoLink submission _ = Just $ QueryResultsR commitHash
then Just $ QueryResultsR commitHash
else Nothing
where commitHash = fromSHA1ToText $ submissionCommit submission where commitHash = fromSHA1ToText $ submissionCommit submission
-- sometimes we checker whether we got a teacher, but sometimes
-- fall back to a simpler check...
checkSimpleVisibility :: Submission -> Maybe UserId -> Bool
checkSimpleVisibility submission mauthId = isPublic || isOwner
where isPublic = submissionIsPublic submission
isOwner = (mauthId == Just userId)
userId = submissionSubmitter submission
checkWhetherVisible :: (MonadIO m, BackendCompatible SqlBackend backend, PersistQueryRead backend, PersistUniqueRead backend) checkWhetherVisible :: (MonadIO m, BackendCompatible SqlBackend backend, PersistQueryRead backend, PersistUniqueRead backend)
=> Submission -> Maybe (Key User) -> ReaderT backend m Bool => Submission -> Maybe (Key User) -> ReaderT backend m Bool
checkWhetherVisible submission Nothing = return $ submissionIsPublic submission checkWhetherVisible submission Nothing = return $ submissionIsPublic submission

View File

@ -3,10 +3,10 @@
<p class="media-object"> <p class="media-object">
<span class="glyphicon glyphicon-asterisk" aria-hidden="hidden"> <span class="glyphicon glyphicon-asterisk" aria-hidden="hidden">
<div class="media-body"> <div class="media-body">
^{submissionHeader (OneThing (submission, Nothing))} ^{submissionHeader mUserId (OneThing (submission, Nothing))}
^{resultTable (Entity (fsiSubmissionId submission) (fsiSubmission submission))} ^{resultTable (Entity (fsiSubmissionId submission) (fsiSubmission submission))}
$if not (null (fsiSuperSubmissions submission)) $if not (null (fsiSuperSubmissions submission))
<h4>downstream submissions <h4>downstream submissions
$forall superSubmission <- (fsiSuperSubmissions submission) $forall superSubmission <- (fsiSuperSubmissions submission)
^{queryResult superSubmission} ^{queryResult mUserId superSubmission}

View File

@ -5,5 +5,5 @@ $if null submissions
<p>No results found. <p>No results found.
$else $else
$forall submission <- submissions $forall submission <- submissions
^{queryResult submission} ^{queryResult mUserId submission}
<hr> <hr>

View File

@ -10,6 +10,7 @@
<dd>#{submitter} <dd>#{submitter}
<dt>submitted <dt>submitted
<dd>#{stamp} <dd>#{stamp}
$if showFullInfo
<dt>original repo <dt>original repo
<dd> <dd>
$maybe (url, branchPart) <- getHttpLink (fsiRepo $ current submission) $maybe (url, branchPart) <- getHttpLink (fsiRepo $ current submission)

View File

@ -3,7 +3,7 @@
<p class="media-object"> <p class="media-object">
<span class="glyphicon glyphicon-asterisk" aria-hidden="hidden"> <span class="glyphicon glyphicon-asterisk" aria-hidden="hidden">
<div class="media-body"> <div class="media-body">
^{submissionHeader fullSubmissionInfo} ^{submissionHeader mUserId fullSubmissionInfo}
$case tableEntryParams <$> entry $case tableEntryParams <$> entry
$of OneThing [] $of OneThing []