From 85c9ad664617ddc24c90c94c3a3207eae0202840 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Filip=20Grali=C5=84ski?= <filipg@amu.edu.pl>
Date: Wed, 6 Jun 2018 10:30:53 +0200
Subject: [PATCH] improve how-to for self-hosted instances and git-annex

---
 Handler/ShowChallenge.hs          | 32 +++++++++----
 Settings.hs                       | 11 +++++
 config/settings.yml               |  1 +
 templates/challenge-how-to.hamlet | 76 +++++++++++++++++++++++--------
 4 files changed, 91 insertions(+), 29 deletions(-)

diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index e6d7eb5..2cbd43e 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -78,7 +78,10 @@ getChallengeHowToR name = do
   maybeUser <- maybeAuth
 
   app <- getYesod
-  let repoHost = appRepoHost $ appSettings app
+  let settings = appSettings app
+
+  let publicRepoId = challengePublicRepo challenge
+  repo <- runDB $ get404 publicRepoId
 
   case maybeUser of
     Just (Entity userId user) -> do
@@ -97,7 +100,7 @@ getChallengeHowToR name = do
       keys <- runDB $ selectList [PublicKeyUser ==. userId] []
       return $ not (null keys)
     Nothing -> return False
-  challengeLayout False challenge (challengeHowTo challenge repoHost (idToBeShown challenge maybeUser) isIDSet isSSHUploaded mToken)
+  challengeLayout False challenge (challengeHowTo challenge settings repo (idToBeShown challenge maybeUser) isIDSet isSSHUploaded mToken)
 
 idToBeShown challenge maybeUser =
   case maybeUser of
@@ -107,21 +110,30 @@ idToBeShown challenge maybeUser =
    Nothing -> defaultIdToBe
   where defaultIdToBe = "YOURID" :: Text
 
-defaultRepo challenge maybeUser = "ssh://gitolite@gonito.net/" ++ (idToBeShown challenge maybeUser) ++ "/" ++ (challengeName challenge)
+defaultRepo SelfHosted challenge _ maybeUser = "ssh://gitolite@gonito.net/" ++ (idToBeShown challenge maybeUser) ++ "/" ++ (challengeName challenge)
+defaultRepo Branches _ repo _ = repoUrl repo
 
-challengeHowTo challenge repoHost idToBeShown isIDSet isSSHUploaded mToken = $(widgetFile "challenge-how-to")
+defaultBranch SelfHosted = Just "master"
+defaultBranch Branches = Nothing
+
+challengeHowTo challenge settings repo idToBeShown isIDSet isSSHUploaded mToken = $(widgetFile "challenge-how-to")
 
 getChallengeSubmissionR :: Text -> Handler Html
 getChallengeSubmissionR name = do
    (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
    maybeUser <- maybeAuth
-   (formWidget, formEnctype) <- generateFormPost $ submissionForm (Just $ defaultRepo challenge maybeUser)
+
+   Just repo <- runDB $ get $ challengePublicRepo challenge
+   app <- getYesod
+   let scheme = appRepoScheme $ appSettings app
+
+   (formWidget, formEnctype) <- generateFormPost $ submissionForm (Just $ defaultRepo scheme challenge repo maybeUser) (defaultBranch scheme) (repoGitAnnexRemote repo)
    challengeLayout True challenge $ challengeSubmissionWidget formWidget formEnctype challenge
 
 postChallengeSubmissionR :: Text -> Handler TypedContent
 postChallengeSubmissionR name = do
     (Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name
-    ((result, formWidget), formEnctype) <- runFormPost $ submissionForm Nothing
+    ((result, formWidget), formEnctype) <- runFormPost $ submissionForm Nothing Nothing Nothing
     let submissionData = case result of
           FormSuccess res -> Just res
           _ -> Nothing
@@ -375,13 +387,13 @@ checkRepoAvailibility challengeId repoId chan = do
 
 challengeSubmissionWidget formWidget formEnctype challenge = $(widgetFile "challenge-submission")
 
-submissionForm :: Maybe Text -> Form (Maybe Text, Maybe Text, Text, Text, Maybe Text)
-submissionForm defaultUrl = renderBootstrap3 BootstrapBasicForm $ (,,,,)
+submissionForm :: Maybe Text -> Maybe Text -> Maybe Text -> Form (Maybe Text, Maybe Text, Text, Text, Maybe Text)
+submissionForm defaultUrl defaultBranch defaultGitAnnexRemote = renderBootstrap3 BootstrapBasicForm $ (,,,,)
     <$> aopt textField (fieldWithTooltip MsgSubmissionDescription MsgSubmissionDescriptionTooltip) Nothing
     <*> aopt textField (tagsfs MsgSubmissionTags) Nothing
     <*> areq textField (bfs MsgSubmissionUrl) defaultUrl
-    <*> areq textField (bfs MsgSubmissionBranch) (Just "master")
-    <*> aopt textField (bfs MsgSubmissionGitAnnexRemote) Nothing
+    <*> areq textField (bfs MsgSubmissionBranch) defaultBranch
+    <*> aopt textField (bfs MsgSubmissionGitAnnexRemote) (Just defaultGitAnnexRemote)
 
 getChallengeMySubmissionsR :: Text -> Handler Html
 getChallengeMySubmissionsR name = do
diff --git a/Settings.hs b/Settings.hs
index 58b12ba..47870db 100644
--- a/Settings.hs
+++ b/Settings.hs
@@ -18,6 +18,13 @@ import Yesod.Default.Config2       (applyEnvValue, configSettingsYml)
 import Yesod.Default.Util          (WidgetFileSettings, widgetFileNoReload,
                                     widgetFileReload)
 
+data RepoScheme = SelfHosted | Branches
+                  deriving(Eq, Show)
+
+toRepoScheme :: Text -> RepoScheme
+toRepoScheme "branches" = Branches
+toRepoScheme _ = SelfHosted
+
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
 -- theoretically even a database.
@@ -63,6 +70,7 @@ data AppSettings = AppSettings
     , appLocation               :: Maybe Text
     -- ^ Repo host
     , appRepoHost               :: Text
+    , appRepoScheme             :: RepoScheme
     }
 
 instance FromJSON AppSettings where
@@ -97,6 +105,9 @@ instance FromJSON AppSettings where
 
         appRepoHost               <- o .: "repo-host"
 
+        scheme <- o .: "repo-scheme"
+        appRepoScheme <- return $ toRepoScheme scheme
+
         return AppSettings {..}
 
 -- | Settings for 'widgetFile', such as which template languages to support and
diff --git a/config/settings.yml b/config/settings.yml
index 3183669..b6df103 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -9,6 +9,7 @@ ip-from-header: "_env:IP_FROM_HEADER:false"
 var-dir:        "_env:VAR_DIR:."
 contact-email:  "_env:CONTACT_EMAIL:filipg@amu.edu.pl"
 repo-host:      "_env:REPO_HOST:ssh://gitolite@gonito.net/"
+repo-scheme:    "_env:REPO_SCHEME:selfhosted"
 
 # Optional values with the following production defaults.
 # In development, they default to the inverse.
diff --git a/templates/challenge-how-to.hamlet b/templates/challenge-how-to.hamlet
index b061afe..1e298b9 100644
--- a/templates/challenge-how-to.hamlet
+++ b/templates/challenge-how-to.hamlet
@@ -29,26 +29,44 @@
 
 <h2>Get your repo
 
-$if not isIDSet || not isSSHUploaded
-  <p>You need to
-     $if not isIDSet
-        \ set up your ID
-        $if not isSSHUploaded
-          \ and
-     $if not isSSHUploaded
-        \ upload your SSH public key
-     \ (see <a href="@{YourAccountR}">your account</a>) if you want to have a repo hosted on Gonito.net, then:
+$case (appRepoScheme settings)
+ $of SelfHosted
+  $if not isIDSet || not isSSHUploaded
+    <p>You need to
+       $if not isIDSet
+          \ set up your ID
+          $if not isSSHUploaded
+            \ and
+       $if not isSSHUploaded
+          \ upload your SSH public key
+       \ (see <a href="@{YourAccountR}">your account</a>) if you want to have a repo hosted on Gonito.net, then:
 
-<pre>
-  git clone #{repoHost}#{idToBeShown}/#{challengeName challenge}
+  <pre>
+    git clone #{appRepoHost settings}#{idToBeShown}/#{challengeName challenge}
 
-<p>(Warning about empty repository is expected, don't worry about it.)
+  <p>(Warning about empty repository is expected, don't worry about it.)
 
-<pre>
-  cd #{challengeName challenge}
-  git pull #{repoHost}#{challengeName challenge}
+  <pre>
+    cd #{challengeName challenge}
+    git pull #{appRepoHost settings}#{challengeName challenge}
 
-<p>(Alternatively, you can use any other Git repo, e.g. GitHub, make sure Gonito.net has access to your repo.)
+  <p>(Alternatively, you can use any other Git repo, e.g. GitLab, make sure Gonito.net has access to your repo.)
+ $of Branches
+    <p>Clone the repo:
+
+    <pre>
+      git clone #{repoUrl repo}
+
+    $maybe gitAnnexRemote <- (repoGitAnnexRemote repo)
+      <pre>
+        git annex init
+        git annex initremote storage #{gitAnnexRemote}
+        git annex get --from storage
+
+    <p>Switch to some branch, let's say <tt>my-brilliant-solution</tt>:
+
+    <pre>
+      git checkout -b my-brilliant-solution
 
 <h2>Work on your solution
 
@@ -66,9 +84,29 @@ $if not isIDSet || not isSSHUploaded
 
 <pre>
   cd #{challengeName challenge}
-  git add dev-0/out.tsv test-A/out.tsv # also your source codes could be added
+  git add foo.py build.sh # add your source codes
+
+$maybe gitAnnexRemote <- (repoGitAnnexRemote repo)
+  <pre>
+    # if your output files are large or if they should not pushed to the regular repo (e.g. contain sensitive information):
+    git annex add dev-0/out.tsv test-A/out.tsv
+    git annex copy --to storage
+    # otherwise (e.g. they are just class labels), add the output files in a regular manner:
+    git add dev-0/out.tsv test-A/out.tsv
+$nothing
+  <pre>
+    git add dev-0/out.tsv test-A/out.tsv # add your output files
+
+<pre>
   git commit -m 'my brilliant solution'
-  git push origin master
+
+$case (appRepoScheme settings)
+  $of SelfHosted
+    <pre>
+      git push origin master
+  $of Branches
+    <pre>
+      git push origin my-brilliant-solution:my-brilliant-solution
 
 <h3>Repos hosted on Gonito.net
 
@@ -80,7 +118,7 @@ $if not isIDSet || not isSSHUploaded
 $maybe token <- mToken
    <p>Your webook is:
    <pre>
-     https://gonito.net/trigger-remotely?token=#{token}&branch=master&challenge=#{challengeName challenge}&url=URL_TO_YOUR_REPO
+     #{appRoot settings}/trigger-remotely?token=#{token}&branch=master&challenge=#{challengeName challenge}&url=URL_TO_YOUR_REPO
    <p>(must be POSTed)
 
 <h3>Manual submission