only public submissions are listed when queried

This commit is contained in:
Filip Gralinski 2016-02-15 12:42:05 +01:00
parent 923b1fe8f0
commit 4e3523e3db
5 changed files with 46 additions and 13 deletions

View File

@ -6,9 +6,6 @@ import Handler.Shared
import PersistSHA1 import PersistSHA1
import Text.Printf
import Database.Persist.Sql
import Data.Text as T import Data.Text as T
getMakePublicR :: SubmissionId -> Handler TypedContent getMakePublicR :: SubmissionId -> Handler TypedContent
@ -23,15 +20,15 @@ doMakePublic submissionId chan = do
else do else do
msg chan "Making the submission public..." msg chan "Making the submission public..."
runDB $ update submissionId [SubmissionIsPublic =. True] runDB $ update submissionId [SubmissionIsPublic =. True]
let targetBranchName = printf "submission-%05d" $ fromSqlKey submissionId
submission <- runDB $ get404 submissionId submission <- runDB $ get404 submissionId
challenge <- runDB $ get404 $ submissionChallenge submission challenge <- runDB $ get404 $ submissionChallenge submission
let submissionRepoId = submissionRepo submission let submissionRepoId = submissionRepo submission
submissionRepoDir <- getRepoDir submissionRepoId submissionRepoDir <- getRepoDir submissionRepoId
let targetRepoUrl = T.unpack $ gitServer ++ challengeName challenge let targetRepoUrl = getPublicSubmissionUrl $ challengeName challenge
msg chan $ T.pack $ "Start pushing from " ++ submissionRepoDir ++ " to repo " ++ targetRepoUrl ++ ", branch " ++ targetBranchName ++ " ..." let targetBranchName = getPublicSubmissionBranch submissionId
msg chan $ "Start pushing from " ++ (T.pack submissionRepoDir) ++ " to repo " ++ targetRepoUrl ++ ", branch " ++ targetBranchName ++ " ..."
let commit = submissionCommit submission let commit = submissionCommit submission
pushRepo submissionRepoDir commit targetRepoUrl targetBranchName chan pushRepo submissionRepoDir commit (T.unpack $ targetRepoUrl) (T.unpack $ targetBranchName) chan
return () return ()

View File

@ -3,6 +3,7 @@ module Handler.Query where
import Import import Import
import Handler.Tables (formatSubmitter) import Handler.Tables (formatSubmitter)
import Handler.Shared
import PersistSHA1 import PersistSHA1
import Database.Persist.Sql import Database.Persist.Sql
@ -12,22 +13,27 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
withSmallInput) withSmallInput)
data FullSubmissionInfo = FullSubmissionInfo { data FullSubmissionInfo = FullSubmissionInfo {
fsiSubmissionId :: SubmissionId,
fsiSubmission :: Submission, fsiSubmission :: Submission,
fsiUser :: User, fsiUser :: User,
fsiRepo :: Repo } fsiRepo :: Repo,
fsiChallenge :: Challenge }
getFullInfo :: Entity Submission -> Handler FullSubmissionInfo getFullInfo :: Entity Submission -> Handler FullSubmissionInfo
getFullInfo (Entity submissionId submission) = do getFullInfo (Entity submissionId submission) = do
repo <- runDB $ get404 $ submissionRepo submission repo <- runDB $ get404 $ submissionRepo submission
user <- runDB $ get404 $ submissionSubmitter submission user <- runDB $ get404 $ submissionSubmitter submission
challenge <- runDB $ get404 $ submissionChallenge submission
return $ FullSubmissionInfo { return $ FullSubmissionInfo {
fsiSubmissionId = submissionId,
fsiSubmission = submission, fsiSubmission = submission,
fsiUser = user, fsiUser = user,
fsiRepo = repo } fsiRepo = repo,
fsiChallenge = challenge }
findSubmissions :: Text -> Handler [FullSubmissionInfo] findSubmissions :: Text -> Handler [FullSubmissionInfo]
findSubmissions sha1Prefix = do findSubmissions sha1Prefix = do
submissions <- runDB $ rawSql "SELECT ?? FROM submission WHERE cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"] submissions <- runDB $ rawSql "SELECT ?? FROM submission WHERE is_public AND cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
mapM getFullInfo submissions mapM getFullInfo submissions
getQueryFormR :: Handler Html getQueryFormR :: Handler Html
@ -62,9 +68,13 @@ processQuery query = do
setTitle "query results" setTitle "query results"
$(widgetFile "query-results") $(widgetFile "query-results")
queryResult submission = $(widgetFile "query-result") queryResult submission = do
$(widgetFile "query-result")
where commitSha1AsText = fromSHA1ToText $ submissionCommit $ fsiSubmission submission where commitSha1AsText = fromSHA1ToText $ submissionCommit $ fsiSubmission submission
submitter = formatSubmitter $ fsiUser submission submitter = formatSubmitter $ fsiUser submission
publicSubmissionBranch = getPublicSubmissionBranch $ fsiSubmissionId submission
publicSubmissionRepo = getReadOnlySubmissionUrl $ challengeName $ fsiChallenge submission
browsableUrl = browsableGitRepoBranch (challengeName $ fsiChallenge submission) publicSubmissionBranch
stamp = T.pack $ show $ submissionStamp $ fsiSubmission submission stamp = T.pack $ show $ submissionStamp $ fsiSubmission submission
queryForm :: Form Text queryForm :: Form Text

View File

@ -27,6 +27,9 @@ import PersistSHA1
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Text.Printf
import Database.Persist.Sql
atom = Control.Concurrent.STM.atomically atom = Control.Concurrent.STM.atomically
type Channel = TChan (Maybe Text) type Channel = TChan (Maybe Text)
@ -42,8 +45,27 @@ gitPath = "/usr/bin/git"
browsableGitSite :: Text browsableGitSite :: Text
browsableGitSite = "http://gonito.net/gitlist/" browsableGitSite = "http://gonito.net/gitlist/"
serverAddress :: Text
serverAddress = "gonito.net"
gitServer :: Text gitServer :: Text
gitServer = "ssh://gitolite@gonito.net/" gitServer = "ssh://gitolite@" ++ serverAddress ++ "/"
gitReadOnlyServer :: Text
gitReadOnlyServer = "git://" ++ serverAddress ++ "/"
getPublicSubmissionBranch :: SubmissionId -> Text
getPublicSubmissionBranch = T.pack . (printf "submission-%05d") . fromSqlKey
getPublicSubmissionUrl :: Text -> Text
getPublicSubmissionUrl bareRepoName = gitServer ++ bareRepoName
getReadOnlySubmissionUrl :: Text -> Text
getReadOnlySubmissionUrl bareRepoName = gitReadOnlyServer ++ bareRepoName
browsableGitRepoBranch :: Text -> Text -> Text
browsableGitRepoBranch bareRepoName branch = (browsableGitRepo bareRepoName) ++ "/" ++ branch ++ "/"
browsableGitRepo :: Text -> Text browsableGitRepo :: Text -> Text
browsableGitRepo bareRepoName browsableGitRepo bareRepoName

View File

@ -1,5 +1,7 @@
<h2>Search for submission by Git commit SHA1 hashes: <h2>Search for submission by Git commit SHA1 hashes:
<p>(Only public submissions will be returned.)
<p> <p>
<form method=post action=@{QueryFormR}#form enctype=#{formEnctype}> <form method=post action=@{QueryFormR}#form enctype=#{formEnctype}>
^{formWidget} ^{formWidget}

View File

@ -2,5 +2,7 @@
<div .subm-description>#{submissionDescription $ fsiSubmission submission} <div .subm-description>#{submissionDescription $ fsiSubmission submission}
<div .subm-user>#{submitter} <div .subm-user>#{submitter}
<div .subm-stamp>#{stamp} <div .subm-stamp>#{stamp}
<div .subm-repo>#{repoUrl $ fsiRepo submission} / #{repoBranch $ fsiRepo submission} <div .subm-repo>taken from: #{repoUrl $ fsiRepo submission} / branch #{repoBranch $ fsiRepo submission}
<div .subm-repo>publicly available at: #{publicSubmissionRepo} / branch #{publicSubmissionBranch}
<div .subm-browsable>browsable at: <a href="#{browsableUrl}">#{browsableUrl}</a>
<hr> <hr>