From c1988345690b9da7a82020ff72542860fcb1d68a Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Wed, 16 Feb 2022 16:57:49 +0100
Subject: server: add mapservice GET endpoint

---
 server/Worker.hs | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

(limited to 'server/Worker.hs')

diff --git a/server/Worker.hs b/server/Worker.hs
index 1672026..40a267b 100644
--- a/server/Worker.hs
+++ b/server/Worker.hs
@@ -13,7 +13,8 @@ import           CheckDir                      (recursiveCheckDir)
 import           Cli.Extras                    (CliConfig, ProcessFailure,
                                                 Severity (..),
                                                 callProcessAndLogOutput,
-                                                prettyProcessFailure, runCli)
+                                                prettyProcessFailure,
+                                                readProcessAndLogStderr, runCli)
 import           Control.Concurrent.Async      (async, link)
 import           Control.Concurrent.STM.TQueue
 import qualified Data.Text                     as T
@@ -54,16 +55,19 @@ runJob config Job {..} cliconfig done = runCli cliconfig $ do
         (callgit gitdir
          [ "clone", toString ref, "--bare"
          , "--depth", "1", "-b", toString ref])
+      rev <- map T.strip -- git returns a newline here
+        $ readProcessAndLogStderr Error
+        $ gitProc gitdir ["rev-parse", toString ref]
       rand <- liftIO UUID.nextRandom
       let workdir = "/tmp" </> ("worktree-" <> UUID.toString rand)
       callgit gitdir [ "worktree", "add", workdir ]
       callgit workdir [ "checkout", toString ref ]
       res <- liftIO $ recursiveCheckDir (orgLintconfig jobOrg) workdir (orgEntrypoint jobOrg)
       callgit gitdir [ "worktree", "remove", "-f", "-f", workdir ]
-      pure res
+      pure (res, rev)
     liftIO $ setJobStatus done jobOrg jobRef $ case res of
-      Right res -> Linted res
-      Left err  -> Failed (prettyProcessFailure err)
+      Right thing -> uncurry Linted thing
+      Left err    -> Failed (prettyProcessFailure err)
   where
     url = repourl jobRef
     ref = reporef jobRef
-- 
cgit v1.2.3