Merge branch 'master' of ssh://gonito.net/gonito

This commit is contained in:
veal 2016-02-15 14:54:15 +01:00
commit e9c7be5ed3
8 changed files with 94 additions and 5 deletions

View File

@ -41,6 +41,7 @@ import Handler.Graph
import Handler.Home import Handler.Home
import Handler.CreateChallenge import Handler.CreateChallenge
import Handler.ListChallenges import Handler.ListChallenges
import Handler.MakePublic
import Handler.Query import Handler.Query
import Handler.ShowChallenge import Handler.ShowChallenge
import Handler.Shared import Handler.Shared

47
Handler/MakePublic.hs Normal file
View File

@ -0,0 +1,47 @@
module Handler.MakePublic where
import Import
import Handler.Shared
import PersistSHA1
import Data.Text as T
getMakePublicR :: SubmissionId -> Handler TypedContent
getMakePublicR submissionId = runViewProgress $ doMakePublic submissionId
doMakePublic :: SubmissionId -> Channel -> Handler ()
doMakePublic submissionId chan = do
isOwner <- checkWhetherUserRepo submissionId
if not isOwner
then
err chan "Only the submitter can make a submission public!"
else do
msg chan "Making the submission public..."
runDB $ update submissionId [SubmissionIsPublic =. True]
submission <- runDB $ get404 submissionId
challenge <- runDB $ get404 $ submissionChallenge submission
let submissionRepoId = submissionRepo submission
submissionRepoDir <- getRepoDir submissionRepoId
let targetRepoUrl = getPublicSubmissionUrl $ challengeName challenge
let targetBranchName = getPublicSubmissionBranch submissionId
msg chan $ "Start pushing from " ++ (T.pack submissionRepoDir) ++ " to repo " ++ targetRepoUrl ++ ", branch " ++ targetBranchName ++ " ..."
let commit = submissionCommit submission
pushRepo submissionRepoDir commit (T.unpack $ targetRepoUrl) (T.unpack $ targetBranchName) chan
return ()
pushRepo :: String -> SHA1 -> String -> String -> Channel -> Handler ()
pushRepo repoDir commit targetRepoUrl targetBranchName chan = do
(exitCode, _) <- runProgram (Just repoDir) gitPath [
"push",
targetRepoUrl,
(T.unpack $ fromSHA1ToText commit) ++ ":refs/heads/" ++ targetBranchName] chan
return ()
checkWhetherUserRepo :: SubmissionId -> Handler Bool
checkWhetherUserRepo submissionId = do
submission <- runDB $ get404 submissionId
userId <- requireAuthId
return $ userId == submissionSubmitter submission

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,6 +45,28 @@ 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 = "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
| ".git" `isSuffixOf` bareRepoName = browsableGitSite ++ bareRepoName | ".git" `isSuffixOf` bareRepoName = browsableGitSite ++ bareRepoName

View File

@ -22,5 +22,6 @@
/q QueryFormR GET POST /q QueryFormR GET POST
/q/#Text QueryResultsR GET /q/#Text QueryResultsR GET
/make-public/#SubmissionId MakePublicR GET
/account YourAccountR GET POST /account YourAccountR GET POST

View File

@ -35,6 +35,7 @@ library
Handler.Graph Handler.Graph
Handler.Home Handler.Home
Handler.ListChallenges Handler.ListChallenges
Handler.MakePublic
Handler.Shared Handler.Shared
Handler.ShowChallenge Handler.ShowChallenge
Handler.Extract Handler.Extract

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>