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, 0 insertions, 761 deletions

diff --git a/forge/build/git.scm b/forge/build/git.scm
deleted file mode 100644
index 1434d07..0000000
--- a/forge/build/git.scm
+++ /dev/null
@@ -1,76 +0,0 @@
-;;; 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/forge/forge.scm b/forge/forge.scm
deleted file mode 100644
index e88edb0..0000000
--- a/forge/forge.scm
+++ /dev/null
@@ -1,287 +0,0 @@
-;;; 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/forge/laminar.scm b/forge/laminar.scm
deleted file mode 100644
index 5d95372..0000000
--- a/forge/laminar.scm
+++ /dev/null
@@ -1,135 +0,0 @@
-;;; 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/forge/utils.scm b/forge/utils.scm
deleted file mode 100644
index dd980ef..0000000
--- a/forge/utils.scm
+++ /dev/null
@@ -1,70 +0,0 @@
-;;; 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/forge/webhook.scm b/forge/webhook.scm
deleted file mode 100644
index 737b9e6..0000000
--- a/forge/webhook.scm
+++ /dev/null
@@ -1,193 +0,0 @@
-;;; 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))))