server: add mapservice GET endpoint

1 files changed, 8 insertions, 4 deletions

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