Move channel modules into subdirectory.

We don't want the scm files in doc to be picked up on `guix pull'.

* .guix-channel: New file.
* forge: Move to guix/forge.

5 files changed, 761 insertions, 0 deletions

diff --git a/guix/forge/build/git.scm b/guix/forge/build/git.scm
new file mode 100644
index 0000000..1434d07
--- /dev/null
+++ b/guix/forge/build/git.scm
@@ -0,0 +1,76 @@
+;;; guix-forge --- Guix software forge meta-service
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of guix-forge.
+;;;
+;;; guix-forge is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; guix-forge is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with guix-forge.  If not, see
+;;; <https://www.gnu.org/licenses/>.
+
+(define-module (forge build git)
+  #:use-module (rnrs exceptions)
+  #:use-module (guix build utils)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:export (download-git-to-store
+            latest-git-checkout))
+
+;;;
+;;; Commentary:
+;;;
+;;; This module provides build-side code to download a git repository
+;;; to the store.
+;;;
+
+;;; Code:
+
+(define (hline)
+  "Print a horizontal line 50 '=' characters long."
+  (display (make-string 50 #\=))
+  (newline)
+  (force-output))
+
+(define* (download-git-to-store store name url #:key branch show-commit?)
+  "Download BRANCH of git repository from URL to STORE under NAME and
+return store path. If BRANCH is not specified, the default branch is
+downloaded. git and certificates should be in the environment."
+  (call-with-temporary-directory
+   (lambda (directory)
+     (with-directory-excursion directory
+       (guard (condition ((invoke-error? condition)
+                          (format (current-error-port)
+                                  "'~a~{ ~a~}' failed with exit code ~a~%"
+                                  (invoke-error-program condition)
+                                  (invoke-error-arguments condition)
+                                  (invoke-error-exit-status condition))
+                          (exit #f)))
+         (apply invoke
+                "git" "clone" "--quiet" "--depth" "1"
+                ;; Append file:// to local repository path so that
+                ;; shallow clone works.
+                (if (string-prefix? "/" url)
+                    (string-append "file://" url)
+                    url)
+                (append (if branch
+                            (list "--branch" branch)
+                            (list))
+                        (list "."))))
+       (when show-commit?
+         (hline)
+         (invoke "git" "--no-pager" "log")
+         (hline))
+       (delete-file-recursively ".git"))
+     (add-to-store store name #t "sha256" directory))))
+
+(define latest-git-checkout
+  (store-lift download-git-to-store))
diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm
new file mode 100644
index 0000000..e88edb0
--- /dev/null
+++ b/guix/forge/forge.scm
@@ -0,0 +1,287 @@
+;;; guix-forge --- Guix software forge meta-service
+;;; Copyright © 2021, 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of guix-forge.
+;;;
+;;; guix-forge is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; guix-forge is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with guix-forge.  If not, see
+;;; <https://www.gnu.org/licenses/>.
+
+(define-module (forge forge)
+  #:use-module (gnu)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module ((gnu packages certs) #:select (nss-certs))
+  #:use-module (gnu packages ci)
+  #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
+  #:use-module ((gnu packages guile) #:select (guile-3.0 guile-zlib))
+  #:use-module ((gnu packages version-control) #:select (git-minimal))
+  #:use-module (gnu services mcron)
+  #:use-module (guix modules)
+  #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (guix store)
+  #:use-module (forge laminar)
+  #:use-module (forge utils)
+  #:use-module (forge webhook)
+  #:export (forge-service-type
+            forge-configuration
+            forge-configuration?
+            forge-configuration-projects
+            forge-project
+            forge-project?
+            this-forge-project
+            forge-project-name
+            forge-project-user
+            forge-project-repository
+            forge-project-repository-branch
+            forge-project-website-directory
+            forge-project-ci-jobs
+            forge-project-ci-jobs-trigger
+            derivation-job-gexp))
+
+(define-record-type* <forge-project>
+  forge-project make-forge-project
+  forge-project?
+  this-forge-project
+  (name forge-project-name)
+  ;; The user field is optional because the repository may be remote
+  ;; and not need to be owned by any user.
+  (user forge-project-user
+        (default #f))
+  (repository forge-project-repository)
+  (repository-branch forge-project-repository-branch
+                     (default "main"))
+  (description forge-project-description
+               (default #f))
+  (website-directory forge-project-website-directory
+                     (default #f))
+  (ci-jobs forge-project-ci-jobs
+           (default '()) (thunked))
+  (ci-jobs-trigger forge-project-ci-jobs-trigger ; one of 'post-receive-hook, 'cron, 'webhook
+                   (default (cond
+                             ;; 'post-receive-hook for local repositories
+                             ((string-prefix? "/" (forge-project-repository this-forge-project))
+                              'post-receive-hook)
+                             ;; 'cron for remote repositories
+                             (else 'cron)))
+                   (thunked)))
+
+(define-record-type* <forge-configuration>
+  forge-configuration make-forge-configuration
+  forge-configuration?
+  (projects forge-configuration-projects
+            (default '())))
+
+(define* (ci-jobs-trigger-gexp ci-jobs #:key reason)
+  "Return a G-expression that triggers CI-JOBS. CI-JOBS is a list of
+<forge-laminar-job> objects."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+        ;; TODO: Only trigger on updates to the main/master branch.
+        (display "Triggering continuous integration jobs..." (current-error-port))
+        (newline (current-error-port))
+        (when #$reason
+          (setenv "LAMINAR_REASON" #$reason))
+        (apply invoke
+               #$(file-append laminar "/bin/laminarc")
+               "queue" '#$(map forge-laminar-job-name ci-jobs)))))
+
+(define (forge-activation config)
+  (let ((projects
+         (map (lambda (project)
+                (list (forge-project-user project)
+                      (forge-project-repository project)
+                      (forge-project-description project)
+                      (forge-project-website-directory project)
+                      (program-file
+                       (forge-project-name project)
+                       (ci-jobs-trigger-gexp
+                        (forge-project-ci-jobs project)
+                        #:reason "post-receive hook"))
+                      (forge-project-ci-jobs-trigger project)))
+              (forge-configuration-projects config))))
+    #~(begin
+        (use-modules (rnrs io ports)
+                     (srfi srfi-26)
+                     (ice-9 match))
+        
+        (define (find-regular-files dir)
+          (find-files dir (lambda (file stat)
+                            (memq (stat:type stat)
+                                  '(regular directory)))
+                      #:directories? #t))
+        
+        (for-each (match-lambda
+                    ((username repository description website-directory ci-jobs-trigger ci-jobs-trigger-type)
+                     ;; For local repositories only
+                     (when (string-prefix? "/" repository)
+                       ;; Set description.
+                       (when description
+                         (call-with-output-file (string-append repository "/description")
+                           (cut put-string <> description)))
+                       ;; Set ownership of repository files.
+                       (for-each (lambda (file)
+                                   (let ((user (getpw username)))
+                                     (chown file (passwd:uid user) (passwd:gid user))))
+                                 (append (find-regular-files repository))))
+                     ;; Install post receive hook.
+                     (when (eq? ci-jobs-trigger-type 'post-receive-hook)
+                       (let ((hook-link (string-append repository "/hooks/post-receive")))
+                         (when (file-exists? hook-link)
+                           (delete-file hook-link))
+                         (symlink ci-jobs-trigger hook-link)))
+                     ;; Set ownership of website directory.
+                     (when website-directory
+                       (let ((user (getpw "laminar")))
+                         (chown website-directory (passwd:uid user) (passwd:gid user))))))
+                  '#$projects))))
+
+(define (import-module? name)
+  "Return #t if module NAME may be imported.  Else, return #f."
+  (match name
+    (('forge _ ...) #t)
+    (name (guix-module-name? name))))
+
+(define* (derivation-job-gexp project job gexp-producer
+                              #:key (guix-daemon-uri (%daemon-socket-uri)))
+  "Return a G-expression that builds another G-expression as a
+derivation and returns its output path. GEXP-PRODUCER is a
+G-expression that expands to a lambda function. The lambda function
+takes one argument---the latest git checkout of PROJECT, a
+<forge-project> object---and returns a G-expression describing a
+derivation to run. JOB is a <forge-laminar-job> object representing
+the job that this derivation will be part of. GUIX_DAEMON_URI is a
+file name or URI designating the Guix daemon endpoint."
+  (with-imported-modules (source-module-closure '((forge build git)
+                                                  (guix gexp)
+                                                  (guix profiles))
+                                                #:select? import-module?)
+    (with-extensions (list guile-gcrypt guile-zlib)
+      (with-packages (list git-minimal nss-certs)
+        #~(begin
+            ;; We pull out macros using module-ref and functions using
+            ;; @@ instead of using use-modules because this gexp might
+            ;; be substituted into other gexps and use-modules only
+            ;; works at the top-level.
+            (let-syntax ((guard (macro-transformer
+                                 (module-ref (resolve-module '(rnrs exceptions))
+                                             'guard)))
+                         (mbegin (macro-transformer
+                                  (module-ref (resolve-module '(guix monads))
+                                              'mbegin)))
+                         (mlet* (macro-transformer
+                                 (module-ref (resolve-module '(guix monads))
+                                             'mlet*)))
+                         (with-store (macro-transformer
+                                      (module-ref (resolve-module '(guix store))
+                                                  'with-store)))
+                         (return (identifier-syntax ((@@ (guix store) %store-monad)
+                                                     %return))))
+              (let* ((latest-git-checkout (@@ (forge build git) latest-git-checkout))
+                     (built-derivations (@@ (guix derivations) built-derivations))
+                     (derivation->output-path (@@ (guix derivations) derivation->output-path))
+                     (read-derivation-from-file (@@ (guix derivations) read-derivation-from-file))
+                     (gexp->derivation (@@ (guix gexp) gexp->derivation))
+                     (%daemon-socket-uri (@@ (guix store) %daemon-socket-uri))
+                     (%store-monad (@@ (guix store) %store-monad))
+                     (store-protocol-error? (@@ (guix store) store-protocol-error?))
+                     (run-with-store (@@ (guix store) run-with-store))
+                     (derivation-output
+                      (parameterize ((%daemon-socket-uri #$guix-daemon-uri))
+                        (with-store store
+                          (guard (condition ((store-protocol-error? condition)
+                                             (exit #f)))
+                            (run-with-store store
+                              (mlet* %store-monad ((git-checkout (latest-git-checkout
+                                                                  #$(string-append (forge-project-name project)
+                                                                                   "-checkout")
+                                                                  #$(forge-project-repository project)
+                                                                  #:show-commit? #t))
+                                                   (drv (gexp->derivation #$(string-append
+                                                                             (forge-laminar-job-name job)
+                                                                             "-derivation")
+                                                          (#$gexp-producer git-checkout)
+                                                          #:guile-for-build (read-derivation-from-file
+                                                                             #$(raw-derivation-file
+                                                                                (with-store store
+                                                                                  (package-derivation store guile-3.0))))
+                                                          #:substitutable? #f)))
+                                (mbegin %store-monad
+                                  (built-derivations (list drv))
+                                  (return (derivation->output-path drv))))))))))
+                (format (current-error-port) "Built ~a successfully~%" derivation-output)
+                derivation-output)))))))
+
+(define forge-service-type
+  (service-type
+   (name 'forge)
+   (description "Run guix-forge.")
+   (extensions (list (service-extension activation-service-type
+                                        forge-activation)
+                     (service-extension forge-laminar-service-type
+                                        (lambda (config)
+                                          (append
+                                           ;; jobs
+                                           (append-map forge-project-ci-jobs
+                                                       (forge-configuration-projects config))
+                                           ;; group jobs by project
+                                           (filter-map (lambda (project)
+                                                         (match (forge-project-ci-jobs project)
+                                                           (() #f)
+                                                           ((job) #f)
+                                                           (jobs
+                                                            (forge-laminar-group
+                                                             (name (forge-project-name project))
+                                                             (regex (string-append "^(?:"
+                                                                                   (string-join (map forge-laminar-job-name jobs)
+                                                                                                "|")
+                                                                                   ")$"))))))
+                                                       (forge-configuration-projects config)))))
+                     ;; Set up cron jobs to trigger CI jobs for remote
+                     ;; repositories.
+                     ;; TODO: Run CI job only if there are new commits
+                     ;; in the remote repository.
+                     (service-extension mcron-service-type
+                                        (lambda (config)
+                                          (filter-map (lambda (project)
+                                                        (and (eq? (forge-project-ci-jobs-trigger project)
+                                                                  'cron)
+                                                             #~(job '(next-day)
+                                                                    #$(program-file
+                                                                       (forge-project-name project)
+                                                                       (ci-jobs-trigger-gexp
+                                                                        (forge-project-ci-jobs project)
+                                                                        #:reason "Cron job"))
+                                                                    #:user "laminar")))
+                                                      (forge-configuration-projects config))))
+                     (service-extension webhook-service-type
+                                        (lambda (config)
+                                          (filter-map (lambda (project)
+                                                        (and (eq? (forge-project-ci-jobs-trigger project)
+                                                                  'webhook)
+                                                             (webhook-hook
+                                                              (id (forge-project-name project))
+                                                              (run (ci-jobs-trigger-gexp
+                                                                    (forge-project-ci-jobs project)
+                                                                    #:reason "Webhook")))))
+                                                      (forge-configuration-projects config))))))
+   (compose concatenate)
+   (extend (lambda (config projects)
+             (forge-configuration
+              (inherit config)
+              (projects (append (forge-configuration-projects config)
+                                projects)))))
+   (default-value (forge-configuration))))
diff --git a/guix/forge/laminar.scm b/guix/forge/laminar.scm
new file mode 100644
index 0000000..5d95372
--- /dev/null
+++ b/guix/forge/laminar.scm
@@ -0,0 +1,135 @@
+;;; guix-forge --- Guix software forge meta-service
+;;; Copyright © 2021, 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of guix-forge.
+;;;
+;;; guix-forge is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; guix-forge is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with guix-forge.  If not, see
+;;; <https://www.gnu.org/licenses/>.
+
+(define-module (forge laminar)
+  #:use-module (gnu)
+  #:use-module (srfi srfi-1)
+  #:use-module (gnu packages ci)
+  #:use-module (gnu services ci)
+  #:use-module (guix records)
+  #:export (forge-laminar-service-type
+            forge-laminar-configuration
+            forge-laminar-configuration?
+            forge-laminar-configuration-state-directory
+            forge-laminar-configuration-jobs
+            forge-laminar-job
+            forge-laminar-job?
+            this-forge-laminar-job
+            forge-laminar-job-name
+            forge-laminar-job-run
+            forge-laminar-job-after
+            forge-laminar-group
+            forge-laminar-group?
+            forge-laminar-group-name
+            forge-laminar-group-regex))
+
+(define-record-type* <forge-laminar-configuration>
+  forge-laminar-configuration make-forge-laminar-configuration
+  forge-laminar-configuration?
+  (state-directory forge-laminar-configuration-state-directory
+                   (default "/var/lib/laminar"))
+  (jobs forge-laminar-configuration-jobs
+        (default '()))
+  (groups forge-laminar-configuration-groups
+          (default '())))
+
+(define-record-type* <forge-laminar-job>
+  forge-laminar-job make-forge-laminar-job
+  forge-laminar-job?
+  this-forge-laminar-job
+  (name forge-laminar-job-name)
+  (run forge-laminar-job-run (thunked))
+  (after forge-laminar-job-after
+         (default #f)))
+
+(define-record-type* <forge-laminar-group>
+  forge-laminar-group make-forge-laminar-group
+  forge-laminar-group?
+  (name forge-laminar-group-name)
+  (regex forge-laminar-group-regex))
+
+(define (forge-laminar-activation config)
+  (let* ((state-directory (forge-laminar-configuration-state-directory config))
+         (configuration-directory (string-append state-directory "/cfg"))
+         (groups-configuration (string-append configuration-directory "/groups.conf"))
+         (jobs-directory (string-append configuration-directory "/jobs")))
+    #~(begin
+        (use-modules (srfi srfi-26))
+
+        ;; Ensure configuration directory exists.
+        (mkdir-p #$configuration-directory)
+        ;; Configure groups.
+        (when (file-exists? #$groups-configuration)
+          (delete-file #$groups-configuration))
+        (symlink
+         #$(plain-file "laminar-groups"
+                       (string-join (map (lambda (group)
+                                           (string-append (forge-laminar-group-name group)
+                                                          "="
+                                                          (forge-laminar-group-regex group)))
+                                         (forge-laminar-configuration-groups config))
+                                    "\n"))
+         #$groups-configuration)
+        ;; Create jobs directory and populate with job scripts.
+        (mkdir-p #$(dirname jobs-directory))
+        (when (file-exists? #$jobs-directory)
+          (delete-file #$jobs-directory))
+        (symlink
+         #$(file-union "laminar-jobs"
+                       (append-map (lambda (job)
+                                     (let ((name (forge-laminar-job-name job))
+                                           (run (forge-laminar-job-run job))
+                                           (after (forge-laminar-job-after job)))
+                                       (cons (list (string-append name ".run")
+                                                   (program-file name run))
+                                             (if after
+                                                 (list (list (string-append name ".after")
+                                                             (program-file name after)))
+                                                 (list)))))
+                                   (forge-laminar-configuration-jobs config)))
+         #$jobs-directory)
+        ;; Set permissions for laminar directory.
+        (for-each (lambda (file)
+                    (let ((user (getpw "laminar")))
+                      (chown file (passwd:uid user) (passwd:gid user))))
+                  (find-files #$state-directory
+                              (lambda (file stat)
+                                (memq (stat:type stat)
+                                      '(regular directory)))
+                              #:directories? #t)))))
+
+(define forge-laminar-service-type
+  (service-type
+   (name 'forge-laminar)
+   (description "Run forge-laminar.")
+   (extensions (list (service-extension activation-service-type
+                                        forge-laminar-activation)
+                     ;; Extend the laminar service with a dummy value,
+                     ;; thus requiring it.
+                     (service-extension laminar-service-type
+                                        (const #t))))
+   (compose concatenate)
+   (extend (lambda (config extended-values)
+             (forge-laminar-configuration
+              (inherit config)
+              (jobs (append (forge-laminar-configuration-jobs config)
+                            (filter forge-laminar-job? extended-values)))
+              (groups (append (forge-laminar-configuration-groups config)
+                              (filter forge-laminar-group? extended-values))))))
+   (default-value (forge-laminar-configuration))))
diff --git a/guix/forge/utils.scm b/guix/forge/utils.scm
new file mode 100644
index 0000000..dd980ef
--- /dev/null
+++ b/guix/forge/utils.scm
@@ -0,0 +1,70 @@
+;;; guix-forge --- Guix software forge meta-service
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of guix-forge.
+;;;
+;;; guix-forge is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; guix-forge is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with guix-forge.  If not, see
+;;; <https://www.gnu.org/licenses/>.
+
+(define-module (forge utils)
+  #:use-module (ice-9 match)
+  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix profiles)
+  #:use-module (guix search-paths)
+  #:use-module (guix store)
+  #:export (with-packages))
+
+(define (profile-with-packages packages)
+  "Return profile with PACKAGES."
+  (with-store store
+    (run-with-store store
+      (mlet* %store-monad ((prof-drv (profile-derivation
+                                      (packages->manifest packages)))
+                           (profile -> (derivation->output-path prof-drv)))
+        (mbegin %store-monad
+          (built-derivations (list prof-drv))
+          (return profile))))))
+
+(define (environment-with-packages packages)
+  "Return environment of a profile with PACKAGES. Return value is an
+association list mapping the name of an environment variable to its
+value."
+  (map (match-lambda
+         ((search-path . value)
+          (cons (search-path-specification-variable search-path)
+                value)))
+       (profile-search-paths (profile-with-packages packages))))
+
+(define (with-packages packages exp)
+  "Return a gexp executing EXP, another gexp, in an environment where
+PACKAGES are available and their search path environment variables
+have been set."
+  #~(begin
+      ;; Add a reference to the profile.
+      #$(profile-with-packages packages)
+      ;; Set the environment.
+      ;; We pull out match-lambda using module-ref instead of using
+      ;; use-modules because this gexp will be substituted into other
+      ;; gexps and use-modules only works at the top-level.
+      (let-syntax ((match-lambda (macro-transformer
+                                  (module-ref (resolve-module '(ice-9 match))
+                                              'match-lambda))))
+        (for-each (match-lambda
+                    ((variable . value)
+                     (setenv variable value)))
+                  '#$(environment-with-packages packages)))
+      ;; Run the provided expression.
+      #$exp))
diff --git a/guix/forge/webhook.scm b/guix/forge/webhook.scm
new file mode 100644
index 0000000..737b9e6
--- /dev/null
+++ b/guix/forge/webhook.scm
@@ -0,0 +1,193 @@
+;;; guix-forge --- Guix software forge meta-service
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of guix-forge.
+;;;
+;;; guix-forge is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; guix-forge is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with guix-forge.  If not, see
+;;; <https://www.gnu.org/licenses/>.
+
+(define-module (forge webhook)
+  #:use-module (srfi srfi-1)
+  #:use-module ((gnu packages admin) #:select (shadow))
+  #:use-module ((gnu packages guile) #:select (guile-json-4))
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system accounts)
+  #:use-module (gnu system shadow)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix records)
+  #:use-module (guix packages)
+  #:use-module (guix git-download)
+  #:use-module (guix build-system go)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:export (webhook-service-type
+            webhook-configuration
+            webhook-configuration?
+            webhook-configuration-package
+            webhook-configuration-port
+            webhook-configuration-log-directory
+            webhook-configuration-hooks
+            webhook-hook
+            webhook-hook?
+            webhook-hook-id
+            webhook-hook-run))
+
+(define webhook
+  (package
+    (name "webhook")
+    (version "2.8.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/adnanh/webhook")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0n03xkgwpzans0cymmzb0iiks8mi2c76xxdak780dk0jbv6qgp5i"))))
+    (build-system go-build-system)
+    (arguments
+     `(#:import-path "github.com/adnanh/webhook"
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'configure
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "src/github.com/adnanh/webhook/webhook_test.go"
+               (("/bin/echo")
+                (string-append (assoc-ref inputs "coreutils")
+                               "/bin/echo"))))))))
+    (home-page "https://github.com/adnanh/webhook")
+    (synopsis "Lightweight incoming webhook server")
+    (description "webhook is a lightweight configurable tool written
+in Go, that allows you to easily create HTTP endpoints (hooks) on your
+server, which you can use to execute configured commands. You can also
+pass data from the HTTP request (such as headers, payload or query
+variables) to your commands. webhook also allows you to specify rules
+which have to be satisfied in order for the hook to be triggered.
+
+For example, if you're using Github or Bitbucket, you can use webhook
+to set up a hook that runs a redeploy script for your project on your
+staging server, whenever you push changes to the master branch of your
+project.
+
+If you use Mattermost or Slack, you can set up an \"Outgoing webhook
+integration\" or \"Slash command\" to run various commands on your
+server, which can then report back directly to you or your channels
+using the \"Incoming webhook integrations\", or the appropriate
+response body.
+
+webhook aims to do nothing more than it should do, and that is:
+
+@itemize
+@item receive the request,
+@item parse the headers, payload and query variables,
+@item check if the specified rules for the hook are satisfied,
+@item and finally, pass the specified arguments to the specified
+command via command line arguments or via environment variables.
+@end itemize
+
+Everything else is the responsibility of the command's author.")
+    (license license:expat)))
+
+(define-record-type* <webhook-configuration>
+  webhook-configuration make-webhook-configuration
+  webhook-configuration?
+  (package webhook-configuration-package
+           (default webhook))
+  (ip webhook-configuration-ip
+      (default "127.0.0.1"))
+  (port webhook-configuration-port
+        (default 9000))
+  (log-directory webhook-configuration-log-directory
+                 (default "/var/log/webhook"))
+  (hooks webhook-configuration-hooks
+         (default '())))
+
+(define-record-type* <webhook-hook>
+  webhook-hook make-webhook-hook
+  webhook-hook?
+  (id webhook-hook-id)
+  (run webhook-hook-run))
+
+(define (webhook-activation config)
+  ;; Create log directory.
+  #~(mkdir-p #$(webhook-configuration-log-directory config)))
+
+(define (hooks-json-gexp config)
+  (with-extensions (list guile-json-4)
+    #~(begin
+        (use-modules (srfi srfi-26)
+                     (json))
+        
+        (call-with-output-file #$output
+          (cut scm->json
+               ;; We convert from list to vector on the build-side
+               ;; because a vector cannot be lowered correctly into a
+               ;; G-expression.
+               (list->vector
+                ;; We build a true dotted association list in this
+                ;; roundabout way because a true dotted association
+                ;; list cannot be lowered correctly into a
+                ;; G-expression.
+                (map (cut map (cut apply cons <>) <>)
+                     '#$(map (lambda (hook)
+                               `(("id" ,(webhook-hook-id hook))
+                                 ("execute-command" ,(program-file (webhook-hook-id hook)
+                                                                   (webhook-hook-run hook)))))
+                             (webhook-configuration-hooks config))))
+               <>)))))
+
+(define webhook-shepherd-service
+  (lambda (config)
+    (shepherd-service
+     (documentation "Run webhook.")
+     (provision '(webhook))
+     (requirement '(networking))
+     (modules '((gnu build shepherd)
+                (gnu system file-systems)))
+     (start (with-imported-modules (source-module-closure
+                                    '((gnu build shepherd)
+                                      (gnu system file-systems)))
+              #~(make-forkexec-constructor/container
+                 (list #$(file-append (webhook-configuration-package config)
+                                      "/bin/webhook")
+                       "-hooks" #$(computed-file "hooks.json"
+                                                 (hooks-json-gexp config))
+                       "-ip" #$(webhook-configuration-ip config)
+                       "-port" #$(number->string (webhook-configuration-port config))
+                       "-logfile" #$(string-append (webhook-configuration-log-directory config)
+                                                   "/webhook.log"))
+                 #:mappings (list (file-system-mapping
+                                   (source #$(webhook-configuration-log-directory config))
+                                   (target source)
+                                   (writable? #t)))
+                 #:log-file "/var/log/webhook.log")))
+     (stop #~(make-kill-destructor)))))
+
+(define webhook-service-type
+  (service-type
+   (name 'webhook)
+   (description "Run webhook.")
+   (extensions (list (service-extension activation-service-type
+                                        webhook-activation)
+                     (service-extension shepherd-root-service-type
+                                        (compose list webhook-shepherd-service))))
+   (compose concatenate)
+   (extend (lambda (config hook-extensions)
+             (webhook-configuration
+              (inherit config)
+              (hooks (append (webhook-configuration-hooks config)
+                             hook-extensions)))))
+   (default-value (webhook-configuration))))