aboutsummaryrefslogtreecommitdiff
path: root/forge
diff options
context:
space:
mode:
Diffstat (limited to 'forge')
-rw-r--r--forge/webhook.scm192
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)))))))