branch master updated: Attempt to fetch this Git polling mess

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository data-service.

The following commit(s) were added to refs/heads/master by this push:
     new 82bb174  Attempt to fetch this Git polling mess
82bb174 is described below

commit 82bb17470044d536f57b799a9feea54435544c3f
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Wed Oct 11 17:53:38 2023 +0100

    Attempt to fetch this Git polling mess
    
    Listing remote branches through libgit2 will list branches that don't exist 
on
    the remote. I think branch-list is more listing branch references, and you 
can
    have references to a remote branch where the remote branch doesn't exist. 
This
    isn't very useful here though, as I'm trying to work out what remote 
branches
    exist.
    
    There's remote-ls which might help, but I can't figure out how to get the
    commits for branches from that.
    
    Therefore, just bodge the two things together in to a big mess. I seem to be
    able to get commits from branch-list that hopefully match what's on the
    remote (although I'm not confident about this), and I think remote-ls does
    allow checking what branches exist.
---
 guix-data-service/poll-git-repository.scm | 46 +++++++++++++++++++++++--------
 1 file changed, 34 insertions(+), 12 deletions(-)

diff --git a/guix-data-service/poll-git-repository.scm 
b/guix-data-service/poll-git-repository.scm
index 399299d..1ce271a 100644
--- a/guix-data-service/poll-git-repository.scm
+++ b/guix-data-service/poll-git-repository.scm
@@ -112,21 +112,42 @@
               conn
               git-repository-id))
 
+            ;; remote-ls returns remote-head's where the oid's aren't like the
+            ;; oid's found through branches, and I'm not sure how to handle
+            ;; them. Work around this by just using remote-ls to check what
+            ;; branches exist on the remote.
+            (remote-branch-names
+             (with-repository repository-directory repository
+               (let ((remote (remote-lookup repository "origin")))
+                 (remote-connect remote)
+
+                 (filter-map
+                  (lambda (rh)
+                    (let ((name (remote-head-name rh)))
+                      (if (string-prefix? "refs/heads/" name)
+                          (string-drop name
+                                       (string-length "refs/heads/"))
+                          #f)))
+                  (remote-ls remote)))))
+
             (repository-branches
              (with-repository repository-directory repository
-               (map
+               (filter-map
                 (lambda (branch-reference)
                   (let* ((branch-name
-                          (last
-                           (string-split
-                            (reference-shorthand branch-reference)
-                            #\/))))
-                    (cons
-                     branch-name
-                     ;; TODO Not sure what the right way to do this is
-                     (and=> (false-if-exception
-                             (reference-target branch-reference))
-                            oid->string))))
+                          (string-drop (reference-shorthand branch-reference)
+                                       (string-length "origin/"))))
+                    (and
+                     ;; branch-list may list branches which don't exist on the
+                     ;; remote, so use the information from remote-ls to
+                     ;; filter them out
+                     (member branch-name remote-branch-names)
+                     (cons
+                      branch-name
+                      ;; TODO Not sure what the right way to do this is
+                      (and=> (false-if-exception
+                              (reference-target branch-reference))
+                             oid->string)))))
                 (branch-list repository BRANCH-REMOTE)))))
 
        (with-postgresql-transaction
@@ -187,7 +208,8 @@
                               git-repository-id
                               repository-commit
                               "poll"))))
-                     (if database-commit
+                     (if (or (not database-commit)
+                             (string=? database-commit ""))
                          #f ;; Nothing to do
                          (insert-git-commit-entry conn
                                                   (git-branch-entry)