Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 23 May 2025 19:54:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
To reply to this bug, email your comments to 78568 AT debbugs.gnu.org.
There is no need to reopen the bug first.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Fri, 23 May 2025 19:54:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:guix-patches <at> gnu.org.
(Fri, 23 May 2025 19:54:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 0/5] Synchronize team definitions with Codeberg Date: Fri, 23 May 2025 21:52:39 +0200
Hello Guix,
As a followup to <https://issues.guix.gnu.org/78354>, this patch
series adds a ‘sync-codeberg-teams’ command that pushes team
definitions to Codeberg (name, description, and members).
Currently it creates teams with read-only repository access such
that being a team member does not equate to being a committer (as
is currently the case).
Synchronization works by deleting the team from Codeberg if it
already exists, and recreating it. This is brute force but it
appears to work well (nothing is lost and list of deletions/creations
does not show up in the activity log; there’s also no rate limit
apparently.)
You can see the result here (you need to be logged in):
https://codeberg.org/org/guix/teams
That’s 42 teams. Coincidence?
Feedback welcome!
Ludo’.
PS: ‘define-forgejo-request’ & co. could be used as the basis
of a separate Guile library of Forgejo bindings.
Ludovic Courtès (5):
teams: Add ‘codeowners’ command in help message.
teams: Use suitable team identifiers for Codeberg.
teams: Add missing team descriptions.
teams: Add Codeberg accounts to <person> records.
teams: Add ‘sync-codeberg-teams’ action.
etc/teams.scm | 367 +++++++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 331 insertions(+), 36 deletions(-)
base-commit: 8dff81313876a54519ce17e9fda64d4310e2dd5c
--
2.49.0
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Fri, 23 May 2025 19:56:01 GMT) Full text and rfc822 format available.Message #8 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 78568 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 1/5] teams: Add ‘codeowners’ command in help message. Date: Fri, 23 May 2025 21:55:05 +0200
* etc/teams.scm (main): Add ‘codeowners’ command in help message.
Change-Id: I859997aba2b8829173e608e5ba1c8ab59b79d9c5
---
etc/teams.scm | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/etc/teams.scm b/etc/teams.scm
index f7617e724e..a57d132787 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -1107,6 +1107,8 @@ (define (main . args)
get-maintainer <patch>
compatibility mode with Linux get_maintainer.pl
show <team-name>
- display <team-name> properties~%"))))
+ display <team-name> properties
+ codeowners
+ write a 'CODEOWNERS' file suitable for Codeberg on standard output~%"))))
(apply main (cdr (command-line)))
--
2.49.0
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Fri, 23 May 2025 19:56:02 GMT) Full text and rfc822 format available.Message #11 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 78568 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 2/5] teams: Use suitable team identifiers for Codeberg. Date: Fri, 23 May 2025 21:55:06 +0200
The “c++” team has to be called “cpp”.
* etc/teams.scm (team-id->forgejo-id): New procedure.
(team->codeowners-snippet): Use it.
Change-Id: I10619d8833b5c747504f26b7b0eedb9d61bfd812
---
etc/teams.scm | 16 +++++++++++++++-
1 file changed, 15 insertions(+), 1 deletion(-)
diff --git a/etc/teams.scm b/etc/teams.scm
index a57d132787..9fa189a92c 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -1024,13 +1024,27 @@ (define (patch->teams patch-file)
(find-team-by-scope (apply diff-revisions
(git-patch->revisions patch-file)))))
+(define (team-id->forgejo-id id)
+ "Return a name (string) suitable as a Forgejo team name."
+ (define valid ;"AlphaDashDot"
+ (char-set-union char-set:ascii (char-set #\-) (char-set #\.)))
+
+ (define (valid? chr)
+ (char-set-contains? valid chr))
+
+ (string-map (match-lambda
+ (#\+ #\p) ;special case for "c++"
+ ((? valid? chr) chr)
+ (_ #\-))
+ (symbol->string id)))
+
(define (team->codeowners-snippet team)
(string-join (map (lambda (scope)
(format #f "~50a @guix/~a"
(if (regexp*? scope)
(regexp*-pattern scope)
(regexp-quote scope))
- (team-id team)))
+ (team-id->forgejo-id (team-id team))))
(team-scope team))
"\n"
'suffix))
--
2.49.0
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Fri, 23 May 2025 19:56:02 GMT) Full text and rfc822 format available.Message #14 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 78568 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 3/5] teams: Add missing team descriptions. Date: Fri, 23 May 2025 21:55:07 +0200
* etc/teams.scm (bootstrap, hurd): Add #:description.
Change-Id: I531907763c746420a60daf6a5c33ec586565db07
---
etc/teams.scm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/etc/teams.scm b/etc/teams.scm
index 9fa189a92c..4b06d3a937 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -126,6 +126,7 @@ (define-team audio
(define-team bootstrap
(team 'bootstrap
#:name "Bootstrap"
+ #:description "Full-source bootstrap: stage0, Mes, Gash, etc."
#:scope (list "gnu/packages/commencement.scm"
"gnu/packages/mes.scm")))
@@ -355,6 +356,7 @@ (define-team home
(define-team hurd
(team 'hurd
#:name "Team for the Hurd"
+ #:description "GNU Hurd packages and operating system support."
#:scope (list "gnu/system/hurd.scm"
"gnu/system/images/hurd.scm"
"gnu/build/hurd-boot.scm"
--
2.49.0
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Fri, 23 May 2025 19:56:03 GMT) Full text and rfc822 format available.Message #17 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 78568 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 5/5] teams: Add ‘sync-codeberg-teams’ action. Date: Fri, 23 May 2025 21:55:09 +0200
* etc/teams.scm (<forgejo-team>): New JSON mapping.
(unit-map->json, json->unit-map): New procedures.
(%default-forgejo-team-units, %default-forgejo-team-unit-map)
(%codeberg-organization): New variables.
(codeberg-url, forgejo-http-headers): New procedures.
(&forgejo-error): New record type.
(process-url-components, define-forgejo-request): New macros.
(organization-teams, create-team, add-team-member)
(team->forgejo-team, synchronize-team, synchronize-teams): New
procedures.
(main): Add ‘sync-codeberg-teams’ action.
Change-Id: I6b1f437a3407bc2d44965519990deb524afa9528
---
etc/teams.scm | 252 +++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 250 insertions(+), 2 deletions(-)
diff --git a/etc/teams.scm b/etc/teams.scm
index e881e916ab..08ca891e0d 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -41,12 +41,21 @@
(use-modules (srfi srfi-1)
(srfi srfi-9)
(srfi srfi-26)
+ (srfi srfi-34)
+ (srfi srfi-35)
+ (srfi srfi-71)
(ice-9 format)
(ice-9 regex)
(ice-9 match)
(ice-9 rdelim)
(guix ui)
- (git))
+ (git)
+ (json)
+ (web client)
+ (web request)
+ (web response)
+ (rnrs bytevectors)
+ (guix base64))
(define-record-type <regexp*>
(%make-regexp* pat flag rx)
@@ -116,6 +125,241 @@ (define-syntax-rule (define-member person teams ...)
team (cons p (team-members team)))))
(quote (teams ...)))))
+
+;;;
+;;; Forgejo support.
+;;;
+
+;; Forgejo team. This corresponds to both the 'Team' and 'CreateTeamOption'
+;; structures in Forgejo.
+(define-json-mapping <forgejo-team>
+ forgejo-team forgejo-team?
+ json->forgejo-team <=> forgejo-team->json
+ (name forgejo-team-name)
+ (id forgejo-team-id) ;integer
+ (description forgejo-team-description)
+ (all-repositories? forgejo-team-all-repositories?
+ "includes_all_repositories")
+ (can-create-org-repository? forgejo-team-can-create-org-repository?
+ "can_create_org_repo")
+ (permission forgejo-team-permission
+ "permission" string->symbol symbol->string)
+ ;; A 'units' field exists but is deprecated in favor of 'units_map'.
+ (unit-map forgejo-team-unit-map
+ "units_map" json->unit-map unit-map->json))
+
+(define (unit-map->json lst)
+ (map (match-lambda
+ ((unit . permission)
+ (cons unit (symbol->string permission))))
+ lst))
+
+(define (json->unit-map lst)
+ (map (match-lambda
+ ((unit . permission)
+ (cons unit (string->symbol permission))))
+ lst))
+
+(define %default-forgejo-team-units
+ '("repo.code" "repo.issues" "repo.pulls" "repo.releases"
+ "repo.wiki" "repo.ext_wiki" "repo.ext_issues" "repo.projects"
+ "repo.packages" "repo.actions"))
+
+(define %default-forgejo-team-unit-map
+ ;; Everything (including "repo.code") is read-only by default, except a few
+ ;; units.
+ (map (match-lambda
+ ("repo.pulls" (cons "repo.pulls" 'write))
+ ("repo.issues" (cons "repo.issues" 'write))
+ ("repo.wiki" (cons "repo.wiki" 'write))
+ (unit (cons unit 'read)))
+ %default-forgejo-team-units))
+
+(define (forgejo-http-headers token)
+ "Return the HTTP headers for basic authorization with TOKEN."
+ `((content-type . (application/json (charset . "UTF-8")))
+ ;; The "Auth Basic" scheme needs a base64-encoded colon-separated user and
+ ;; token values. Forgejo doesn't seem to care for the user part but the
+ ;; colon seems to be necessary for the token value to get extracted.
+ (authorization . (basic . ,(base64-encode
+ (string->utf8
+ (string-append ":" token)))))))
+
+;; Error with a Forgejo request.
+(define-condition-type &forgejo-error &error
+ forgejo-error?
+ (url forgejo-error-url)
+ (method forgejo-error-method)
+ (response forgejo-error-response))
+
+(define %codeberg-organization
+ ;; Name of the organization at codeberg.org.
+ "guix")
+
+(define* (codeberg-url items #:key (parameters '()))
+ "Construct a Codeberg API URL with the path components ITEMS and query
+PARAMETERS."
+ (define query
+ (match parameters
+ (() "")
+ (((keys . values) ...)
+ (string-append "?" (string-join
+ (map (lambda (key value)
+ (string-append key "=" value)) ;XXX: hackish
+ keys values)
+ "&")))))
+
+ (string-append "https://codeberg.org/api/v1/"
+ (string-join items "/")
+ query))
+
+(define-syntax process-url-components
+ (syntax-rules (&)
+ "Helper macro to construct a Codeberg URL."
+ ((_ components ... & parameters)
+ (codeberg-url (list components ...)
+ #:parameters parameters))
+ ((_ components ...)
+ (codeberg-url (list components ...)))))
+
+(define-syntax define-forgejo-request
+ (syntax-rules (=>)
+ "Define a procedure that performs a Forgejo request."
+ ((_ (proc parameters ...)
+ docstring
+ (verb components ...)
+ body
+ => code
+ deserialize)
+ (define (proc token parameters ...)
+ docstring
+ (let* ((url (process-url-components components ...))
+ (response port (http-request url
+ #:method 'verb
+ #:streaming? #t
+ #:headers (forgejo-http-headers token)
+ #:body body)))
+ (if (= code (response-code response))
+ (let ((value (deserialize port)))
+ (when port (close-port port))
+ value)
+ (begin
+ (when port (close-port port))
+ (raise (condition (&forgejo-error (url url)
+ (method 'verb)
+ (response response)))))))))
+ ((_ (proc parameters ...)
+ docstring
+ (method components ...)
+ => code
+ deserialize)
+ (define-forgejo-request (proc parameters ...)
+ docstring
+ (method components ...)
+ ""
+ => code
+ deserialize))
+ ((_ (proc parameters ...)
+ docstring
+ (method components ...)
+ => code)
+ (define-forgejo-request (proc parameters ...)
+ docstring
+ (method components ...)
+ ""
+ => code
+ (const *unspecified*)))))
+
+;; API documentation at <https://codeberg.org/api/swagger>.
+
+(define-forgejo-request (organization-teams organization)
+ "Return the list of teams of ORGANIZATION."
+ (GET "orgs" organization "teams"
+ & '(("limit" . "100"))) ;get up to 100 teams
+ => 200
+ (lambda (port)
+ (map json->forgejo-team (vector->list (json->scm port)))))
+
+(define-forgejo-request (create-team organization team)
+ "Create TEAM, a Forgejo team, under ORGANIZATION."
+ (POST "orgs" organization "teams")
+ (forgejo-team->json team)
+ => 201
+ json->forgejo-team)
+
+(define-forgejo-request (delete-team team)
+ "Delete TEAM, a Forgejo team."
+ (DELETE "teams" (number->string (forgejo-team-id team)))
+ => 204)
+
+(define-forgejo-request (add-team-member team user)
+ "Add USER (a string) to TEAM, a Forgejo team."
+ (PUT "teams" (number->string (forgejo-team-id team))
+ "members" user)
+ => 204)
+
+(define (team->forgejo-team team)
+ "Return a Forgejo team derived from TEAM, a <team> record."
+ (forgejo-team (team-id->forgejo-id (team-id team))
+ #f
+ (or (team-description team) "")
+ #f ;all-repositories?
+ #f ;can-create-org-repository?
+ 'read ;permission
+ %default-forgejo-team-unit-map))
+
+(define* (synchronize-team token team
+ #:key
+ (current-teams
+ (organization-teams token
+ %codeberg-organization))
+ (log-port (current-error-port)))
+ "Synchronize TEAM, a <team> record, so that its metadata and list of members
+are accurate on Codeberg. Lookup team IDs among CURRENT-TEAMS."
+ (let ((forgejo-team
+ (find (let ((name (team-id->forgejo-id (team-id team))))
+ (lambda (candidate)
+ (string=? (forgejo-team-name candidate) name)))
+ current-teams)))
+ (when forgejo-team
+ ;; Delete the previously-created team.
+ (format log-port "team '~a' already exists; deleting it~%"
+ (forgejo-team-name forgejo-team))
+ (delete-team token forgejo-team))
+
+ ;; Create the team.
+ (let ((forgejo-team
+ (create-team token %codeberg-organization
+ (or forgejo-team
+ (team->forgejo-team team)))))
+ (format log-port "created team '~a'~%"
+ (forgejo-team-name forgejo-team))
+ (let ((members (filter-map person-codeberg-account
+ (team-members team))))
+ (for-each (lambda (member)
+ (add-team-member token forgejo-team member))
+ members)
+ (format log-port "added ~a members to team '~a'~%"
+ (length members)
+ (forgejo-team-name forgejo-team))
+ forgejo-team))))
+
+(define (synchronize-teams token)
+ "Push all the existing teams on Codeberg."
+ (let ((teams (sort-teams
+ (hash-map->list (lambda (_ value) value) %teams))))
+ (format (current-error-port)
+ "creating ~a teams in the '~a' organization at Codeberg...~%"
+ (length teams) %codeberg-organization)
+
+ ;; Arrange to compute the list of existing teams once and for all.
+ (for-each (let ((teams (organization-teams token
+ %codeberg-organization)))
+ (lambda (team)
+ (synchronize-team token team
+ #:current-teams teams)))
+ teams)))
+
(define-team audio
@@ -1132,6 +1376,8 @@ (define (main . args)
(list-teams team-names))
(("codeowners")
(export-codeowners (current-output-port)))
+ (("sync-codeberg-teams" token)
+ (synchronize-teams token))
(anything
(format (current-error-port)
"Usage: etc/teams.scm <command> [<args>]
@@ -1154,6 +1400,8 @@ (define (main . args)
show <team-name>
display <team-name> properties
codeowners
- write a 'CODEOWNERS' file suitable for Codeberg on standard output~%"))))
+ write a 'CODEOWNERS' file suitable for Codeberg on standard output
+ sync-codeberg-teams <token>
+ create or update the list of teams at Codeberg~%"))))
(apply main (cdr (command-line)))
--
2.49.0
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Fri, 23 May 2025 19:56:04 GMT) Full text and rfc822 format available.Message #20 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 78568 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 4/5] teams: Add Codeberg accounts to <person> records. Date: Fri, 23 May 2025 21:55:08 +0200
Based on the committer accounts given in the thread at
<https://lists.gnu.org/archive/html/guix-devel/2025-05/msg00072.html>.
* etc/teams.scm (<person>)[account]: Add field.
(person): Add ‘account’ parameter.
<top level>: Add known Codeberg account names.
Change-Id: Iad3b10c328b0df5d3c68d98ffee7f7c8ec4c8e23
---
etc/teams.scm | 95 +++++++++++++++++++++++++++++++++------------------
1 file changed, 62 insertions(+), 33 deletions(-)
diff --git a/etc/teams.scm b/etc/teams.scm
index 4b06d3a937..e881e916ab 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -75,13 +75,14 @@ (define-record-type <team>
(scope team-scope))
(define-record-type <person>
- (make-person name email)
+ (make-person name email account)
person?
(name person-name)
- (email person-email))
+ (email person-email)
+ (account person-codeberg-account))
-(define* (person name #:optional email)
- (make-person name email))
+(define* (person name #:optional email account)
+ (make-person name email account))
(define* (team id #:key name description (members '())
(scope '()))
@@ -672,24 +673,29 @@ (define-team zig
(define-member (person "Eric Bavier"
- "bavier <at> posteo.net")
+ "bavier <at> posteo.net"
+ "bavier")
science)
(define-member (person "Lars-Dominik Braun"
- "lars <at> 6xq.net")
+ "lars <at> 6xq.net"
+ "ldb")
python haskell)
(define-member (person "Jonathan Brielmaier"
- "jonathan.brielmaier <at> web.de")
+ "jonathan.brielmaier <at> web.de"
+ "jonsger")
mozilla)
(define-member (person "Ludovic Courtès"
- "ludo <at> gnu.org")
+ "ludo <at> gnu.org"
+ "civodul")
core home bootstrap core-packages installer
documentation mentors)
(define-member (person "Andreas Enge"
- "andreas <at> enge.fr")
+ "andreas <at> enge.fr"
+ "enge")
bootstrap core-packages lxqt science tex)
(define-member (person "Tanguy Le Carrour"
@@ -701,15 +707,18 @@ (define-member (person "Tobias Geerinckx-Rice"
core mentors)
(define-member (person "Steve George"
- "steve <at> futurile.net")
+ "steve <at> futurile.net"
+ "futurile")
rust)
(define-member (person "Leo Famulari"
- "leo <at> famulari.name")
+ "leo <at> famulari.name"
+ "lfam")
kernel)
(define-member (person "Efraim Flashner"
- "efraim <at> flashner.co.il")
+ "efraim <at> flashner.co.il"
+ "efraim")
embedded bootstrap rust)
(define-member (person "jgart"
@@ -717,11 +726,13 @@ (define-member (person "jgart"
lisp mentors)
(define-member (person "Guillaume Le Vaillant"
- "glv <at> posteo.net")
+ "glv <at> posteo.net"
+ "glv")
lisp)
(define-member (person "Julien Lepiller"
- "julien <at> lepiller.eu")
+ "julien <at> lepiller.eu"
+ "roptat")
java ocaml translations)
(define-member (person "Philip McGrath"
@@ -729,23 +740,28 @@ (define-member (person "Philip McGrath"
racket)
(define-member (person "Mathieu Othacehe"
- "othacehe <at> gnu.org")
+ "othacehe <at> gnu.org"
+ "mothacehe")
core installer mentors)
(define-member (person "Florian Pelz"
- "pelzflorian <at> pelzflorian.de")
+ "pelzflorian <at> pelzflorian.de"
+ "pelzflorian")
translations)
(define-member (person "Liliana Marie Prikler"
- "liliana.prikler <at> gmail.com")
+ "liliana.prikler <at> gmail.com"
+ "lilyp")
emacs games gnome)
(define-member (person "Ricardo Wurmus"
- "rekado <at> elephly.net")
+ "rekado <at> elephly.net"
+ "rekado")
r sugar)
(define-member (person "Christopher Baines"
- "guix <at> cbaines.net")
+ "guix <at> cbaines.net"
+ "cbaines")
core mentors ruby)
(define-member (person "Andrew Tropin"
@@ -769,19 +785,22 @@ (define-member (person "Simon Tournier"
julia core mentors r)
(define-member (person "宋文武"
- "iyzsong <at> envs.net")
+ "iyzsong <at> envs.net"
+ "iyzsong")
games localization lxqt qt xfce)
(define-member (person "Vagrant Cascadian"
- "vagrant <at> debian.org")
+ "vagrant <at> debian.org"
+ "vagrantc")
embedded)
-(define-member (person "Vagrant Cascadian"
+(define-member (person "Vagrant Cascadian" ;XXX: duplicate
"vagrant <at> reproducible-builds.org")
reproduciblebuilds)
(define-member (person "Maxim Cournoyer"
- "maxim.cournoyer <at> gmail.com")
+ "maxim.cournoyer <at> gmail.com"
+ "apteryx")
documentation gnome qt telephony electronics)
(define-member (person "Katherine Cox-Buday"
@@ -797,7 +816,8 @@ (define-member (person "Gabriel Wicki"
audio documentation electronics embedded)
(define-member (person "Ekaitz Zarraga"
- "ekaitz <at> elenq.tech")
+ "ekaitz <at> elenq.tech"
+ "ekaitz-zarraga")
bootstrap zig electronics)
(define-member (person "Divya Ranjan Pattanaik"
@@ -805,7 +825,8 @@ (define-member (person "Divya Ranjan Pattanaik"
emacs rust haskell)
(define-member (person "Clément Lassieur"
- "clement <at> lassieur.org")
+ "clement <at> lassieur.org"
+ "snape")
mozilla)
(define-member (person "Sharlatan Hellseher"
@@ -817,7 +838,8 @@ (define-member (person "Vivien Kraus"
gnome)
(define-member (person "Mark H Weaver"
- "mhw <at> netris.org")
+ "mhw <at> netris.org"
+ "mhw")
mozilla)
(define-member (person "Adam Faiz"
@@ -829,7 +851,8 @@ (define-member (person "Laurent Gatto"
r)
(define-member (person "Nicolas Goaziou"
- "guix <at> nicolasgoaziou.fr")
+ "guix <at> nicolasgoaziou.fr"
+ "ngz")
tex)
(define-member (person "André Batista"
@@ -837,15 +860,18 @@ (define-member (person "André Batista"
mozilla)
(define-member (person "Janneke Nieuwenhuizen"
- "janneke <at> gnu.org")
+ "janneke <at> gnu.org"
+ "janneke")
bootstrap core-packages home hurd installer)
(define-member (person "Ian Eure"
- "ian <at> retrospec.tv")
+ "ian <at> retrospec.tv"
+ "ieure")
mozilla emacs)
(define-member (person "Zheng Junjie"
- "z572 <at> z572.online")
+ "z572 <at> z572.online"
+ "z572")
core-packages qt kde)
(define-member (person "Sughosha"
@@ -853,7 +879,8 @@ (define-member (person "Sughosha"
kde)
(define-member (person "Jelle Licht"
- "jlicht <at> fsfe.org")
+ "jlicht <at> fsfe.org"
+ "jlicht")
javascript)
(define-member (person "Cayetano Santos"
@@ -861,11 +888,13 @@ (define-member (person "Cayetano Santos"
emacs electronics)
(define-member (person "Greg Hogan"
- "code <at> greghogan.com")
+ "code <at> greghogan.com"
+ "greghogan")
c++)
(define-member (person "Hilton Chain"
- "hako <at> ultrarare.space")
+ "hako <at> ultrarare.space"
+ "hako")
emacs home localization mozilla rust zig)
(define-member (person "Noé Lopez"
--
2.49.0
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Tue, 27 May 2025 08:33:01 GMT) Full text and rfc822 format available.Message #23 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 78568 <at> debbugs.gnu.org Subject: Re: [bug#78568] [PATCH 5/5] teams: Add ‘sync-codeberg-teams’ action. Date: Tue, 27 May 2025 17:32:26 +0900
Hi,
Ludovic Courtès <ludo <at> gnu.org> writes:
> * etc/teams.scm (<forgejo-team>): New JSON mapping.
> (unit-map->json, json->unit-map): New procedures.
> (%default-forgejo-team-units, %default-forgejo-team-unit-map)
> (%codeberg-organization): New variables.
> (codeberg-url, forgejo-http-headers): New procedures.
> (&forgejo-error): New record type.
> (process-url-components, define-forgejo-request): New macros.
> (organization-teams, create-team, add-team-member)
> (team->forgejo-team, synchronize-team, synchronize-teams): New
> procedures.
> (main): Add ‘sync-codeberg-teams’ action.
That's a sizable amount of code! Maybe we should embark on a
guile-codeberg project at some point to have a library for interacting
with its API.
> Change-Id: I6b1f437a3407bc2d44965519990deb524afa9528
> ---
> etc/teams.scm | 252 +++++++++++++++++++++++++++++++++++++++++++++++++-
> 1 file changed, 250 insertions(+), 2 deletions(-)
>
> diff --git a/etc/teams.scm b/etc/teams.scm
> index e881e916ab..08ca891e0d 100755
> --- a/etc/teams.scm
> +++ b/etc/teams.scm
> @@ -41,12 +41,21 @@
> (use-modules (srfi srfi-1)
> (srfi srfi-9)
> (srfi srfi-26)
> + (srfi srfi-34)
> + (srfi srfi-35)
> + (srfi srfi-71)
> (ice-9 format)
> (ice-9 regex)
> (ice-9 match)
> (ice-9 rdelim)
> (guix ui)
> - (git))
> + (git)
> + (json)
> + (web client)
> + (web request)
> + (web response)
> + (rnrs bytevectors)
> + (guix base64))
>
> (define-record-type <regexp*>
> (%make-regexp* pat flag rx)
> @@ -116,6 +125,241 @@ (define-syntax-rule (define-member person teams ...)
> team (cons p (team-members team)))))
> (quote (teams ...)))))
>
> +
> +;;;
> +;;; Forgejo support.
> +;;;
> +
> +;; Forgejo team. This corresponds to both the 'Team' and 'CreateTeamOption'
> +;; structures in Forgejo.
> +(define-json-mapping <forgejo-team>
> + forgejo-team forgejo-team?
> + json->forgejo-team <=> forgejo-team->json
> + (name forgejo-team-name)
> + (id forgejo-team-id) ;integer
> + (description forgejo-team-description)
> + (all-repositories? forgejo-team-all-repositories?
> + "includes_all_repositories")
> + (can-create-org-repository? forgejo-team-can-create-org-repository?
> + "can_create_org_repo")
> + (permission forgejo-team-permission
> + "permission" string->symbol symbol->string)
> + ;; A 'units' field exists but is deprecated in favor of 'units_map'.
> + (unit-map forgejo-team-unit-map
> + "units_map" json->unit-map unit-map->json))
> +
> +(define (unit-map->json lst)
> + (map (match-lambda
> + ((unit . permission)
> + (cons unit (symbol->string permission))))
> + lst))
> +
> +(define (json->unit-map lst)
> + (map (match-lambda
> + ((unit . permission)
> + (cons unit (string->symbol permission))))
> + lst))
> +
> +(define %default-forgejo-team-units
> + '("repo.code" "repo.issues" "repo.pulls" "repo.releases"
> + "repo.wiki" "repo.ext_wiki" "repo.ext_issues" "repo.projects"
> + "repo.packages" "repo.actions"))
> +
> +(define %default-forgejo-team-unit-map
> + ;; Everything (including "repo.code") is read-only by default, except a few
> + ;; units.
> + (map (match-lambda
> + ("repo.pulls" (cons "repo.pulls" 'write))
> + ("repo.issues" (cons "repo.issues" 'write))
> + ("repo.wiki" (cons "repo.wiki" 'write))
> + (unit (cons unit 'read)))
> + %default-forgejo-team-units))
>
> +(define (forgejo-http-headers token)
> + "Return the HTTP headers for basic authorization with TOKEN."
> + `((content-type . (application/json (charset . "UTF-8")))
> + ;; The "Auth Basic" scheme needs a base64-encoded colon-separated user and
> + ;; token values. Forgejo doesn't seem to care for the user part but the
> + ;; colon seems to be necessary for the token value to get extracted.
> + (authorization . (basic . ,(base64-encode
> + (string->utf8
> + (string-append ":" token)))))))
> +
> +;; Error with a Forgejo request.
> +(define-condition-type &forgejo-error &error
> + forgejo-error?
> + (url forgejo-error-url)
> + (method forgejo-error-method)
> + (response forgejo-error-response))
> +
> +(define %codeberg-organization
> + ;; Name of the organization at codeberg.org.
> + "guix")
> +
> +(define* (codeberg-url items #:key (parameters '()))
> + "Construct a Codeberg API URL with the path components ITEMS and query
> +PARAMETERS."
> + (define query
> + (match parameters
> + (() "")
> + (((keys . values) ...)
> + (string-append "?" (string-join
> + (map (lambda (key value)
> + (string-append key "=" value)) ;XXX: hackish
Why is the above considered hackish? You could use cut to simplify
out the lambda.
[...]
> +(define* (synchronize-team token team
> + #:key
> + (current-teams
> + (organization-teams token
> + %codeberg-organization))
> + (log-port (current-error-port)))
> + "Synchronize TEAM, a <team> record, so that its metadata and list of members
> +are accurate on Codeberg. Lookup team IDs among CURRENT-TEAMS."
> + (let ((forgejo-team
> + (find (let ((name (team-id->forgejo-id (team-id team))))
> + (lambda (candidate)
> + (string=? (forgejo-team-name candidate) name)))
> + current-teams)))
> + (when forgejo-team
> + ;; Delete the previously-created team.
> + (format log-port "team '~a' already exists; deleting it~%"
> + (forgejo-team-name forgejo-team))
> + (delete-team token forgejo-team))
It'd be nicer to update the team, maybe lighter for the endpoint? What
was the rationale for going with this more brute force approach? Was
the API complex to use, or not available for this?
> + ;; Create the team.
> + (let ((forgejo-team
> + (create-team token %codeberg-organization
> + (or forgejo-team
> + (team->forgejo-team team)))))
> + (format log-port "created team '~a'~%"
> + (forgejo-team-name forgejo-team))
> + (let ((members (filter-map person-codeberg-account
> + (team-members team))))
> + (for-each (lambda (member)
> + (add-team-member token forgejo-team member))
> + members)
> + (format log-port "added ~a members to team '~a'~%"
> + (length members)
> + (forgejo-team-name forgejo-team))
> + forgejo-team))))
> +
> +(define (synchronize-teams token)
> + "Push all the existing teams on Codeberg."
> + (let ((teams (sort-teams
> + (hash-map->list (lambda (_ value) value) %teams))))
> + (format (current-error-port)
> + "creating ~a teams in the '~a' organization at Codeberg...~%"
> + (length teams) %codeberg-organization)
A bit odd to use current-error-port for this message here; I think the
other usages of current-error-port were motivated by the fact that the
other actions of the script were producing copy-pastable output, so you
could redirect the errors somewhere to avoid corrupting it? But that's
not an issue here, so I think we should use current-output-port.
> +
> + ;; Arrange to compute the list of existing teams once and for all.
> + (for-each (let ((teams (organization-teams token
> + %codeberg-organization)))
> + (lambda (team)
> + (synchronize-team token team
> + #:current-teams teams)))
> + teams)))
Interesting technique.
Apart from having preferred a more surgical approach to update the teams
(assuming that would be less overhead for Codeberg), this LGTM.
--
Thanks,
Maxim
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Tue, 27 May 2025 10:32:01 GMT) Full text and rfc822 format available.Message #26 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Cc: 78568 <at> debbugs.gnu.org Subject: Re: [bug#78568] [PATCH 5/5] teams: Add ‘sync-codeberg-teams’ action. Date: Tue, 27 May 2025 12:25:42 +0200
Hi Maxim, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> writes: > That's a sizable amount of code! Maybe we should embark on a > guile-codeberg project at some point to have a library for interacting > with its API. Agreed. >> +(define* (codeberg-url items #:key (parameters '())) >> + "Construct a Codeberg API URL with the path components ITEMS and query >> +PARAMETERS." >> + (define query >> + (match parameters >> + (() "") >> + (((keys . values) ...) >> + (string-append "?" (string-join >> + (map (lambda (key value) >> + (string-append key "=" value)) ;XXX: hackish > > Why is the above considered hackish? You could use cut to simplify > out the lambda. Because it could in theory construct an invalid URL. It’s OK here because we can assume that KEY and VALUE don’t contain things like ampersands, question marks, etc. >> +(define* (synchronize-team token team >> + #:key >> + (current-teams >> + (organization-teams token >> + %codeberg-organization)) >> + (log-port (current-error-port))) >> + "Synchronize TEAM, a <team> record, so that its metadata and list of members >> +are accurate on Codeberg. Lookup team IDs among CURRENT-TEAMS." >> + (let ((forgejo-team >> + (find (let ((name (team-id->forgejo-id (team-id team)))) >> + (lambda (candidate) >> + (string=? (forgejo-team-name candidate) name))) >> + current-teams))) >> + (when forgejo-team >> + ;; Delete the previously-created team. >> + (format log-port "team '~a' already exists; deleting it~%" >> + (forgejo-team-name forgejo-team)) >> + (delete-team token forgejo-team)) > > It'd be nicer to update the team, maybe lighter for the endpoint? What > was the rationale for going with this more brute force approach? Was > the API complex to use, or not available for this? Updating in general is tricky: you would need to check every aspect of the team, compute the diff between the current list of members and the target list of members, etc. It’s more code and it’s hard to get it right. Since the remove/recreate approach doesn’t have undesirable side effects AFAICS, and since it’s much easier and more reliable, I went for it. >> + (format (current-error-port) >> + "creating ~a teams in the '~a' organization at Codeberg...~%" >> + (length teams) %codeberg-organization) > > A bit odd to use current-error-port for this message here; I think the > other usages of current-error-port were motivated by the fact that the > other actions of the script were producing copy-pastable output, so you > could redirect the errors somewhere to avoid corrupting it? But that's > not an issue here, so I think we should use current-output-port. It’s in traditional Unix fashion: logging and error messages go to standard error. > Apart from having preferred a more surgical approach to update the teams > (assuming that would be less overhead for Codeberg), this LGTM. Thanks! Ludo’.
guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Wed, 28 May 2025 21:22:01 GMT) Full text and rfc822 format available.Message #29 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Cc: 78568 <at> debbugs.gnu.org Subject: Re: [bug#78568] [PATCH 5/5] teams: Add ‘sync-codeberg-teams’ action. Date: Wed, 28 May 2025 19:46:59 +0200
Hello, Pushed as 848ebb7f72fa529b0a3da47fbef2a6cf6f7fba8a. I added Codeberg account names that people gave on guix-devel in the meantime. There are still a few missing. Thanks, Ludo’.
Ludovic Courtès <ludo <at> gnu.org>
to control <at> debbugs.gnu.org.
(Wed, 28 May 2025 21:22:02 GMT) Full text and rfc822 format available.guix-patches <at> gnu.org:bug#78568; Package guix-patches.
(Wed, 28 May 2025 21:52:02 GMT) Full text and rfc822 format available.Message #34 received at 78568 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Cc: 78568 <at> debbugs.gnu.org Subject: Re: [bug#78568] [PATCH 5/5] teams: Add ‘sync-codeberg-teams’ action. Date: Wed, 28 May 2025 23:29:48 +0200
Turns out that the brute-force approach breaks assumptions in Forgejo after all: https://codeberg.org/Codeberg/Community/issues/1952#issuecomment-4899291 So I’ll have to do what you suggested and explicitly synchronize the various bits without deleting/recreating teams. Ludo’.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.