mirror/guix
mirror/guix
1
Fork 0
mirror of https://https.git.savannah.gnu.org/git/guix.git/ synced 2025-07-13 10:30:43 +02:00
Code Releases Activity

teams: Synchronize teams without deleting and recreating them.

Browse source 
The brute-force approach previously used would cause confusion on
Codeberg: deleted teams previously recorded as reviewers of PRs would be
considered “ghost teams”.

  https://codeberg.org/Codeberg/Community/issues/1952

* etc/teams.scm (<forgejo-user>): New record type.
(edit-team, forgejo-team-members): New forgejo requests.
(update-team): New procedure.
(synchronize-team): Change to use ‘update-team’ when TEAM already
exists.

Change-Id: Id7d3b21a43abaaf21920f2201296fb95acda2270
This commit is contained in:
Ludovic Courtès 2025-05-29 17:48:15 +02:00
parent 5afcbfccc9
commit 2b0961b005
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 73 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

96
etc/teams.scm
View file

@ -175,6 +175,17 @@ exec $pre_inst_env_maybe guix repl -- "$0" "$@"
(unit (cons unit 'read)))
%default-forgejo-team-units))
;; Forgejo user, as returned by 'forgejo-team-members'.
(define-json-mapping <forgejo-user>
forgejo-user forgejo-user?
json->forgejo-user <=> forgejo-user->json
(id forgejo-user-id) ;integer
(active? forgejo-user-active? "active") ;boolean
(login forgejo-user-login) ;string
(full-name forgejo-user-full-name "full_name") ;string
;; Various fields omitted.
)
(define (forgejo-http-headers token)
"Return the HTTP headers for basic authorization with TOKEN."
`((content-type . (application/json (charset . "UTF-8")))
@ -287,11 +298,27 @@ PARAMETERS."
=> 201
json->forgejo-team)
(define-forgejo-request (edit-team team)
"Update TEAM, a Forgejo team."
(PATCH "teams" (number->string (forgejo-team-id team)))
(forgejo-team->json team)
=> 200
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 (forgejo-team-members team)
"Return the list of account names of the members of TEAM, a Forgejo team."
(GET "teams" (number->string (forgejo-team-id team)) "members"
& '(("limit" . "100"))) ;get up to 100 members
=> 200
(lambda (port)
(set-port-encoding! port "UTF-8")
(map json->forgejo-user (vector->list (json->scm port)))))
(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))
@ -308,6 +335,32 @@ PARAMETERS."
'read ;permission
%default-forgejo-team-unit-map))
(define* (update-team token forgejo-team team
#:key (log-port (current-error-port)))
"Update FORGEJO-TEAM on the server so that it matches TEAM."
(format log-port "updating team '~a'~%"
(forgejo-team-name forgejo-team))
;; Update metadata: description, permissions, etc.
(edit-team token forgejo-team)
;; Update the list of members so it matches those of TEAM.
(let* ((current (map forgejo-user-login
(forgejo-team-members token forgejo-team)))
(target (filter-map person-codeberg-account
(team-members team)))
(to-add (lset-difference string=? target current))
(to-remove (lset-difference string=? current target)))
(for-each (lambda (user)
(format log-port "adding '~a' to team '~a'~%"
user (forgejo-team-name forgejo-team))
(add-team-member token forgejo-team user))
to-add)
(for-each (lambda (user)
(format log-port "removing '~a' from team '~a'~%"
user (forgejo-team-name forgejo-team)))
to-remove)))
(define* (synchronize-team token team
#:key
(current-teams
@ -315,34 +368,31 @@ PARAMETERS."
%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."
are accurate on Codeberg, either by creating it or by updating it if it
already exists. 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))))
(if forgejo-team
(update-team token forgejo-team team
#:log-port log-port)
(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."