filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

start handling git-annex remote

Browse Source
This commit is contained in:
Filip Gralinski 2018-06-05 07:46:42 +02:00
parent 06970317a7
commit f1502c16e4
4 changed files with 22 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
Handler/CreateChallenge.hs
View File

@ -39,25 +39,28 @@ postCreateChallengeR = do
challengeData = case result of challengeData = case result of
FormSuccess res -> Just res FormSuccess res -> Just res
_ -> Nothing _ -> Nothing
Just (name, publicUrl, publicBranch, privateUrl, privateBranch) = challengeData Just (name, publicUrl, publicBranch, publicGitAnnexRemote,
privateUrl, privateBranch, privateGitAnnexRemote) = challengeData
userId <- requireAuthId userId <- requireAuthId
user <- runDB $ get404 userId user <- runDB $ get404 userId
if userIsAdmin user if userIsAdmin user
then then
runViewProgress $ doCreateChallenge name publicUrl publicBranch privateUrl privateBranch runViewProgress $ doCreateChallenge name publicUrl publicBranch publicGitAnnexRemote privateUrl privateBranch privateGitAnnexRemote
else else
runViewProgress $ (flip err) "MUST BE AN ADMIN TO CREATE A CHALLENGE" runViewProgress $ (flip err) "MUST BE AN ADMIN TO CREATE A CHALLENGE"
doCreateChallenge :: Text -> Text -> Text -> Text -> Text -> Channel -> Handler () doCreateChallenge :: Text -> Text -> Text -> Maybe Text -> Text -> Text -> Maybe Text -> Channel -> Handler ()
doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do doCreateChallenge name publicUrl publicBranch publicGitAnnexRemote privateUrl privateBranch privateGitAnnexRemote chan = do
maybePublicRepoId <- cloneRepo (RepoCloningSpec { maybePublicRepoId <- cloneRepo (RepoCloningSpec {
cloningSpecRepo = RepoSpec { cloningSpecRepo = RepoSpec {
repoSpecUrl = publicUrl, repoSpecUrl = publicUrl,
repoSpecBranch = publicBranch }, repoSpecBranch = publicBranch,
repoSpecGitAnnexRemote = publicGitAnnexRemote},
cloningSpecReferenceRepo = RepoSpec { cloningSpecReferenceRepo = RepoSpec {
repoSpecUrl = publicUrl, repoSpecUrl = publicUrl,
repoSpecBranch = publicBranch}}) chan repoSpecBranch = publicBranch,
repoSpecGitAnnexRemote = publicGitAnnexRemote}}) chan
case maybePublicRepoId of case maybePublicRepoId of
Just publicRepoId -> do Just publicRepoId -> do
publicRepo <- runDB $ get404 publicRepoId publicRepo <- runDB $ get404 publicRepoId
@ -65,10 +68,12 @@ doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do
maybePrivateRepoId <- cloneRepo (RepoCloningSpec { maybePrivateRepoId <- cloneRepo (RepoCloningSpec {
cloningSpecRepo = RepoSpec { cloningSpecRepo = RepoSpec {
repoSpecUrl = privateUrl, repoSpecUrl = privateUrl,
repoSpecBranch = privateBranch }, repoSpecBranch = privateBranch,
repoSpecGitAnnexRemote = privateGitAnnexRemote},
cloningSpecReferenceRepo = RepoSpec { cloningSpecReferenceRepo = RepoSpec {
repoSpecUrl =(T.pack $ publicRepoDir), repoSpecUrl =(T.pack $ publicRepoDir),
repoSpecBranch = (repoBranch publicRepo)}}) chan repoSpecBranch = (repoBranch publicRepo),
repoSpecGitAnnexRemote = (repoGitAnnexRemote publicRepo)}}) chan
case maybePrivateRepoId of case maybePrivateRepoId of
Just privateRepoId -> addChallenge name publicRepoId privateRepoId chan Just privateRepoId -> addChallenge name publicRepoId privateRepoId chan
Nothing -> return () Nothing -> return ()
@ -174,10 +179,12 @@ never = depth ==? 0
testDirFilter :: FindClause Bool testDirFilter :: FindClause Bool
testDirFilter = (fileType ==? Directory) &&? (SFF.fileName ~~? "dev-*" ||? SFF.fileName ~~? "test-*") testDirFilter = (fileType ==? Directory) &&? (SFF.fileName ~~? "dev-*" ||? SFF.fileName ~~? "test-*")
sampleForm :: Form (Text, Text, Text, Text, Text) sampleForm :: Form (Text, Text, Text, Maybe Text, Text, Text, Maybe Text)
sampleForm = renderBootstrap3 BootstrapBasicForm $ (,,,,) sampleForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,)
<$> areq textField (fieldSettingsLabel MsgName) Nothing <$> areq textField (fieldSettingsLabel MsgName) Nothing
<*> areq textField (fieldSettingsLabel MsgPublicUrl) Nothing <*> areq textField (fieldSettingsLabel MsgPublicUrl) Nothing
<*> areq textField (fieldSettingsLabel MsgBranch) Nothing <*> areq textField (fieldSettingsLabel MsgBranch) Nothing
<*> aopt textField (fieldSettingsLabel MsgGitAnnexRemote) Nothing
<*> areq textField (fieldSettingsLabel MsgPrivateUrl) Nothing <*> areq textField (fieldSettingsLabel MsgPrivateUrl) Nothing
<*> areq textField (fieldSettingsLabel MsgBranch) Nothing <*> areq textField (fieldSettingsLabel MsgBranch) Nothing
<*> aopt textField (fieldSettingsLabel MsgGitAnnexRemote) Nothing

4
Handler/Shared.hs
View File

@ -129,7 +129,8 @@ data RepoCloningSpec = RepoCloningSpec {
data RepoSpec = RepoSpec { data RepoSpec = RepoSpec {
repoSpecUrl :: Text, repoSpecUrl :: Text,
repoSpecBranch :: Text repoSpecBranch :: Text,
repoSpecGitAnnexRemote :: Maybe Text
} }
cloneRepo :: RepoCloningSpec -> Channel -> Handler (Maybe (Key Repo)) cloneRepo :: RepoCloningSpec -> Channel -> Handler (Maybe (Key Repo))
@ -209,6 +210,7 @@ cloneRepo' repoCloningSpec chan = do
repoId <- runDB $ insert $ Repo { repoId <- runDB $ insert $ Repo {
repoUrl=url, repoUrl=url,
repoBranch=repoSpecBranch $ cloningSpecRepo repoCloningSpec, repoBranch=repoSpecBranch $ cloningSpecRepo repoCloningSpec,
repoGitAnnexRemote=repoSpecGitAnnexRemote $ cloningSpecRepo repoCloningSpec,
repoCurrentCommit=commitRaw, repoCurrentCommit=commitRaw,
repoOwner=userId, repoOwner=userId,
repoReady=True, repoReady=True,

1
config/models
View File

@ -26,6 +26,7 @@ Repo
owner UserId owner UserId
ready Bool default=False ready Bool default=False
stamp UTCTime default=now() stamp UTCTime default=now()
gitAnnexRemote Text Maybe
UniqueUrlBranch url branch UniqueUrlBranch url branch
deriving Show deriving Show
Challenge Challenge

1
messages/en.msg
View File

@ -58,3 +58,4 @@ User: User
Manage: manage Manage: manage
Presentation: presentation Presentation: presentation
GonitoInClass: Gonito in class GonitoInClass: Gonito in class
GitAnnexRemote: git-annex remote (if needed)