about summary refs log tree commit diff
path: root/forge/webhook.scm
diff options
context:
space:
mode:
authorArun Isaac2022-03-02 17:55:27 +0530
committerArun Isaac2022-03-02 21:04:17 +0530
commitcb7cecae3f6152052bdaf601eb1f6fcb2727b6b9 (patch)
treee369c485363fb08ed2b294e1602d4a209754d506 /forge/webhook.scm
parent419d982bb29dd8a3904e6591796cc7ebc9190fd8 (diff)
downloadguix-forge-cb7cecae3f6152052bdaf601eb1f6fcb2727b6b9.tar.gz
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.
Diffstat (limited to 'forge/webhook.scm')
-rw-r--r--forge/webhook.scm193
1 files changed, 0 insertions, 193 deletions
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))))