diff options
Diffstat (limited to 'forge/webhook.scm')
| -rw-r--r-- | forge/webhook.scm | 192 |
1 files changed, 192 insertions, 0 deletions
diff --git a/forge/webhook.scm b/forge/webhook.scm new file mode 100644 index 0000000..e61494b --- /dev/null +++ b/forge/webhook.scm @@ -0,0 +1,192 @@ +;;; 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))))))) |