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

Application.hs

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

Handler/MakePublic.hs

@@ -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

Handler/Query.hs

@@ -3,6 +3,7 @@ module Handler.Query where
 import Import
 
 import Handler.Tables (formatSubmitter)
+import Handler.Shared
 import PersistSHA1
 
 import Database.Persist.Sql
@@ -12,22 +13,27 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
                               withSmallInput)
 
 data FullSubmissionInfo = FullSubmissionInfo {
+  fsiSubmissionId :: SubmissionId,
   fsiSubmission :: Submission,
   fsiUser :: User,
-  fsiRepo :: Repo }
+  fsiRepo :: Repo,
+  fsiChallenge :: Challenge }
 
 getFullInfo :: Entity Submission -> Handler FullSubmissionInfo
 getFullInfo (Entity submissionId submission) = do
   repo <- runDB $ get404 $ submissionRepo submission
   user <- runDB $ get404 $ submissionSubmitter submission
+  challenge <- runDB $ get404 $ submissionChallenge submission
   return $ FullSubmissionInfo {
+    fsiSubmissionId = submissionId,
     fsiSubmission = submission,
     fsiUser = user,
-    fsiRepo = repo }
+    fsiRepo = repo,
+    fsiChallenge = challenge }
 
 findSubmissions :: Text -> Handler [FullSubmissionInfo]
 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
 
 getQueryFormR :: Handler Html
@@ -62,9 +68,13 @@ processQuery query = do
     setTitle "query results"
     $(widgetFile "query-results")
 
-queryResult submission = $(widgetFile "query-result")
+queryResult submission = do
+  $(widgetFile "query-result")
     where commitSha1AsText = fromSHA1ToText $ submissionCommit $ fsiSubmission 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
 
 queryForm :: Form Text

Handler/Shared.hs

@@ -27,6 +27,9 @@ import PersistSHA1
 
 import qualified Data.ByteString as BS
 
+import Text.Printf
+import Database.Persist.Sql
+
 atom = Control.Concurrent.STM.atomically
 
 type Channel = TChan (Maybe Text)
@@ -42,6 +45,28 @@ gitPath = "/usr/bin/git"
 browsableGitSite :: Text
 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 bareRepoName
   | ".git" `isSuffixOf` bareRepoName = browsableGitSite ++ bareRepoName

config/routes

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

gonito.cabal

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

templates/query-form.hamlet

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

templates/query-result.hamlet

@@ -2,5 +2,7 @@
 <div .subm-description>#{submissionDescription $ fsiSubmission submission}
 <div .subm-user>#{submitter}
 <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>