Add 'git clone' step in CI

Dedicate repo/job specific workspace.

Then, clone the git repo in that dedicated directory. And run `nix
build` in it. Display output of all these steps in the build log.

src/Vira/Lib/Process.hs

@@ -0,0 +1,26 @@
+-- | `System.Process` utilities
+module Vira.Lib.Process (
+  alwaysUnderPath,
+  redirectOutputTo,
+) where
+
+import Effectful.Process (
+  CreateProcess (cwd, std_err, std_out),
+  StdStream (UseHandle),
+ )
+import System.FilePath ((</>))
+
+-- | Make sure that this process will always use the given path, or its subdirectory, as CWD. If the current CWD is relative, it will be made relative to the given path.
+alwaysUnderPath :: FilePath -> CreateProcess -> CreateProcess
+alwaysUnderPath path p =
+  p
+    { cwd = Just $ maybe path (path </>) (cwd p)
+    }
+
+-- | With stdout and stderr redirected to given handle
+redirectOutputTo :: Handle -> CreateProcess -> CreateProcess
+redirectOutputTo h p =
+  p
+    { std_out = UseHandle h
+    , std_err = UseHandle h
+    }

src/Vira/Page/JobPage.hs

@@ -4,6 +4,7 @@ module Vira.Page.JobPage where
 
 import Effectful (Eff)
 import Effectful.Error.Static (throwError)
+import Effectful.Process (CreateProcess (cwd), shell)
 import Effectful.Reader.Dynamic (ask, asks)
 import GHC.IO.Exception (ExitCode (..))
 import Htmx.Servant.Response
@@ -91,16 +92,19 @@ triggerNewBuild repoName branchName = do
   asks App.supervisor >>= \supervisor -> do
     job <- App.update $ St.AddNewJobA repoName branchName branch.headCommit supervisor.baseWorkDir
     log Info $ "Added job " <> show job
-    let cmd = "nix build -L --no-link --print-out-paths " <> toString (gitFlakeUrl repo.cloneUrl) <> "/" <> toString branch.headCommit
-    Supervisor.startTask supervisor job.jobId job.jobWorkingDir cmd $ \exitCode -> do
+    let stages = stageClone repo branch :| [stageBuild]
+    Supervisor.startTask supervisor job.jobId job.jobWorkingDir stages $ \exitCode -> do
       let status = case exitCode of
             ExitSuccess -> St.JobFinished St.JobSuccess
             ExitFailure _code -> St.JobFinished St.JobFailure
       App.update $ St.JobUpdateStatusA job.jobId status
     App.update $ St.JobUpdateStatusA job.jobId St.JobRunning
     log Info $ "Started task " <> show job.jobId
   where
-    gitFlakeUrl :: Text -> Text
-    gitFlakeUrl _url =
-      -- TODO: Implement this more generally
-      "github:srid/emanote"
+    -- TODO: Avoid shell command for security
+    stageClone repo branch =
+      shell ("git clone " <> toString repo.cloneUrl <> " project && cd project && git checkout " <> toString branch.headCommit)
+    stageBuild =
+      (shell "nix build -L --no-link --print-out-paths .")
+        { cwd = Just "project"
+        }

src/Vira/State/Acid.hs

@@ -96,7 +96,7 @@ addNewJobA jobRepo jobBranch jobCommit baseWorkDir = do
       let ids = T.jobId <$> jobs
        in if Prelude.null ids then JobId 1 else JobId 1 + maximum ids
     jobStatus = JobPending
-    jobWorkingDir = baseWorkDir </> show jobId
+    jobWorkingDir = baseWorkDir </> toString jobRepo </> show jobId
     job = Job {..}
   modify $ \s ->
     s

src/Vira/State/Core.hs

@@ -27,6 +27,10 @@ openViraState = do
     sampleRepos =
       Ix.fromList
         [ Repo "emanote" "https://github.com/srid/emanote.git"
+        , Repo "omnix" "https://github.com/juspay/omnix.git"
+        , Repo "haskell-flake" "https://github.com/srid/haskell-flake.git"
+        , Repo "hyperswitch" "https://github.com/juspay/hyperswitch.git"
+        , Repo "superposition" "https://github.com/juspay/superposition.git"
         ]
 
 {- | Close vira database

src/Vira/Supervisor.hs

@@ -8,14 +8,16 @@ import Data.Map.Strict qualified as Map
 import Effectful (Eff, IOE, (:>))
 import Effectful.Concurrent.Async
 import Effectful.Concurrent.MVar (modifyMVar, modifyMVar_, readMVar)
-import Effectful.FileSystem (FileSystem, createDirectory)
+import Effectful.FileSystem (FileSystem, createDirectoryIfMissing)
 import Effectful.FileSystem.IO (hClose, openFile)
-import Effectful.Process (CreateProcess (cwd, std_err, std_out), Process, StdStream (UseHandle), createProcess, shell, waitForProcess)
-import System.Directory (createDirectoryIfMissing, getCurrentDirectory, makeAbsolute)
-import System.Exit (ExitCode)
+import Effectful.Process (CreateProcess (cmdspec), Process, createProcess, waitForProcess)
+import System.Directory (getCurrentDirectory, makeAbsolute)
+import System.Directory qualified
+import System.Exit (ExitCode (ExitSuccess))
 import System.FilePath ((</>))
 import Vira.App qualified as App
 import Vira.App.Logging
+import Vira.Lib.Process qualified as Process
 import Vira.Supervisor.Type
 import Prelude hiding (readMVar)
 
@@ -24,7 +26,7 @@ newSupervisor = do
   tasks <- newMVar mempty
   pwd <- liftIO getCurrentDirectory
   workDir <- liftIO $ makeAbsolute $ pwd </> "state" </> "workspace" -- keep it alongside acid-state db
-  liftIO $ createDirectoryIfMissing True workDir
+  liftIO $ System.Directory.createDirectoryIfMissing True workDir
   pure $ TaskSupervisor tasks workDir
 
 logSupervisorState :: (HasCallStack, Concurrent :> es, Log Message :> es) => TaskSupervisor -> Eff es ()
@@ -48,62 +50,73 @@ startTask ::
   TaskId ->
   -- The working directory of the job (will be created)
   FilePath ->
-  -- The shell command to run
-  String ->
+  -- List of processes to run in sequence
+  NonEmpty CreateProcess ->
   -- Handler to call after the task finishes
   ( -- Exit code
     ExitCode ->
     Eff es ()
   ) ->
   Eff es ()
-startTask supervisor taskId pwd cmd h = do
+startTask supervisor taskId pwd procs h = do
   logSupervisorState supervisor
-  log Info $ "Starting task: " <> toText cmd
+  log Info $ "Starting task group: " <> show (cmdspec <$> procs) <> " in " <> toText pwd
   modifyMVar (tasks supervisor) $ \tasks -> do
     if Map.member taskId tasks
       then do
         log Error $ "Task " <> show taskId <> " already exists"
         die $ "Task " <> show taskId <> " already exists"
       else do
-        createDirectory pwd
-        asyncHandle <- Effectful.Concurrent.Async.async $ startTask' taskId pwd cmd h
+        createDirectoryIfMissing True pwd
+        asyncHandle <- Effectful.Concurrent.Async.async $ startTask' taskId pwd h procs
         let task = Task {workDir = pwd, asyncHandle}
         pure (Map.insert taskId task tasks, ())
 
 startTask' ::
+  forall es.
   (Process :> es, Log Message :> es, IOE :> es, FileSystem :> es) =>
   TaskId ->
   FilePath ->
-  String ->
   (ExitCode -> Eff es ()) ->
+  -- List of processes to run in sequence
+  NonEmpty CreateProcess ->
   Eff es ExitCode
-startTask' taskId pwd cmd h = do
-  -- Send all output to a file under working directory.
-  -- Write vira level log entry to the output log
-  let outputLogFile = pwd </> "output.log"
-  -- TODO: In lieu of https://github.com/juspay/vira/issues/6
-  let buildLog (msg :: Text) = do
-        let s = "[vira:job:" <> show taskId <> "] " <> msg <> "\n"
-        appendFileText outputLogFile s
-  buildLog $ "Task started: " <> toText cmd
-  outputHandle <- openFile outputLogFile AppendMode
-  let processSettings s =
-        s
-          { cwd = Just pwd
-          , std_out = UseHandle outputHandle
-          , std_err = UseHandle outputHandle
-          }
-      process =
-        -- FIXME: Using `shell` is not considered secure.
-        shell cmd & processSettings
-  (_, _, _, ph) <- createProcess process
-  exitCode <- waitForProcess ph
-  let msg = "Task " <> show taskId <> " finished with exit code " <> show exitCode
-  log Info msg
-  buildLog msg
-  hClose outputHandle
-  h exitCode
-  pure exitCode
+startTask' taskId pwd h = runProcs . toList
+  where
+    -- Send all output to a file under working directory.
+    -- Write vira level log entry to the output log
+    outputLogFile = pwd </> "output.log"
+    -- TODO: In lieu of https://github.com/juspay/vira/issues/6
+    logToWorkspaceOutput (msg :: Text) = do
+      let s = "🥕 [vira:job:" <> show taskId <> "] " <> msg <> "\n"
+      appendFileText outputLogFile s
+
+    -- Run each process one after another; exiting immediately if any fails
+    runProcs :: [CreateProcess] -> Eff es ExitCode
+    runProcs [] = do
+      log Info $ "All procs for task " <> show taskId <> " finished successfully"
+      h ExitSuccess
+      pure ExitSuccess
+    runProcs (proc : rest) =
+      runProc proc >>= \case
+        ExitSuccess -> runProcs rest
+        exitCode -> do
+          log Info $ "A proc for task " <> show taskId <> " failed with exitCode " <> show exitCode
+          h exitCode
+          pure exitCode
+
+    runProc :: CreateProcess -> Eff es ExitCode
+    runProc proc = do
+      logToWorkspaceOutput $ "Task started: " <> show (cmdspec proc)
+      outputHandle <- openFile outputLogFile AppendMode
+      let processSettings =
+            Process.alwaysUnderPath pwd
+              >>> Process.redirectOutputTo outputHandle
+      (_, _, _, ph) <- createProcess $ proc & processSettings
+      exitCode <- waitForProcess ph
+      logToWorkspaceOutput $ "A task finished with exit code " <> show exitCode
+      hClose outputHandle
+      pure exitCode
 
 -- | Kill a task
 killTask :: TaskSupervisor -> TaskId -> Eff App.AppStack ()

vira.cabal

@@ -106,6 +106,7 @@ library
     Vira.App.Servant
     Vira.App.Stack
     Vira.Lib.Git
+    Vira.Lib.Process
     Vira.Page.JobPage
     Vira.Page.RegistryPage
     Vira.Page.RepoPage