Add "writable" flag to repo required for pushing

6 files changed, 208 insertions, 49 deletions

diff --git a/src/Command.hs b/src/Command.hs
index 452be9d..9dd6f35 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -37,7 +37,7 @@ import Repo
 
 data CommonOptions = CommonOptions
     { optJobs :: Int
-    , optRepo :: [ ( RepoName, FilePath ) ]
+    , optRepo :: [ ( RepoName, ( Bool, FilePath ) ) ]
     , optDestination :: [ ( DestinationName, Text ) ]
     }
 
diff --git a/src/Config.hs b/src/Config.hs
index 651b05c..885e9a8 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -188,10 +188,11 @@ parsePush = withSeq "Push list" $ mapM $
 
 parseRepo :: Text -> Node Pos -> Parser DeclaredRepo
 parseRepo name node = choice
-    [ flip (withNull "Repo") node $ return $ DeclaredRepo (RepoName name) Nothing
+    [ flip (withNull "Repo") node $ return $ DeclaredRepo (RepoName name) Nothing False
     , flip (withMap "Repo") node $ \r -> DeclaredRepo
         <$> pure (RepoName name)
         <*> (fmap T.unpack <$> r .:? "path")
+        <*> (fromMaybe False <$> r .:? "writable")
     ]
 
 parseDestination :: Text -> Node Pos -> Parser DeclaredDestination
diff --git a/src/Main.hs b/src/Main.hs
index 647231d..e1fbee9 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -62,16 +62,11 @@ options =
         (ReqArg (\num opts -> return opts { optCommon = (optCommon opts) { optJobs = read num }}) "<num>")
         ("number of jobs to run simultaneously (default " <> show (optJobs defaultCommonOptions) <> ")")
     , Option [] [ "repo" ]
-        (ReqArg (\value opts ->
-            case span (/= ':') value of
-                ( repo, ':' : path ) -> return opts
-                    { optCommon = (optCommon opts)
-                        { optRepo = ( RepoName $ T.pack repo, path ) : optRepo (optCommon opts)
-                        }
-                    }
-                _ -> throwError $ "--repo: invalid value ‘" <> value <> "’"
-        ) "<repo>:<path>")
+        (repoOption "repo" False)
         ("override or declare repo path")
+    , Option [] [ "writable-repo" ]
+        (repoOption "writable-repo" True)
+        ("override or declare repo path and open it as writable")
     , Option [] [ "destination" ]
         (ReqArg (\value opts ->
             case span (/= ':') value of
@@ -97,6 +92,18 @@ options =
         "use test-style output to <path> or standard output"
     ]
 
+  where
+    repoOption optname writable =
+        (ReqArg (\value opts ->
+            case span (/= ':') value of
+                ( repo, ':' : path ) -> return opts
+                    { optCommon = (optCommon opts)
+                        { optRepo = ( RepoName $ T.pack repo, ( writable, path ) ) : optRepo (optCommon opts)
+                        }
+                    }
+                _ -> throwError $ "--" <> optname <> ": invalid value ‘" <> value <> "’"
+        ) "<repo>:<path>")
+
 data SomeCommandType = forall c. Command c => SC (Proxy c)
 
 commands :: NE.NonEmpty SomeCommandType
@@ -212,12 +219,12 @@ runSomeCommand rootPath gopts (SC tproxy) args = do
                     Right config -> return ( path, JobRootConfig config )
                     Left err -> reportFailure $ "Failed to parse job file ‘" <> path <> "’:" <> err
                 False -> doesDirectoryExist path >>= \case
-                    True -> openRepo path >>= \case
+                    True -> openRepo False path >>= \case
                         Just repo -> return ( path, JobRootRepo repo )
                         Nothing -> reportFailure $ "Failed to open repository ‘" <> path <> "’"
                     False -> reportFailure $ "File or directory ‘" <> path <> "’ not found"
         Nothing -> do
-            openRepo "." >>= \case
+            openRepo False "." >>= \case
                 Just repo -> return ( ".", JobRootRepo repo )
                 Nothing -> findConfig >>= \case
                     Just path -> BL.readFile path >>= return . parseConfig >>= \case
@@ -253,11 +260,11 @@ runSomeCommand rootPath gopts (SC tproxy) args = do
 
     ciContainingRepo <- case ciJobRoot of
         JobRootRepo repo -> return (Just repo)
-        JobRootConfig _  -> openRepo $ takeDirectory ciRootPath
+        JobRootConfig _  -> openRepo False $ takeDirectory ciRootPath
 
-    let openDeclaredRepo dir ( name, dpath ) = do
+    let openDeclaredRepo dir ( name, ( writable, dpath ) ) = do
             let path = dir </> dpath
-            openRepo path >>= \case
+            openRepo writable path >>= \case
                 Just repo -> return ( name, repo )
                 Nothing -> do
                     absPath <- makeAbsolute path
@@ -272,7 +279,7 @@ runSomeCommand rootPath gopts (SC tproxy) args = do
                     Just repo -> return ( repoName decl, repo )
                     Nothing
                         | Just path <- repoPath decl
-                        -> openDeclaredRepo (takeDirectory ciRootPath) ( repoName decl, path )
+                        -> openDeclaredRepo (takeDirectory ciRootPath) ( repoName decl, ( repoWritable decl, path ) )
 
                         | otherwise
                         -> do
diff --git a/src/Repo.hs b/src/Repo.hs
index c6fc275..683a815 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -63,6 +63,7 @@ import System.Process
 data Repo
     = GitRepo
         { gitDir :: FilePath
+        , gitWritable :: Bool
         , gitLock :: MVar ()
         , gitInotify :: MVar (Maybe ( INotify, TChan (Tag Commit) ))
         , gitWatchedBranches :: MVar (Map Text [ TVar (Maybe Commit) ])
@@ -77,6 +78,7 @@ getRepoWorkDir GitRepo {..} = takeDirectory gitDir
 data DeclaredRepo = DeclaredRepo
     { repoName :: RepoName
     , repoPath :: Maybe FilePath
+    , repoWritable :: Bool
     }
 
 newtype RepoName = RepoName Text
@@ -164,8 +166,8 @@ runGitCommand GitRepo {..} args = liftIO $ do
         readProcess "git" (("--git-dir=" <> gitDir) : args) ""
 
 
-openRepo :: FilePath -> IO (Maybe Repo)
-openRepo path = do
+openRepo :: Bool -> FilePath -> IO (Maybe Repo)
+openRepo gitWritable path = do
     findGitDir >>= \case
         Just gitDir -> do
             gitLock <- newMVar ()
@@ -437,7 +439,9 @@ readCommittedFile Tree {..} path = do
 
 pushToBranch :: (MonadIO m, MonadFail m) => Branch -> Commit -> m ()
 pushToBranch Branch {..} Commit {..} = do
-    liftIO $
+    when (not $ gitWritable branchRepo) $ do
+        fail $ "repo ‘" <> gitDir branchRepo <> "’ is not writable"
+    join $ liftIO $
         withMVar (gitLock branchRepo) $ \_ ->
         withMVar (gitLock commitRepo) $ \_ -> do
             let cmd = (proc "git" [ "--git-dir=" <> gitDir commitRepo, "push", "--quiet", "--porcelain", gitDir branchRepo, showCommitId commitId_ <> ":refs/heads/" <> T.unpack branchName ])
@@ -448,8 +452,8 @@ pushToBranch Branch {..} Commit {..} = do
             createProcess cmd >>= \( _, mbstdout, _, ph ) -> if
                 | Just _ <- mbstdout -> do
                     waitForProcess ph >>= \case
-                        ExitSuccess -> return ()
-                        code -> fail $ "git push exited with error: " <> show code
+                        ExitSuccess -> return $ return ()
+                        code -> return $ fail $ "git push exited with error: " <> show code
                 | otherwise -> error "createProcess must return stdout handle"
 
 
diff --git a/test/asset/publish/push.yaml b/test/asset/publish/push.yaml
index d82cd0b..8178226 100644
--- a/test/asset/publish/push.yaml
+++ b/test/asset/publish/push.yaml
@@ -1,7 +1,18 @@
 repo source_repo:
+
 repo target_repo:
+  path: "./target2.git"
+  writable: true
+
+repo target_repo_ro:
+  path: "./target3.git"
 
 job push_job:
   push:
     - source: source_repo.commit
       destination: target_repo.branch("master")
+
+job push_job_ro:
+  push:
+    - source: source_repo.commit
+      destination: target_repo_ro.branch("master")
diff --git a/test/script/publish.et b/test/script/publish.et
index 690e82d..e895b93 100644
--- a/test/script/publish.et
+++ b/test/script/publish.et
@@ -71,48 +71,51 @@ test PublishFromSelf:
 
 test PushRepo:
     node n
+    let git = [ "git", "-C", "workdir" ]
+    let commit = git ++ [ "-c", "user.name=test", "-c", "user.email=test", "commit", "-q" ]
     shell on n as git_init:
         cp ${scripts.path}/push.yaml minici.yaml
 
         mkdir workdir
-        git -C workdir -c init.defaultBranch=master init -q
-        git -C workdir -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit'
-        git -C workdir rev-parse HEAD
+        $git -c init.defaultBranch=master init -q
+        $commit --allow-empty -m 'initial commit'
+        $git rev-parse HEAD
 
-        git clone --bare workdir target.git
+        git clone --quiet --bare workdir target.git
+        git clone --quiet --bare workdir target3.git
 
         touch workdir/a
-        git -C workdir add a
-        git -C workdir -c user.name=test -c user.email=test commit -q -m a
-        git -C workdir rev-parse HEAD
-        git -C workdir rev-parse HEAD^{tree}
+        $git add a
+        $commit -m a
+        $git rev-parse HEAD
+        $git rev-parse HEAD^{tree}
 
         touch workdir/b
-        git -C workdir add b
-        git -C workdir -c user.name=test -c user.email=test commit -q -m b
-        git -C workdir rev-parse HEAD
-        git -C workdir rev-parse HEAD^{tree}
+        $git add b
+        $commit -m b
+        $git rev-parse HEAD
+        $git rev-parse HEAD^{tree}
 
         touch workdir/c
-        git -C workdir add c
-        git -C workdir -c user.name=test -c user.email=test commit -q -m c
-        git -C workdir rev-parse HEAD
-        git -C workdir rev-parse HEAD^{tree}
+        $git add c
+        $commit -m c
+        $git rev-parse HEAD
+        $git rev-parse HEAD^{tree}
 
         touch workdir/d
-        git -C workdir add d
-        git -C workdir -c user.name=test -c user.email=test commit -q -m d
-        git -C workdir rev-parse HEAD
-        git -C workdir rev-parse HEAD^{tree}
+        $git add d
+        $commit -m d
+        $git rev-parse HEAD
+        $git rev-parse HEAD^{tree}
 
         touch workdir/e
-        git -C workdir add e
-        git -C workdir -c user.name=test -c user.email=test commit -q -m e
-        git -C workdir rev-parse HEAD
-        git -C workdir rev-parse HEAD^{tree}
+        $git add e
+        $commit -m e
+        $git rev-parse HEAD
+        $git rev-parse HEAD^{tree}
 
-        git -C workdir reset --hard HEAD~5
-        git -C workdir rev-parse HEAD
+        $git reset --hard HEAD~5
+        $git rev-parse HEAD
 
     expect /([0-9a-f]+)/ from git_init capture c_init
     expect /([0-9a-f]+)/ from git_init capture ca
@@ -129,7 +132,7 @@ test PushRepo:
 
     guard (c_init == c_end)
 
-    let cmd_run = [ "--repo=source_repo:workdir", "--repo=target_repo:target.git", "run" ]
+    let cmd_run = [ "--repo=source_repo:workdir", "--writable-repo=target_repo:target.git", "run" ]
     local:
         spawn on n as p args (cmd_run ++ [ "push_job:$cb" ]) killwith SIGINT
         expect from p:
@@ -144,3 +147,136 @@ test PushRepo:
             git -C target.git rev-parse HEAD
         expect /([0-9a-f]+)/ from git_check capture cur_target
         guard (cur_target == cb)
+
+
+test PushRepoWritable:
+    node n
+    let git = [ "git", "-C", "workdir" ]
+    let commit = git ++ [ "-c", "user.name=test", "-c", "user.email=test", "commit", "-q" ]
+    shell on n as git_init:
+        cp ${scripts.path}/push.yaml minici.yaml
+
+        mkdir workdir
+        $git -c init.defaultBranch=master init -q
+        $commit --allow-empty -m 'initial commit'
+        $git rev-parse HEAD
+
+        git clone --quiet --bare workdir target1.git
+        git clone --quiet --bare workdir target2.git
+        git clone --quiet --bare workdir target3.git
+        git clone --quiet --bare workdir target4.git
+
+        touch workdir/a
+        $git add a
+        $commit -m a
+        $git rev-parse HEAD
+        $git rev-parse HEAD^{tree}
+
+        $git reset --hard HEAD~1
+        $git rev-parse HEAD
+
+    expect /([0-9a-f]+)/ from git_init capture c_init
+    expect /([0-9a-f]+)/ from git_init capture ca
+    expect /([0-9a-f]+)/ from git_init capture ta
+    expect /([0-9a-f]+)/ from git_init capture c_end
+
+    guard (c_init == c_end)
+
+    local:
+        let cmd_run = [ "--repo=source_repo:workdir", "run" ]
+        spawn on n as p args (cmd_run ++ [ "push_job:$ca" ]) killwith SIGINT
+        expect from p:
+            /job-enqueue push_job:$ca/
+            /job-start push_job:$ca/
+            /job-finish push_job:$ca done/
+
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+        shell on n as git_check:
+            git -C target2.git rev-parse HEAD
+        expect /([0-9a-f]+)/ from git_check capture cur_target
+        guard (cur_target == ca)
+
+    local:
+        let cmd_run = [ "--repo=source_repo:workdir", "--repo=target_repo:target1.git", "run" ]
+        spawn on n as p args (cmd_run ++ [ "push_job:$ca" ]) killwith SIGINT
+        expect from p:
+            /job-enqueue push_job:$ca/
+            /job-start push_job:$ca/
+            /job-finish push_job:$ca error/
+
+        expect /note .*repo .*target1.git.* is not writable.*/ from p
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+        shell on n as git_check:
+            git -C target1.git rev-parse HEAD
+        expect /([0-9a-f]+)/ from git_check capture cur_target
+        guard (cur_target == c_init)
+
+    local:
+        let cmd_run = [ "--repo=source_repo:workdir", "--writable-repo=target_repo:target1.git", "run" ]
+        spawn on n as p args (cmd_run ++ [ "push_job:$ca" ]) killwith SIGINT
+        expect from p:
+            /job-enqueue push_job:$ca/
+            /job-start push_job:$ca/
+            /job-finish push_job:$ca done/
+
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+        shell on n as git_check:
+            git -C target1.git rev-parse HEAD
+        expect /([0-9a-f]+)/ from git_check capture cur_target
+        guard (cur_target == ca)
+
+    local:
+        let cmd_run = [ "--repo=source_repo:workdir", "run" ]
+        spawn on n as p args (cmd_run ++ [ "push_job_ro:$ca" ]) killwith SIGINT
+        expect from p:
+            /job-enqueue push_job_ro:$ca/
+            /job-start push_job_ro:$ca/
+            /job-finish push_job_ro:$ca error/
+
+        expect /note .*repo .*target3.git.* is not writable.*/ from p
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+        shell on n as git_check:
+            git -C target2.git rev-parse HEAD
+        expect /([0-9a-f]+)/ from git_check capture cur_target
+        guard (cur_target == ca)
+
+    local:
+        let cmd_run = [ "--repo=source_repo:workdir", "--repo=target_repo_ro:target4.git", "run" ]
+        spawn on n as p args (cmd_run ++ [ "push_job_ro:$ca" ]) killwith SIGINT
+        expect from p:
+            /job-enqueue push_job_ro:$ca/
+            /job-start push_job_ro:$ca/
+            /job-finish push_job_ro:$ca error/
+
+        expect /note .*repo .*target4.git.* is not writable.*/ from p
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+        shell on n as git_check:
+            git -C target4.git rev-parse HEAD
+        expect /([0-9a-f]+)/ from git_check capture cur_target
+        guard (cur_target == c_init)
+
+    local:
+        let cmd_run = [ "--repo=source_repo:workdir", "--writable-repo=target_repo_ro:target4.git", "run" ]
+        spawn on n as p args (cmd_run ++ [ "push_job_ro:$ca" ]) killwith SIGINT
+        expect from p:
+            /job-enqueue push_job_ro:$ca/
+            /job-start push_job_ro:$ca/
+            /job-finish push_job_ro:$ca done/
+
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+        shell on n as git_check:
+            git -C target4.git rev-parse HEAD
+        expect /([0-9a-f]+)/ from git_check capture cur_target
+        guard (cur_target == ca)