diff options
Diffstat (limited to 'genenetwork-development.scm')
| -rw-r--r-- | genenetwork-development.scm | 650 |
1 files changed, 650 insertions, 0 deletions
diff --git a/genenetwork-development.scm b/genenetwork-development.scm new file mode 100644 index 0000000..2465573 --- /dev/null +++ b/genenetwork-development.scm @@ -0,0 +1,650 @@ +;;; genenetwork-machines --- Guix configuration for genenetwork machines +;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of genenetwork-machines. +;;; +;;; genenetwork-machines 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. +;;; +;;; genenetwork-machines 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 genenetwork-machines. If not, see +;;; <https://www.gnu.org/licenses/>. + +(use-modules (gnu) + ((gn packages gemini) #:select (tissue)) + ((gn packages genenetwork) #:select (genenetwork2 genenetwork3)) + ((gn packages quality-control) #:select (sbcl-qc)) + (gn services databases) + ((gnu packages admin) #:select (shepherd)) + ((gnu packages base) #:select (gnu-make)) + ((gnu packages bash) #:select (bash)) + ((gnu packages bioinformatics) #:select (ccwl) #:prefix guix:) + ((gnu packages certs) #:select (nss-certs)) + ((gnu packages check) #:select (python-pylint)) + ((gnu packages ci) #:select (laminar)) + ((gnu packages gnupg) #:select (guile-gcrypt)) + ((gnu packages graphviz) #:select (graphviz)) + ((gnu packages guile) #:select (guile-3.0 guile-zlib)) + ((gnu packages guile-xyz) #:select (guile-dbd-mysql guile-dbi guile-libyaml)) + ((gnu packages guile-xyz) #:select (guile-sparql) #:prefix guix:) + ((gnu packages haskell-apps) #:select (shellcheck)) + ((gnu packages python-check) #:select (python-mypy)) + ((gnu packages python-web) #:select (gunicorn)) + ((gnu packages tls) #:select (openssl)) + ((gnu packages version-control) #:select (git-minimal)) + (gnu services ci) + (gnu services databases) + (gnu services shepherd) + (guix build-system gnu) + (guix git-download) + ((guix licenses) #:prefix license:) + (guix modules) + (guix packages) + (guix profiles) + (guix records) + (guix store) + (forge forge) + (forge laminar) + (forge utils) + (forge webhook) + (srfi srfi-1) + (ice-9 match)) + +;; guix-daemon socket of the host shared inside the container +(define %guix-daemon-uri + "/var/host-guix/daemon-socket/socket") + +(define (manifest-cons package onto-manifest) + "Return a manifest with PACKAGE and all packages in ONTO-MANIFEST." + (manifest (cons (package->manifest-entry package) + (manifest-entries onto-manifest)))) + +(define (manifest-cons* . args) + "ARGS is of the form (PACKAGES ... ONTO-MANIFEST). Return a manifest +with PACKAGES and all packages in ONTO-MANIFEST." + (let ((packages (drop-right args 1)) + (onto-manifest (last args))) + (manifest (append (map package->manifest-entry packages) + (manifest-entries onto-manifest))))) + +(define (import-module? name) + "Return #t if NAME, a list of symbols, denotes a module that should +be imported into G-expressions." + ;; Allow all guix-forge, genenetwork or guix modules. + (match name + (((or 'forge 'genenetwork) _ ...) #t) + (name (guix-module-name? name)))) + + +;;; +;;; Development server configuration +;;; + +;; A development server is a server that is automatically redeployed +;; on every commit to its git repository. This is used by both the +;; genenetwork2 and the genenetwork3 development servers. Here, we +;; abstract out the details. + +(define-record-type* <development-server-configuration> + development-server-configuration make-development-server-configuration + development-server-configuration? + (name development-server-configuration-name) + (git-repository development-server-configuration-git-repository) + (git-branch development-server-configuration-git-branch) + (executable-path development-server-configuration-executable-path) + (runner development-server-configuration-runner) + (port development-server-configuration-port + (default 8080))) + +(define (development-server-redeploy config) + "Return a G-expression that provides a function redeploy which +redeploys the development server specified by CONFIG, a +<development-server-configuration> object." + (with-imported-modules (source-module-closure '((genenetwork development-helper) + (forge build git)) + #:select? import-module?) + (with-extensions (list guile-gcrypt guile-zlib) + (with-packages (list git-minimal nss-certs) + #~(begin + (use-modules (genenetwork development-helper) + (forge build git) + (guix derivations) + (guix gexp) + (guix monads) + (guix store) + (guix utils) + (rnrs exceptions)) + + (define (redeploy) + (parameterize ((%daemon-socket-uri #$%guix-daemon-uri)) + (switch-symlinks + #$(development-server-configuration-executable-path config) + (with-store store + (run-with-store store + (mlet* %store-monad ((latest-source + (latest-git-checkout + #$(string-append (development-server-configuration-name config) + "-checkout") + #$(development-server-configuration-git-repository config) + #:branch #$(development-server-configuration-git-branch config))) + (runner-drv + (gexp->script + #$(string-append (development-server-configuration-name config) + "-runner") + (#$(development-server-configuration-runner config) + latest-source) + #:guile (read-derivation-from-file + #$(raw-derivation-file + (with-store store + (package-derivation store guile-3.0))))))) + (mbegin %store-monad + (built-derivations (list runner-drv)) + (return (derivation->output-path runner-drv)))))))))))))) + +(define (development-server-activation config) + "Return a G-expression that runs the development server specified by +CONFIG, a <development-server-configuration> object, on startup." + (let ((executable-path (development-server-configuration-executable-path config))) + #~(begin + (use-modules (guix build utils)) + + (mkdir-p #$(dirname executable-path)) + (chown #$(dirname executable-path) + (passwd:uid (getpw "laminar")) + (passwd:gid (getpw "laminar"))) + #$(development-server-redeploy config) + (redeploy)))) + + +;;; +;;; genenetwork2 +;;; + +;; Path to genotype files required by genenetwork2 +(define %genotype-files + "/export/data/genenetwork/genotype_files") + +;; Port on which genenetwork3 is listening +(define %genenetwork3-port + 9093) + +(define (genenetwork2-tests project test-command) + "Return a G-expression that runs TEST-COMMAND with genenetwork2 +source code. PROJECT is a <forge-project> object describing +genenetwork2. TEST-COMMAND is a list of strings specifying the command +to be executed." + (with-imported-modules '((guix build utils)) + (with-packages (list bash coreutils git-minimal nss-certs) + #~(begin + (use-modules (guix build utils)) + + (define (hline) + "Print a horizontal line 50 '=' characters long." + (display (make-string 50 #\=)) + (newline) + (force-output)) + + (invoke "git" "clone" "--depth" "1" + "--branch" #$(forge-project-repository-branch project) + #$(forge-project-repository project) + ".") + (hline) + (invoke "git" "log" "--max-count" "1") + (hline) + (setenv "SERVER_PORT" "8080") + (setenv "GN2_PROFILE" + #$(profile + (content (package->development-manifest genenetwork2)) + (allow-collisions? #t))) + (setenv "GN_PROXY_URL" "http://genenetwork.org/gn3-proxy") + (setenv "GN3_LOCAL_URL" "http://localhost:9093") + (setenv "GENENETWORK_FILES" #$%genotype-files) + (setenv "HOME" "/tmp") + (setenv "SQL_URI" "mysql://webqtlout:webqtlout@localhost/db_webqtl") + (apply invoke '#$test-command))))) + +(define (genenetwork2-project config) + "Return a forge project describing genenetwork2. CONFIG is a +<development-server-configuration> object describing genenetwork2." + (forge-project + (name "genenetwork2") + (repository (development-server-configuration-git-repository config)) + (repository-branch (development-server-configuration-git-branch config)) + (ci-jobs (list (forge-laminar-job + (name "genenetwork2") + (run (genenetwork2-tests + this-forge-project + (list "sh" "bin/genenetwork2" "./etc/default_settings.py" + "-c" "-m" "unittest" "-v"))) + ;; If unit tests pass, redeploy genenetwork2. + (after #~(begin + (use-modules (guix build utils)) + #$(development-server-redeploy config) + (when (string=? (getenv "RESULT") "success") + (redeploy) + ;; We cannot refer to sudo in the + ;; store since that sudo does not have + ;; the setuid bit set. See "(guix) + ;; Setuid Programs". + (invoke "/run/setuid-programs/sudo" + #$(file-append shepherd "/bin/herd") + "restart" "genenetwork2") + (invoke #$(file-append laminar "/bin/laminarc") + "queue" "genenetwork2-mechanical-rob"))))) + (forge-laminar-job + (name "genenetwork2-mechanical-rob") + (run (genenetwork2-tests + this-forge-project + (list "sh" "bin/genenetwork2" "./etc/default_settings.py" + "-c" "../test/requests/test-website.py" + "--all" "http://localhost:9092"))) + (trigger? #f)))) + (ci-jobs-trigger 'webhook))) + +(define (genenetwork2-shepherd-service config) + "Return a shepherd service to run the genenetwork2 development +server. CONFIG is a <development-server-configuration> object +describing genenetwork2." + (shepherd-service + (documentation "Run GeneNetwork 2 development server.") + (provision '(genenetwork2)) + ;; FIXME: The genenetwork2 service should depend on redis. + (requirement '(networking genenetwork3)) + (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 #$(development-server-configuration-executable-path config) + "127.0.0.1" (number->string #$(development-server-configuration-port config))) + #:mappings (list (file-system-mapping + (source #$(development-server-configuration-executable-path config)) + (target source)) + (file-system-mapping + (source #$%genotype-files) + (target source)) + (file-system-mapping + (source "/run/mysqld/mysqld.sock") + (target source) + (writable? #t))) + #:log-file "/var/log/genenetwork2.log"))) + (stop #~(make-kill-destructor)))) + +(define %default-genenetwork2-configuration + (development-server-configuration + (name "genenetwork2") + (git-repository "https://github.com/genenetwork/genenetwork2") + (git-branch "testing") + (executable-path "/laminar/bin/genenetwork2") + (runner (with-imported-modules (source-module-closure '((genenetwork development-helper)) + #:select? import-module?) + #~(lambda (latest-gn2-source) + ((@@ (genenetwork development-helper) genenetwork2-runner-gexp) + latest-gn2-source + #$(profile + (content (package->development-manifest genenetwork2)) + (allow-collisions? #t)) + #$%genenetwork3-port + #$%genotype-files)))))) + +(define genenetwork2-service-type + (service-type + (name 'genenetwork2) + (description "Run GeneNetwork 2 development server and CI.") + (extensions + (list (service-extension activation-service-type + development-server-activation) + (service-extension shepherd-root-service-type + (compose list genenetwork2-shepherd-service)) + (service-extension forge-service-type + (compose list genenetwork2-project)))) + (default-value %default-genenetwork2-configuration))) + + +;;; +;;; genenetwork3 +;;; + +(define (genenetwork3-tests tests-command manifest) + "Return a G-expression running TESTS-COMMAND in a profile described +by MANIFEST with the latest git checkout of genenetwork3 as the +current directory. TESTS-COMMAND is a list of strings specifying the +command to be executed." + (with-imported-modules (source-module-closure '((genenetwork development-helper)) + #:select? import-module?) + #~(lambda (genenetwork3-checkout) + ((@@ (genenetwork development-helper) + command-in-source-gexp) + genenetwork3-checkout + #$(profile + (content manifest) + (allow-collisions? #t)) + '#$tests-command)))) + +(define genenetwork3-unit-tests + (genenetwork3-tests (list "python3" "-m" "unittest") + (package->development-manifest genenetwork3))) + +(define genenetwork3-pylint + (with-imported-modules (source-module-closure '((genenetwork development-helper)) + #:select? import-module?) + #~(lambda (genenetwork3-checkout) + ((@@ (genenetwork development-helper) + genenetwork3-lint-gexp) + genenetwork3-checkout + #$(profile + (content (manifest-cons* python-pylint shellcheck + (package->development-manifest genenetwork3))) + (allow-collisions? #t)))))) + +(define genenetwork3-mypy + (genenetwork3-tests (list "mypy" ".") + (manifest-cons python-mypy + (package->development-manifest genenetwork3)))) + +(define (genenetwork3-project config) + (forge-project + (name "genenetwork3") + (repository (development-server-configuration-git-repository config)) + (repository-branch (development-server-configuration-git-branch config)) + (ci-jobs (list (forge-laminar-job + (name "genenetwork3") + (run (derivation-job-gexp + this-forge-project + this-forge-laminar-job + genenetwork3-unit-tests + #:guix-daemon-uri %guix-daemon-uri)) + ;; If unit tests pass, redeploy genenetwork3. + (after #~(begin + (use-modules (guix build utils)) + #$(development-server-redeploy config) + (when (string=? (getenv "RESULT") "success") + (redeploy) + ;; We cannot refer to sudo in the + ;; store since that sudo does not have + ;; the setuid bit set. See "(guix) + ;; Setuid Programs". + (invoke "/run/setuid-programs/sudo" + #$(file-append shepherd "/bin/herd") + "restart" "genenetwork3"))))) + (forge-laminar-job + (name "genenetwork3-pylint") + (run (derivation-job-gexp + this-forge-project + this-forge-laminar-job + genenetwork3-pylint + #:guix-daemon-uri %guix-daemon-uri))) + (forge-laminar-job + (name "genenetwork3-mypy") + (run (derivation-job-gexp + this-forge-project + this-forge-laminar-job + genenetwork3-mypy + #:guix-daemon-uri %guix-daemon-uri))))) + (ci-jobs-trigger 'webhook))) + +(define (genenetwork3-shepherd-service config) + (shepherd-service + (documentation "Run GeneNetwork 3.") + (provision '(genenetwork3)) + (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 #$(development-server-configuration-executable-path config) + "127.0.0.1" #$(number->string (development-server-configuration-port config))) + #:mappings (list (file-system-mapping + (source #$(development-server-configuration-executable-path config)) + (target source))) + #:log-file "/var/log/genenetwork3.log"))) + (stop #~(make-kill-destructor)))) + +(define %default-genenetwork3-configuration + (development-server-configuration + (name "genenetwork3") + (git-repository "https://github.com/genenetwork/genenetwork3") + (git-branch "main") + (executable-path "/laminar/bin/genenetwork3") + (runner (with-imported-modules (source-module-closure '((genenetwork development-helper)) + #:select? import-module?) + #~(lambda (latest-gn3-source) + ((@@ (genenetwork development-helper) genenetwork3-runner-gexp) + latest-gn3-source + #$(profile + (content (manifest-cons gunicorn + (package->development-manifest genenetwork3))) + (allow-collisions? #t)))))))) + +(define genenetwork3-service-type + (service-type + (name 'genenetwork3) + (description "Run GeneNetwork 3.") + (extensions + (list (service-extension activation-service-type + development-server-activation) + (service-extension shepherd-root-service-type + (compose list genenetwork3-shepherd-service)) + (service-extension forge-service-type + (compose list genenetwork3-project)))) + (default-value %default-genenetwork3-configuration))) + + +;;; +;;; qc +;;; + +(define qc-tests + (with-imported-modules (cons '(guix build lisp-utils) + (source-module-closure '((genenetwork development-helper)) + #:select? import-module?)) + #~(lambda (source) + ((@@ (genenetwork development-helper) + asdf-test-gexp) + source + #$(profile + (content (package->development-manifest sbcl-qc)) + (allow-collisions? #t)) + "qc" (list "qc.asd"))))) + +(define qc-project + (forge-project + (name "qc") + (repository "https://git.genenetwork.org/jgart/qc") + (ci-jobs (list (forge-laminar-job + (name "qc") + (run (derivation-job-gexp + this-forge-project + this-forge-laminar-job + qc-tests + #:guix-daemon-uri %guix-daemon-uri))))) + (ci-jobs-trigger 'webhook))) + + +;;; +;;; dump-genenetwork-database +;;; + +;; Unreleased version of ccwl that is required by +;; dump-genenetwork-database for its graphql library. +(define ccwl + (let ((commit "02677a508b407779f5991a230341e016deb7f69b") + (revision "0")) + (package + (inherit guix:ccwl) + (name "ccwl") + (version (git-version (package-version guix:ccwl) revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/arunisaac/ccwl") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1kxry8y0pibl0x789jrzqkkh2s59ajyinfvrgvd00gkbqldih82r"))))))) + +;; guile-sparql tests are broken. Disable them temporarily. The issue +;; has been reported upstream at +;; https://github.com/roelj/guile-sparql/issues/6 +(define guile-sparql + (package + (inherit guix:guile-sparql) + (arguments + `(#:tests? #f)))) + +;; Temporarily package run64 here until it can be contributed to +;; upstream Guix. +(define run64 + (package + (name "run64") + (version "0.1.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://git.systemreboot.net/run64") + (commit "a271723e3938b158aa6748e8befceb114b84c6df"))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1kdx8h2x5a4cp8azzy1v2xgyb2153sakb1wbi2rj5ygkpmasygbm")))) + (build-system gnu-build-system) + (arguments + `(#:make-flags (list (string-append "prefix=" %output)) + #:phases + (modify-phases %standard-phases + (delete 'configure)))) + (home-page "https://run64.systemreboot.net") + (synopsis "SRFI-64 test runner for Scheme") + (description "run64 is a SRFI-64 test runner for Scheme.") + (license license:gpl3+))) + +(define dump-genenetwork-database-tests + (with-imported-modules (source-module-closure '((genenetwork development-helper)) + #:select? import-module?) + #~(lambda (source) + ((@@ (genenetwork development-helper) + command-in-source-gexp) + source + #$(profile + (content (packages->manifest + (list gnu-make guile-3.0 guile-dbi guile-dbd-mysql + ccwl graphviz guile-libyaml guile-sparql run64))) + (allow-collisions? #t)) + (list "make" "check"))))) + +(define dump-genenetwork-database-project + (forge-project + (name "dump-genenetwork-database") + (repository "https://git.genenetwork.org/arunisaac/dump-genenetwork-database") + (ci-jobs (list (forge-laminar-job + (name "dump-genenetwork-database") + (run (derivation-job-gexp + this-forge-project + this-forge-laminar-job + dump-genenetwork-database-tests + #:guix-daemon-uri %guix-daemon-uri))))) + (ci-jobs-trigger 'webhook))) + + +;;; +;;; gn-gemtext-threads +;;; + +(define (gn-gemtext-threads-website project job) + (with-imported-modules '((guix utils)) + #~(begin + (use-modules (guix utils)) + + (switch-symlinks #$(forge-project-website-directory project) + #$(derivation-job-gexp + project + job + (with-imported-modules (source-module-closure '((genenetwork development-helper)) + #:select? import-module?) + #~(lambda (source-checkout) + ((@@ (genenetwork development-helper) + tissue-website-gexp) + source-checkout + #$(profile + (content (packages->manifest (list tissue))) + (allow-collisions? #t))))) + #:guix-daemon-uri %guix-daemon-uri + #:deep-clone? #t))))) + +(define gn-gemtext-threads-project + (forge-project + (name "gn-gemtext-threads") + (repository "https://github.com/genenetwork/gn-gemtext-threads/") + (website-directory "/srv/http/issues") + (ci-jobs (list (forge-laminar-job + (name "gn-gemtext-threads") + (run (gn-gemtext-threads-website + this-forge-project + this-forge-laminar-job))))) + ;; TODO: Also rebuild every night to handle update of stale issues. + (ci-jobs-trigger 'webhook))) + + +;;; +;;; operating-system definition +;;; + +(operating-system + (host-name "genenetwork-development") + (timezone "UTC") + (locale "en_US.utf8") + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (targets (list "/dev/sdX")))) + (file-systems (cons (file-system + (device "root") + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (users %base-user-accounts) + (packages %base-packages) + (sudoers-file + (mixed-text-file "sudoers" + "@include " %sudoers-specification + ;; Permit the laminar user to restart genenetwork2 + ;; and genenetwork3. + "\nlaminar ALL = NOPASSWD: " + (file-append shepherd "/bin/herd") " restart genenetwork2, " + (file-append shepherd "/bin/herd") " restart genenetwork3\n")) + (services (cons* (service forge-service-type + (forge-configuration + (projects (list qc-project + dump-genenetwork-database-project + gn-gemtext-threads-project)))) + (service laminar-service-type + (laminar-configuration + (bind-http "localhost:9090"))) + (service webhook-service-type + (webhook-configuration + (port 9091))) + (service redis-service-type) + (service virtuoso-service-type + (virtuoso-configuration + (server-port 8891) + (http-server-port 8892))) + (service genenetwork2-service-type + (development-server-configuration + (inherit %default-genenetwork2-configuration) + (port 9092))) + (service genenetwork3-service-type + (development-server-configuration + (inherit %default-genenetwork3-configuration) + (port %genenetwork3-port))) + %base-services))) |