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.

1 files 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)