;;; genenetwork-machines --- Guix configuration for genenetwork machines
;;; Copyright © 2022–2024 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022–2024 Frederick Muriuki Muriithi <fredmanglis@gmail.com>
;;; Copyright © 2024 Munyoki Kilyungi <me@bonfacemunyoki.com>
;;; Copyright © 2024 John Nduli <rookie101@jnduli.co.ke>
;;;
;;; 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-machines services monitoring)
((gn-machines genenetwork) #:select (genenetwork2 genenetwork3 gn-auth))
(gn services databases)
((gn packages guile) #:select (gn-guile))
(gnu build linux-container)
((gnu packages admin) #:select (shepherd shadow))
((gnu packages base) #:select (gnu-make tar coreutils-minimal))
((gnu packages bash) #:select (bash))
((gnu packages nss) #:select (nss-certs))
((gnu packages check) #:select (python-pylint))
((gnu packages curl) #:select (curl))
((gnu packages ci) #:select (laminar))
((gnu packages compression) #:select (gzip))
((gnu packages databases) #:select (mariadb redis))
((gnu packages databases) #:select (virtuoso-ose))
((gnu packages gnupg) #:select (guile-gcrypt))
((gnu packages graphviz) #:select (graphviz))
((gnu packages guile) #:select (guile-3.0 guile-git guile-zlib))
((gnu packages guile-xyz) #:select (guile-dbd-mysql guile-dbi guile-dsv guile-hashing
guile-ini guile-lib guile-libyaml guile-smc guile-xapian))
((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 rdf) #:select (raptor2))
((gnu packages tls) #:select (openssl))
((gnu packages version-control) #:select (git-minimal))
((gnu packages version-control) #:select (libgit2-1.3) #:prefix guix:)
((gnu packages web) #:select (tissue) #:prefix guix:)
(gnu services ci)
(gnu services databases)
(gnu services mcron)
(gnu services shepherd)
((gnu services web) #:select (nginx-server-configuration
nginx-location-configuration))
(gnu system file-systems)
(guix build-system gnu)
(guix channels)
(guix ci)
(guix git-download)
(guix least-authority)
((guix licenses) #:prefix license:)
(guix modules)
(guix packages)
(guix profiles)
(guix records)
(guix search-paths)
(guix store)
(guix utils)
(forge acme)
(forge cgit)
(forge forge)
(forge laminar)
(forge nginx)
(forge socket)
(forge tissue)
(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")
;; We cannot refer to sudo in the store since that sudo does not have
;; the setuid bit set. See "(guix) Setuid Programs".
(define sudo
"/run/setuid-programs/sudo")
(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))))
(define-record-type* <genenetwork-configuration>
genenetwork-configuration make-genenetwork-configuration
genenetwork-configuration?
(gn2-repository genenetwork-configuration-gn2-repository
(default "https://github.com/genenetwork/genenetwork2"))
(gn3-repository genenetwork-configuration-gn3-repository
(default "https://github.com/genenetwork/genenetwork3"))
(gn-auth-repository genenetwork-configuration-gn-auth-repository
(default "https://git.genenetwork.org/gn-auth"))
(gn-libs-repository genenetwork-configuration-gn-libs-repository
(default "https://git.genenetwork.org/gn-libs"))
(gn-guile-repository genenetwork-configuration-gn-libs-repository
(default "https://git.genenetwork.org/gn-guile"))
(gn2-port genenetwork-configuration-gn2-port
(default 8082))
(gn3-port genenetwork-configuration-gn3-port
(default 8083))
(gn-auth-port genenetwork-configuration-gn-auth-port
(default 8084))
(gn2-secrets genenetwork-configuration-gn2-secrets
(default "/etc/genenetwork"))
(gn3-secrets genenetwork-configuration-gn3-secrets
(default "/etc/genenetwork/gn3-secrets.py"))
(gn-auth-secrets genenetwork-configuration-gn-auth-secrets
(default "/etc/genenetwork"))
(genotype-files genenetwork-configuration-genotype-files
(default "/var/genenetwork/genotype-files"))
(sparql-endpoint genenetwork-configuration-sparql-endpoint
(default "http://localhost:8081/sparql"))
(data-directory genenetwork-data-directory
(default "/var/genenetwork"))
(xapian-db-path genenetwork-xapian-db-path
(default "/var/genenetwork/xapian"))
(auth-db-path genenetwork-auth-db-path
(default "/export/data/genenetwork-sqlite/auth.db"))
(llm-db-path genenetwork-llm-db-path
(default "/export/data/genenetwork-sqlite/llm.db"))
(lmdb-data-path genenetwork-lmdb-data-path
(default "/export/data/lmdb"))
(gn-guile-port genenetwork-configuration-gn-guile-port
(default 8091))
(repositories genenetwork-configuration-repositories
(default "/export/data/repositories"))
(gn-doc-git-checkout genenetwork-configuration-gn-doc-git-checkout
(default "/export/data/gn-docs")))
;;;
;;; guix-bioinformatics
;;;
(define guix-bioinformatics-project
(forge-project
(name "guix-bioinformatics")
(repository "/home/git/public/guix-bioinformatics")
(description "Bioinformatics packages for GNU Guix")
(ci-jobs (let ((channels (list (channel
(name 'gn-bioinformatics)
(url "https://git.genenetwork.org/guix-bioinformatics")
(branch "master")))))
(list (forge-laminar-job
(name "guix-bioinformatics")
(run (guix-channel-job-gexp channels
#:variables '()
#:guix-daemon-uri %guix-daemon-uri)))
(forge-laminar-job
(name "guix-bioinformatics-all-packages")
(run (guix-channel-job-gexp channels
#:verbose? #false
#:guix-daemon-uri %guix-daemon-uri))))))))
;;;
;;; genenetwork
;;;
(define (genenetwork2-tests config test-command)
"Return a G-expression that runs TEST-COMMAND for genenetwork2
described by CONFIG, a <genenetwork-configuration>
object. TEST-COMMAND is a list of strings specifying the command to be
executed."
(match-record config <genenetwork-configuration>
(gn2-repository gn3-repository gn-libs-repository gn3-port genotype-files)
(with-imported-modules '((guix build utils))
(with-packages (list bash coreutils git-minimal nss-certs genenetwork2)
#~(begin
(use-modules (guix build utils)
(srfi srfi-26))
(define (hline)
"Print a horizontal line 50 '=' characters long."
(display (make-string 50 #\=))
(newline)
(force-output))
(define (show-head-commit)
(hline)
(invoke "git" "log" "--max-count" "1")
(hline))
(define (call-with-temporary-directory proc)
(let ((tmp-dir (mkdtemp "/tmp/gn.XXXXXX")))
(dynamic-wind
(const #t)
(cut proc tmp-dir)
(cut delete-file-recursively tmp-dir))))
(invoke "git" "clone" "--depth" "1" #$gn3-repository)
(with-directory-excursion "genenetwork3"
(show-head-commit))
(invoke "git" "clone" "--depth" "1" #$gn-libs-repository)
(with-directory-excursion "gn-libs"
(show-head-commit))
(invoke "git" "clone" "--depth" "1" #$gn2-repository)
(with-directory-excursion "genenetwork2"
(show-head-commit))
;; Use a profile with all dependencies except
;; genenetwork3.
(setenv "GN2_PROFILE"
#$(profile
(content (package->development-manifest genenetwork2))
(allow-collisions? #t)))
;; Set GN3_PYTHONPATH to the latest genenetwork3.
(setenv "GN3_PYTHONPATH"
(string-append (getcwd) "/genenetwork3"))
(setenv "GN_PROXY_URL" "http://genenetwork.org/gn3-proxy/")
(setenv "GN3_LOCAL_URL" (string-append "http://localhost:" (number->string #$gn3-port)))
(setenv "GENENETWORK_FILES" #$genotype-files)
(setenv "HOME" "/tmp")
;; This file is cosmetic
(setenv
"GN2_SETTINGS"
#$(mixed-text-file "gn2.conf"
"GN2_SECRETS=\"/tmp/secret.py\"\n"
"AI_SEARCH_ENABLED=True\n"
"TEST_FEATURE_SWITCH=True\n"
"GN3_LOCAL_URL=\"http://localhost:120\"\n"
"GN3_GUILE_SERVER_URL=\"http://localhost:120\"\n"
"GN_SERVER_URL=\"https://cd.genenetwork.org/api3/\"\n"
"AUTH_SERVER_URL=\"https://auth-cd.genenetwork.org/\"\n"
"SQL_URI=\"mysql://webqtlout:webqtlout@localhost/db_webqtl?unix_socket=/run/mysqld/mysqld.sock\"\n"
"SSL_PRIVATE_KEY=\"/tmp/ssl-private.pem\"\n"
"AUTH_SERVER_SSL_PUBLIC_KEY=\"/tmp/gn-auth-ssl-public-key.pem\"\n"))
(setenv "SQL_URI" "mysql://webqtlout:webqtlout@localhost/db_webqtl?unix_socket=/run/mysqld/mysqld.sock&charset=utf8")
(setenv "PATH" (string-append (getenv "GN2_PROFILE") "/bin:$PATH"))
(setenv "R_LIBS_SITE" (string-append (getenv "GN2_PROFILE") "/site-library"))
(setenv "JS_GUIX_PATH" (string-append (getenv "GN2_PROFILE") "/share/genenetwork2/javascript"))
(setenv "GUIX_GENENETWORK_FILES" (string-append (getenv "GN2_PROFILE") "/share/genenetwork2"))
(setenv "GENENETWORK_FILES" "/export/data/genenetwork/genotype_files")
(setenv "PLINK_COMMAND" (string-append (getenv "GN2_PROFILE") "/bin/plink2"))
(setenv "GEMMA_COMMAND" (string-append (getenv "GN2_PROFILE") "/bin/gemma"))
(setenv "GEMMA_WRAPPER_COMMAND" (string-append (getenv "GN2_PROFILE") "/bin/gemma-wrapper"))
(setenv "HOME" "/tmp")
(chdir "genenetwork2")
;; XXXX: FIXME: R/Qtl tests fail because files are generated in
;; the "/tmp" directory. Currently, "/tmp" is mapped by gn2/gn3
;; so tests will fail because of permission issues.
(call-with-temporary-directory
(lambda (tmp-dir)
(setenv "TMPDIR" tmp-dir)
(apply invoke '#$test-command))))))))
(define %xapian-directory
"/export/data/genenetwork-xapian")
(define (build-xapian-index-gexp project)
"Return a G-expression that builds and installs a Xapian index using
genenetwork3 source from the latest commit of @var{project}."
(with-imported-modules '((guix build utils))
(with-manifest (manifest-cons* git-minimal nss-certs
(package->development-manifest genenetwork3))
#~(begin
(use-modules (guix build utils)
(srfi srfi-26))
(invoke "git" "clone" "--depth" "1"
#$(forge-project-repository project)
".")
(let ((xapian-directory #$%xapian-directory)
(xapian-build-directory (string-append #$%xapian-directory
"/build")))
(dynamic-wind
(const #t)
(lambda ()
;; Build xapian index.
(setenv "PYTHONPATH" (getcwd))
(invoke "./scripts/index-genenetwork" "create-xapian-index"
xapian-build-directory
"mysql://webqtlout:webqtlout@localhost/db_webqtl?unix_socket=/run/mysqld/mysqld.sock&charset=utf8"
"http://localhost:9082/sparql")
;; Stop genenetwork3, replace old xapian index and
;; start genenetwork3.
(dynamic-wind
(cut invoke #$sudo #$(file-append shepherd "/bin/herd") "stop" "genenetwork3")
(lambda ()
(for-each (lambda (file)
(rename-file file (string-append xapian-directory "/" (basename file))))
(find-files xapian-build-directory)))
(cut invoke #$sudo #$(file-append shepherd "/bin/herd") "start" "genenetwork3")))
(cut delete-file-recursively xapian-build-directory)))))))
;; G-expression that is configured in cron to trigger a rebuild of the
;; xapian index
(define build-xapian-index-cron-gexp
(with-imported-modules '((guix build utils))
(with-manifest
(manifest-cons* git-minimal nss-certs
(package->development-manifest genenetwork3))
#~(begin
(use-modules (guix build utils)
(srfi srfi-26))
(define (call-with-temporary-directory proc)
(let ((tmp-dir (mkdtemp "/tmp/xapian-index-cron.XXXXXX")))
(dynamic-wind
(const #t)
(cut proc tmp-dir)
(cut delete-file-recursively tmp-dir))))
(call-with-temporary-directory
(lambda (gn3-dir)
(invoke "git" "clone" "--depth" "1"
"https://github.com/genenetwork/genenetwork3.git"
gn3-dir)
(setenv "PYTHONPATH" gn3-dir)
;; Only trigger a laminar build when the data is modified.
(when
(and
(not (file-exists? (string-append #$%xapian-directory "/build")))
(zero? (status:exit-val
(system* (string-append gn3-dir "/scripts/index-genenetwork")
"is-data-modified"
#$%xapian-directory
"mysql://webqtlout:webqtlout@localhost/db_webqtl?unix_socket=/run/mysqld/mysqld.sock"
"http://localhost:9082/sparql"))))
(setenv "LAMINAR_REASON" "Nightly xapian index rebuild")
(invoke #$(file-append laminar "/bin/laminarc")
"queue" "genenetwork3-build-xapian-index"))))))))
(define (genenetwork-projects config)
"Return forge projects for genenetwork described by CONFIG, a
<genenetwork-configuration> object."
(match-record config <genenetwork-configuration>
(gn2-repository gn3-repository gn-auth-repository gn-libs-repository gn2-port gn-guile-port gn-guile-repository)
(list (forge-project
(name "genenetwork2")
(repository gn2-repository)
(ci-jobs (list (forge-laminar-job
(name "genenetwork2")
(run (genenetwork2-tests config (list "python3" "-m" "pytest")))
;; If unit tests pass, redeploy genenetwork2 and
;; trigger Mechanical Rob.
(after (with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(when (string=? (getenv "RESULT") "success")
(invoke #$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
config
(list "python3" "test/requests/test-website.py"
"--all" (string-append "http://localhost:" (number->string gn2-port)))))
(trigger? #f))))
(ci-jobs-trigger 'webhook))
(forge-project
(name "genenetwork3")
(repository gn3-repository)
(ci-jobs (list (forge-laminar-job
(name "genenetwork3")
(run (guix-channel-job-gexp
(list (channel
(name 'genenetwork3)
(url (forge-project-repository this-forge-project))
(branch "main")))
#:variables (list (variable-specification
(module '(genenetwork3-package))
(name 'genenetwork3)))
#:guix-daemon-uri %guix-daemon-uri))
;; If tests run successfully, redeploy
;; genenetwork3 and trigger genenetwork2 tests.
(after (with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(when (string=? (getenv "RESULT") "success")
(invoke #$sudo
#$(file-append shepherd "/bin/herd")
"restart" "genenetwork3")
(invoke #$(file-append laminar "/bin/laminarc")
"queue" "genenetwork2"))))))
(forge-laminar-job
(name "genenetwork3-all-tests")
(run (guix-channel-job-gexp
(list (channel
(name 'genenetwork3)
(url (forge-project-repository this-forge-project))
(branch "main")))
#:variables (list (variable-specification
(module '(genenetwork3-package))
(name 'genenetwork3-all-tests)))
#:guix-daemon-uri %guix-daemon-uri)))
(forge-laminar-job
(name "genenetwork3-build-xapian-index")
(run (build-xapian-index-gexp this-forge-project))
(trigger? #f))))
(ci-jobs-trigger 'webhook))
(forge-project
(name "gn-libs")
(repository gn-libs-repository)
(ci-jobs (list (forge-laminar-job
(name "gn-libs")
(run (guix-channel-job-gexp
(list (channel
(name 'gn-libs)
(url (forge-project-repository this-forge-project))
(branch "main")))
#:variables (list (variable-specification
(module '(gn-libs))
(name 'gn-libs)))
#:guix-daemon-uri %guix-daemon-uri)))))
(ci-jobs-trigger 'webhook))
(forge-project
(name "gn-guile")
(repository gn-guile-repository)
(ci-jobs (list (forge-laminar-job
(name "gn-guile")
(run (with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(invoke #$sudo
#$(file-append shepherd "/bin/herd")
"restart" "gn-guile")))))))
(ci-jobs-trigger 'webhook))
(forge-project
(name "gn-auth")
(repository gn-auth-repository)
(ci-jobs (list (forge-laminar-job
(name "gn-auth")
(run (guix-channel-job-gexp
(list (channel
(name 'gn-auth)
(url (forge-project-repository this-forge-project))
(branch "main")))
#:variables (list (variable-specification
(module '(gn-auth))
(name 'gn-auth)))
#:guix-daemon-uri %guix-daemon-uri))
;; If unit tests pass, restart the auth server.
(after (with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(when (string=? (getenv "RESULT") "success")
(invoke #$sudo
#$(file-append shepherd "/bin/herd")
"restart" "gn-auth")
(invoke #$(file-append laminar "/bin/laminarc")
"queue" "genenetwork2"))))))
(forge-laminar-job
(name "gn-auth-all-tests")
(run (guix-channel-job-gexp
(list (channel
(name 'gn-auth)
(url (forge-project-repository this-forge-project))
(branch "main")))
#:variables (list (variable-specification
(module '(gn-auth))
(name 'gn-auth-all-tests)))
#:guix-daemon-uri %guix-daemon-uri)))))
(ci-jobs-trigger 'webhook)))))
(define (genenetwork2-cd-gexp config)
"Return a G-expression that runs the latest genenetwork2 development
server described by CONFIG, a <genenetwork-configuration> object."
(match-record config <genenetwork-configuration>
(gn2-repository gn3-repository gn2-port gn3-port gn2-secrets genotype-files gn-guile-port)
(with-packages (list coreutils git-minimal gunicorn nss-certs)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
(define (hline)
"Print a horizontal line 50 '=' characters long."
(display (make-string 50 #\=))
(newline)
(force-output))
(define (show-head-commit)
(hline)
(invoke "git" "log" "--max-count" "1")
(hline))
(setenv "GIT_PAGER" #$(file-append coreutils-minimal "/bin/cat"))
(setenv "TERM" "xterm-256color")
;; Clone the latest genenetwork2
;; repositories.
(with-directory-excursion
"/home/genenetwork"
(when (file-exists? "/home/genenetwork/genenetwork2")
(delete-file-recursively "/home/genenetwork/genenetwork2"))
(invoke "git" "clone" "--depth" "1" #$gn2-repository))
;; Override the genenetwork3 used by genenetwork2.
(setenv "GN3_PYTHONPATH" "/home/genenetwork/genenetwork3")
;; Set other environment variables required by
;; genenetwork2.
(setenv "GN2_PROFILE" #$(profile
(content (package->development-manifest genenetwork2))
(allow-collisions? #t)))
(setenv "REQUESTS_CA_BUNDLE" (string-append
(getenv "GN2_PROFILE")
"/etc/ssl/certs/ca-certificates.crt"))
(setenv "PYTHONPATH" (string-append
(getenv "GN3_PYTHONPATH")
":"
(string-append
(getenv "GN2_PROFILE")
"/lib/python3.11/site-packages")))
(setenv "PATH" (string-append (getenv "GN2_PROFILE") "/bin:$PATH"))
(setenv "R_LIBS_SITE" (string-append (getenv "GN2_PROFILE") "/site-library"))
(setenv "JS_GUIX_PATH" (string-append (getenv "GN2_PROFILE") "/share/genenetwork2/javascript"))
(setenv "GUIX_GENENETWORK_FILES" (string-append (getenv "GN2_PROFILE") "/share/genenetwork2"))
(setenv "GENENETWORK_FILES" #$genotype-files)
(setenv "PLINK_COMMAND" (string-append (getenv "GN2_PROFILE") "/bin/plink2"))
(setenv "GEMMA_COMMAND" (string-append (getenv "GN2_PROFILE") "/bin/gemma"))
(setenv "GEMMA_WRAPPER_COMMAND" (string-append (getenv "GN2_PROFILE") "/bin/gemma-wrapper"))
(setenv "HOME" "/home/genenetwork")
(setenv
"GN2_SETTINGS"
#$(mixed-text-file "gn2.conf"
"GN2_SECRETS=\"" gn2-secrets "/gn2-secrets.py\"\n"
"AI_SEARCH_ENABLED=True\n"
"TEST_FEATURE_SWITCH=True\n"
"GN3_LOCAL_URL=\""
(string-append "http://localhost:"
(number->string gn3-port))
"\"\n"
"GN_GUILE_SERVER_URL=\""
(string-append "http://localhost:"
(number->string gn-guile-port))
"\"\n"
"GN_SERVER_URL=\"https://cd.genenetwork.org/api3/\"\n"
"AUTH_SERVER_URL=\"https://auth-cd.genenetwork.org/\"\n"
"SQL_URI=\"mysql://webqtlout:webqtlout@localhost/db_webqtl?unix_socket=/run/mysqld/mysqld.sock\"\n"
"SSL_PRIVATE_KEY=\"" gn2-secrets "/gn2-ssl-private-key.pem\"\n"
"AUTH_SERVER_SSL_PUBLIC_KEY=\"" gn2-secrets "/gn-auth-ssl-public-key.pem\"\n"))
;; Start genenetwork2.
(with-directory-excursion
"/home/genenetwork/genenetwork2"
(show-head-commit)
(invoke #$(file-append gunicorn "/bin/gunicorn")
"--bind" (string-append "0.0.0.0:" (number->string #$gn2-port))
"--workers" "20"
"--keep-alive" "6000"
"--max-requests" "100"
"--max-requests-jitter" "30"
"--timeout" "1200"
"gn2.wsgi")))))))
(define (genenetwork3-cd-gexp config)
"Return a G-expression that runs the latest genenetwork3 development
server described by CONFIG, a <genenetwork-configuration> object."
(match-record config <genenetwork-configuration>
(gn3-repository gn3-port gn3-secrets sparql-endpoint data-directory xapian-db-path auth-db-path llm-db-path lmdb-data-path)
(with-manifest (package->development-manifest genenetwork3)
(with-packages (list git-minimal nss-certs)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
(define (hline)
"Print a horizontal line 50 '=' characters long."
(display (make-string 50 #\=))
(newline)
(force-output))
(define (show-head-commit)
(hline)
(invoke "git" "log" "--max-count" "1")
(hline))
(setenv "GIT_PAGER" #$(file-append coreutils-minimal "/bin/cat"))
(setenv "GN3_PROFILE" #$(profile
(content (package->development-manifest genenetwork3))
(allow-collisions? #t)))
(setenv "REQUESTS_CA_BUNDLE" (string-append
(getenv "GN3_PROFILE")
"/etc/ssl/certs/ca-certificates.crt"))
;; Configure genenetwork3.
(setenv "GN3_CONF"
#$(mixed-text-file "gn3.conf"
"SPARQL_ENDPOINT=\"" sparql-endpoint "\"\n"
"DATA_DIR=\"" data-directory "\"\n"
"LMDB_DATA_PATH=\"" lmdb-data-path "\"\n"
"AUTH_SERVER_URL=\"https://auth-cd.genenetwork.org/\"\n"
"XAPIAN_DB_PATH=\"" xapian-db-path "\"\n"
"AUTH_DB=\"" auth-db-path "\"\n"
"LLM_DB_PATH=\"" llm-db-path "\"\n"))
(setenv "HOME" "/tmp")
(setenv "GN3_SECRETS" #$gn3-secrets)
(setenv "RSCRIPT" (string-append
(getenv "GN3_PROFILE")
"/bin/Rscript"))
(with-directory-excursion
"/home/genenetwork"
;; Clone the latest genenetwork3 repository.
(when (file-exists? "/home/genenetwork/genenetwork3")
(delete-file-recursively "/home/genenetwork/genenetwork3"))
(invoke "git" "clone" "--depth" "1" #$gn3-repository))
(with-directory-excursion
"/home/genenetwork/genenetwork3"
(show-head-commit)
;; Run genenetwork3.
(invoke #$(file-append gunicorn "/bin/gunicorn")
"-b" #$(string-append "localhost:" (number->string gn3-port))
"--workers" "8"
"gn3.app:create_app()"
;; gunicorn's default 30 second timeout is
;; insufficient for Fahamu AI endpoints and
;; results in worker timeout errors.
"--timeout" "1200"))))))))
(define (gn-auth-cd-gexp config)
"Return a G-expression that runs the latest gn-auth development
server described by CONFIG, a <genenetwork-configuration> object."
(match-record config <genenetwork-configuration>
(gn-auth-repository gn-auth-port auth-db-path gn-auth-secrets)
(with-manifest (package->development-manifest gn-auth)
(with-packages (list git-minimal nss-certs)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
(define (hline)
"Print a horizontal line 50 '=' characters long."
(display (make-string 50 #\=))
(newline)
(force-output))
(define (show-head-commit)
(hline)
(invoke "git" "log" "--max-count" "1")
(hline))
(setenv "GIT_PAGER" #$(file-append coreutils-minimal "/bin/cat"))
(with-directory-excursion
"/home/genenetwork/"
;; Clone the latest gn-auth repository.
(when (file-exists? "/home/genenetwork/gn-auth")
(delete-file-recursively "/home/genenetwork/gn-auth"))
(invoke "git" "clone" "--depth" "1" #$gn-auth-repository))
;; Configure gn-auth.
(setenv "GN_AUTH_PROFILE" #$(profile
(content (package->development-manifest gn-auth))
(allow-collisions? #t)))
(setenv "REQUESTS_CA_BUNDLE" (string-append
(getenv "GN_AUTH_PROFILE")
"/etc/ssl/certs/ca-certificates.crt"))
(setenv "GN_AUTH_CONF"
#$(mixed-text-file "gn-auth.conf"
"AUTH_DB=\"" auth-db-path "\"\n"
"GN_AUTH_SECRETS=\"" gn-auth-secrets "/gn-auth-secrets.py\"\n"
"CLIENTS_SSL_PUBLIC_KEYS_DIR=\"" gn-auth-secrets "/clients-public-keys\"\n"
"SSL_PRIVATE_KEY=\"" gn-auth-secrets "/gn-auth-ssl-private-key.pem\"\n"))
(setenv "HOME" "/tmp")
(setenv "AUTHLIB_INSECURE_TRANSPORT" "true")
;; Run gn-auth.
(with-directory-excursion "/home/genenetwork/gn-auth"
(show-head-commit)
(invoke #$(file-append gunicorn "/bin/gunicorn")
"-b" #$(string-append "localhost:" (number->string gn-auth-port))
"--workers" "8"
"gn_auth.wsgi:app"))))))))
(define (gn-guile-gexp gn-guile-port)
(with-packages
(list coreutils git-minimal nss-certs)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(define (hline)
"Print a horizontal line 50 '=' characters long."
(display (make-string 50 #\=))
(newline)
(force-output))
(define (show-head-commit)
(hline)
(invoke "git" "log" "--max-count" "1")
(hline))
;; KLUDGE: Here we set all the certificates properly. In gn-guile,
;; we make request to external services. Here's an example:
;; curl http://localhost:8091/gene/aliases/Shh
;;
;; Without certs, we run into:
;; 2025-07-22 08:27:11 GET /gene/aliases/Shh
;; [...]
;; 2025-07-22 08:27:19 signer-not-found invalid
(setenv "GN_GUILE_PROFILE" #$(profile
(content (package->development-manifest gn-guile))
(allow-collisions? #t)))
(setenv "SSL_CERT_DIR" (string-append
(getenv "GN_GUILE_PROFILE")
"/etc/ssl/certs"))
(setenv "SSL_CERT_FILE" (string-append
(getenv "GN_GUILE_PROFILE")
"/etc/ssl/certs/ca-certificates.crt"))
(setenv "GIT_SSL_CAINFO" (getenv "SSL_CERT_FILE"))
(setenv "CURL_CA_BUNDLE" (getenv "SSL_CERT_FILE"))
(setenv "REQUESTS_CA_BUNDLE" (getenv "SSL_CERT_FILE"))
(setenv "SPARQL-ENDPOINT" "http://localhost:9082/sparql/")
(setenv "GIT_PAGER" #$(file-append coreutils-minimal "/bin/cat"))
(let ((current-repo-path "/home/genenetwork/gn-docs"))
(setenv "CURRENT_REPO_PATH" current-repo-path)
(with-directory-excursion
"/home/genenetwork"
;; All edits go to the current-repo-path; so we need it to
;; be persistent.
(unless (file-exists? current-repo-path)
(invoke #$(file-append git-minimal "/bin/git")
"clone" "--depth" "1" (getenv "CGIT_REPO_PATH") current-repo-path))
(when (file-exists? "gn-guile")
(delete-file-recursively "gn-guile"))
(invoke "git" "clone" "--depth" "1" "https://git.genenetwork.org/gn-guile")
;; We have a gn-guile-dev wrapper script that sets a "./" in the
;; GN_GUILE_LOAD_PATH hence allowing this to be run from the gn-guile
;; directory. This allows gn-guile to be run from the latest
;; upstream commits without pinning to guix.
(with-directory-excursion "gn-guile"
(show-head-commit)
(invoke #$(file-append gn-guile "/bin/gn-guile-dev")
(number->string #$gn-guile-port)))))))))
(define (genenetwork-shepherd-services config)
"Return shepherd services to run the genenetwork development server
described by CONFIG, a <genenetwork-configuration> object."
(match-record config <genenetwork-configuration>
(gn2-port gn3-port gn-auth-port genotype-files data-directory xapian-db-path gn2-secrets auth-db-path gn-auth-secrets llm-db-path lmdb-data-path gn-doc-git-checkout gn-guile-port)
(list (shepherd-service
(documentation "Run gn-guile server.")
(provision '(gn-guile))
(requirement '(networking))
(modules '((ice-9 match)
(srfi srfi-1)))
(start
(let* ((gn-guile-settings
`(("CGIT_REPO_PATH" ,gn-doc-git-checkout)
("LC_ALL" "en_US.UTF-8")
("GIT_COMMITTER_NAME" "genenetwork")
("GIT_COMMITTER_EMAIL" "no-reply@git.genenetwork.org"))))
#~(make-forkexec-constructor
(list #$(least-authority-wrapper
(program-file "gn-guile"
(gn-guile-gexp gn-guile-port))
#:name "gn-guile-pola-wrapper"
#:preserved-environment-variables
(map first gn-guile-settings)
#:mappings (list (file-system-mapping
(source gn-doc-git-checkout)
(target source)
(writable? #t))
(file-system-mapping
(source "/home/genenetwork")
(target source)
(writable? #t)))
#:namespaces (delq 'net %namespaces))
"127.0.0.1" #$(number->string gn-guile-port))
#:user "genenetwork"
#:group "genenetwork"
#:environment-variables
(map (match-lambda
((spec value)
(string-append spec "=" value)))
'#$gn-guile-settings)
#:log-file "/var/log/cd/gn-guile.log")))
(stop #~(make-kill-destructor)))
(shepherd-service
(documentation "Run GeneNetwork 2 development server.")
(provision '(genenetwork2))
(requirement '(networking redis))
(modules '((guix search-paths)
(ice-9 match)
(srfi srfi-1)))
;; KLUDGE: The default value of 0.5 is too low, and causes
;; gn2 to be disabled when it is respawned "too fast."
(respawn-delay 5)
(start
(let* ((gn2-manifest (packages->manifest (list genenetwork2)))
(gn2-profile (profile
(content gn2-manifest)
(allow-collisions? #t)))
(gn2-settings
`(("SERVER_PORT" ,(number->string gn2-port))
("GENENETWORK_FILES" ,genotype-files)
("HOME" "/tmp")
("LC_ALL" "en_US.UTF-8")
("NO_REDIS" "no-redis")
("RUST_BACKTRACE" "1"))))
(with-imported-modules (source-module-closure '((guix search-paths)))
#~(make-forkexec-constructor
(list #$(least-authority-wrapper
(program-file "genenetwork2"
(genenetwork2-cd-gexp config))
#:name "genenetwork2-pola-wrapper"
#:preserved-environment-variables
(append '("REQUESTS_CA_BUNDLE")
(map first gn2-settings)
(map search-path-specification-variable
(manifest-search-paths gn2-manifest)))
;; If we mapped only the mysqld.sock
;; socket file, it would break when the
;; external mysqld server is restarted.
#:mappings (list (file-system-mapping
(source genotype-files)
(target source))
(file-system-mapping
(source "/home/genenetwork")
(target source)
(writable? #t))
(file-system-mapping
(source "/run/mysqld")
(target source)
(writable? #t))
;; XXXX: FIXME: R/Qtl generates
;; files in "/tmp" and
;; "/tmp/gn2". These files are
;; accessed by gn3 for R/Qtl
;; mapping
(file-system-mapping
(source "/tmp")
(target source)
(writable? #t))
(file-system-mapping
(source gn2-secrets)
(target source)
(writable? #t)))
#:namespaces (delq 'net %namespaces))
"127.0.0.1" #$(number->string gn2-port))
#:user "genenetwork"
#:group "genenetwork"
#:environment-variables
(append
'("REQUESTS_CA_BUNDLE="
#$(file-append gn2-profile "/etc/ssl/certs/ca-certificates.crt"))
(map (match-lambda
((spec . value)
(string-append (search-path-specification-variable spec)
"="
value)))
(evaluate-search-paths
(map sexp->search-path-specification
'#$(map search-path-specification->sexp
(manifest-search-paths gn2-manifest)))
(list #$gn2-profile)))
(map (match-lambda
((spec value)
(string-append spec "=" value)))
'#$gn2-settings))
#:log-file "/var/log/cd/genenetwork2.log"))))
(stop #~(make-kill-destructor)))
(shepherd-service
(documentation "Run GeneNetwork 3 development server.")
(provision '(genenetwork3))
(requirement '(networking))
;; KLUDGE: The default value of 0.5 is too low, and causes
;; gn3 to be disabled when it is respawned "too fast."
(respawn-delay 5)
(start #~(make-forkexec-constructor
(list #$(least-authority-wrapper
(program-file "genenetwork3"
(genenetwork3-cd-gexp config))
#:name "genenetwork3-pola-wrapper"
;; If we mapped only the mysqld.sock
;; socket file, it would break when the
;; external mysqld server is restarted.
#:mappings (list (file-system-mapping
(source "/run/mysqld")
(target source)
(writable? #t))
(file-system-mapping
(source "/home/genenetwork")
(target source)
(writable? #t))
(file-system-mapping
(source lmdb-data-path)
(target source)
(writable? #t))
;; XXXX: FIXME: R/Qtl generates
;; files in "/tmp" and
;; "/tmp/gn2". These files are
;; accessed by gn3 for R/Qtl
;; mapping
(file-system-mapping
(source "/tmp")
(target source)
(writable? #t))
(file-system-mapping
(source data-directory)
(target source))
(file-system-mapping
(source xapian-db-path)
(target source))
(file-system-mapping
(source "/etc/genenetwork/conf/gn3")
(target source)
(writable? #t))
(file-system-mapping
(source (dirname auth-db-path))
(target source)
(writable? #t))
(file-system-mapping
(source (dirname llm-db-path))
(target source)
(writable? #t)))
#:namespaces (delq 'net %namespaces))
"127.0.0.1" #$(number->string gn3-port))
#:user "genenetwork"
#:group "genenetwork"
#:log-file "/var/log/cd/genenetwork3.log"))
(stop #~(make-kill-destructor)))
(shepherd-service
(documentation "Run gn-auth development server.")
(provision '(gn-auth))
(requirement '(networking))
;; KLUDGE: The default value of 0.5 is too low, and causes
;; gn-auth to be disabled when it is respawned "too fast."
(respawn-delay 5)
(start #~(make-forkexec-constructor
(list #$(least-authority-wrapper
(program-file "gn-auth"
(gn-auth-cd-gexp config))
#:name "gn-auth-pola-wrapper"
;; If we mapped only the mysqld.sock
;; socket file, it would break when the
;; external mysqld server is restarted.
#:mappings (list (file-system-mapping
(source "/run/mysqld")
(target source)
(writable? #t))
(file-system-mapping
(source "/home/genenetwork")
(target source)
(writable? #t))
(file-system-mapping
(source data-directory)
(target source))
(file-system-mapping
(source (dirname auth-db-path))
(target source)
(writable? #t))
(file-system-mapping
(source gn-auth-secrets)
(target source)
(writable? #t)))
#:namespaces (delq 'net %namespaces))
"127.0.0.1" #$(number->string gn-auth-port))
#:user "genenetwork"
#:group "genenetwork"
#:log-file "/var/log/cd/gn-auth.log"))
(stop #~(make-kill-destructor))))))
(define %genenetwork-accounts
(list (user-group
(name "genenetwork")
(system? #t))
(user-account
(name "genenetwork")
(group "genenetwork")
(system? #t)
(comment "GeneNetwork user")
(home-directory "/home/genenetwork")
(shell (file-append shadow "/sbin/nologin")))))
(define (genenetwork-activation config)
(match-record config <genenetwork-configuration>
(gn2-secrets gn3-secrets auth-db-path gn-auth-secrets gn-doc-git-checkout)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 ftw))
;; KLUDGE: Guix now stores inferior profiles under
;; /var/guix/profiles/per-user (commit
;; d12c4452a49b355369636de1dfc766b5bad6437b). The 'laminar'
;; user’s directory is not created automatically in our
;; pinned Guix revision, which causes CI jobs using
;; inferiors to fail with permission errors.
;; XXXX: FIXME: Explicitly create the directory for
;; now. Remove this once we update the pinned Guix commit.
(unless (file-exists? "/var/guix/profiles/per-user/laminar")
(mkdir-p "/var/guix/profiles/per-user/laminar")
(chown "/var/guix/profiles/per-user/laminar"
(passwd:uid (getpw "laminar"))
(passwd:gid (getpw "laminar"))))
;; Set ownership of files.
(for-each (lambda (file)
(chown file
(passwd:uid (getpw "genenetwork"))
(passwd:gid (getpw "genenetwork"))))
(cons* #$gn3-secrets
(append (find-files #$gn2-secrets
#:directories? #t)
(find-files gn-doc-git-checkout
#:directories? #t)
(find-files #$(dirname auth-db-path)
#:directories? #t)
(find-files #$gn-auth-secrets
#:directories? #t))))
;; Prevent other users from reading secret files.
(for-each (lambda (file)
(chmod file #o600))
(append (list #$gn3-secrets)
(find-files #$gn2-secrets
#:directories? #f)
(find-files #$gn-auth-secrets
#:directories? #f)))))))
(define genenetwork-service-type
(service-type
(name 'genenetwork)
(description "Run GeneNetwork development servers and CI.")
(extensions
(list (service-extension account-service-type
(const %genenetwork-accounts))
(service-extension activation-service-type
genenetwork-activation)
(service-extension shepherd-root-service-type
genenetwork-shepherd-services)
(service-extension forge-service-type
genenetwork-projects)))
(default-value (genenetwork-configuration))))
;;;
;;; transform-genenetwork-database
;;;
;; 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+)))
;; Connection settings for Virtuoso and MySQL used to load data into Virtuoso
(define %connection-settings
"/etc/genenetwork/conf/gn-transform-database/conn.scm")
;; Path to where the data directory from which virtuoso loads all the files
(define %virtuoso-data-dir "/var/lib/data")
(define (transform-genenetwork-database-gexp connection-settings virtuoso-data-dir repository)
(with-imported-modules '((guix build utils))
(with-packages (list git-minimal gnu-make guile-3.0 guile-dbd-mysql
guile-dbi guile-hashing guile-libyaml guile-sparql
guile-zlib nss-certs virtuoso-ose raptor2)
#~(begin
(use-modules (guix build utils)
(srfi srfi-26)
(ice-9 threads))
(setenv "LC_ALL" "en_US.UTF-8")
(let ((build-directory (string-append #$virtuoso-data-dir
"/build")))
;; Only run this job if the build directory does not
;; exists. This ensures that no other process is
;; running this.
(unless (file-exists? build-directory)
(invoke "git" "clone" "--depth" "1" #$repository ".")
(invoke "make" "-j" (number->string (current-processor-count)))
(invoke "./generate-ttl-files.scm" "--settings"
#$connection-settings "--output" build-directory)
;; First clear all the files in our virtuoso directory
(for-each (lambda (file)
(unless (string-suffix? "build" (dirname file))
(delete-file file)))
(find-files #$virtuoso-data-dir ".ttl"))
;; Move data into the container's virtuoso data directory
(copy-recursively build-directory #$virtuoso-data-dir)
;; Load RDF into virtuoso.
(invoke "./pre-inst-env" "./load-rdf.scm" #$connection-settings)
(delete-file-recursively build-directory)))))))
(define transform-genenetwork-database-project
(forge-project
(name "transform-genenetwork-database")
(repository "/home/git/public/gn-transform-databases")
(ci-jobs (list (forge-laminar-job
(name "transform-genenetwork-database-tests")
(run (guix-channel-job-gexp
(list (channel
(name 'transform-genenetwork-database)
(url (forge-project-repository this-forge-project))
(branch "master"))
%default-guix-channel)
#:guix-daemon-uri %guix-daemon-uri)))
(forge-laminar-job
(name "transform-genenetwork-database")
(run (transform-genenetwork-database-gexp
%connection-settings
%virtuoso-data-dir
"https://git.genenetwork.org/gn-transform-databases")))))))
;;;
;;; gn-gemtext-threads
;;;
(define gn-gemtext-threads-project
(forge-project
(name "gn-gemtext-threads")
(repository "https://github.com/genenetwork/gn-gemtext-threads/")
(ci-jobs (list (forge-laminar-job
(name "gn-gemtext-threads")
(run (with-packages (list nss-certs openssl)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(setenv "LC_ALL" "en_US.UTF-8")
(invoke #$(file-append tissue "/bin/tissue")
"pull" "issues.genenetwork.org"))))))))
(ci-jobs-trigger 'webhook)))
;;;
;;; guile-lmdb
;;;
(define guile-lmdb-project
(forge-project
(name "guile-lmdb")
(repository "https://github.com/aartaka/guile-lmdb")
(ci-jobs (list (forge-laminar-job
(name "guile-lmdb")
(run (guix-channel-job-gexp
(list (channel
(name 'guile-lmdb)
(url (forge-project-repository this-forge-project))
(branch "master"))
%default-guix-channel)
#:guix-daemon-uri %guix-daemon-uri)))))
(ci-jobs-trigger 'webhook)))
;;;
;;; guile-gsl
;;;
(define guile-gsl-project
(forge-project
(name "guile-gsl")
(repository "https://github.com/aartaka/guile-gsl")
(ci-jobs (list (forge-laminar-job
(name "guile-gsl")
(run (guix-channel-job-gexp
(list (channel
(name 'guile-gsl)
(url (forge-project-repository this-forge-project))
(branch "master"))
%default-guix-channel)
#:guix-daemon-uri %guix-daemon-uri)))))
(ci-jobs-trigger 'webhook)))
;;;
;;; guile-lapack
;;;
(define guile-lapack-project
(forge-project
(name "guile-lapack")
(repository "https://github.com/aartaka/guile-lapack")
(ci-jobs (list (forge-laminar-job
(name "guile-lapack")
(run (guix-channel-job-gexp
(list (channel
(name 'guile-lapack)
(url (forge-project-repository this-forge-project))
(branch "master"))
%default-guix-channel)
#:guix-daemon-uri %guix-daemon-uri)))))
(ci-jobs-trigger 'webhook)))
;;;
;;; operating-system definition
;;;
(define (laminar-template-gexp issue-tracker-uri)
"Return a G-expression that creates a custom Laminar template with a
menu link to channels.scm and the issue tracker at ISSUE-TRACKER-URI."
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(copy-file (string-append #$(package-source laminar) "/src/resources/index.html")
#$output)
(substitute* #$output
(("<router-link to=\"jobs\">Jobs</router-link>" jobs-link)
(string-append
"<a href=\"https://cd.genenetwork.org\" target=\"_blank\">CD</a>"
jobs-link
"<a href=\"" #$issue-tracker-uri "\" target=\"_blank\">Issues</a>"
"<a href=\"/channels.scm\" target=\"_blank\">channels.scm</a>"))))))
(define (install-laminar-template-gexp template)
"Return a G-expression that installs custom laminar TEMPLATE."
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(mkdir-p "/var/lib/laminar/custom")
(switch-symlinks "/var/lib/laminar/custom/index.html" #$template))))
(define %ci-domain
"ci.genenetwork.org")
(define (cd-error-pages-gexp)
"Return a G-expression that builds a directory with error pages for
the GeneNetwork continuous deployment."
(with-imported-modules '((guix build utils))
(with-extensions (list guile-lib)
#~(begin
(use-modules (guix build utils)
(htmlprag))
(define (ci-badge job)
`(div (a (@ (href ,(string-append "https://" #$%ci-domain "/jobs/" job)))
(img (@ (src ,(string-append "https://" #$%ci-domain "/badge/" job ".svg")))))))
(define (page-sxml jobs)
`(html
(head
(title "GeneNetwork CD down!"))
(body
(h1 "GeneNetwork CD is down!")
(p "Is the CI red?")
,@(map ci-badge jobs))))
(mkdir-p (string-append #$output "/error"))
(call-with-output-file (string-append #$output "/error/502.html")
(lambda (port)
(display "<!DOCTYPE html>" port)
(newline port)
(display
(sxml->html
;; Construct a 502 page pulling out CI job names using a
;; dummy default genenetwork configuration.
(page-sxml '#$(append-map (lambda (project)
(map forge-laminar-job-name
(forge-project-ci-jobs project)))
(genenetwork-projects
(genenetwork-configuration)))))
port)
(newline port)))))))
(define (channels-scm-gexp published-channel-names)
"Return a G-expression that builds a directory with a channels.scm
file to be served by the laminar reverse
proxy. PUBLISHED-CHANNEL-NAMES is a list of names of channels which
should be included in the channels.scm file."
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (ice-9 pretty-print)
(guix build utils))
(mkdir-p #$output)
(call-with-output-file (string-append #$output "/channels.scm")
(lambda (port)
(pretty-print
'#$`(list ,@(filter-map (lambda (channel)
(and (memq (channel-name channel)
published-channel-names)
(channel->code channel)))
(profile-channels
;; Infer profile from guix
;; executable used.
(match (program-arguments)
((program . _)
(dirname (dirname program)))))))
port))))))
(define (development-server-reverse-proxy-server-block gn2-port gn3-port)
"Return an <nginx-server-configuration> object to reverse proxy the
GeneNetwork development server. GN2-PORT and GN3-PORT are the ports
GeneNetwork2 and GeneNetwork3 are listening on."
(nginx-server-configuration
(server-name '("cd.genenetwork.org"))
(locations
(list (nginx-location-configuration
;; Reverse proxy genenetwork2.
(uri "/")
(body (list (string-append "proxy_pass http://localhost:"
(number->string gn2-port) ";")
"proxy_set_header Host $host;"
"proxy_set_header X-Forwarded-Proto $scheme;")))
(nginx-location-configuration
;; Reverse proxy genenetwork3.
(uri "/api3")
(body (list "rewrite /api3/(.*) /api/$1 break;"
(string-append "proxy_pass http://localhost:"
(number->string gn3-port) ";")
"proxy_set_header Host $host;")))
(nginx-location-configuration
(uri " /error/")
(body (list #~(string-append
"root "
#$(computed-file "genenetwork-cd-error-pages"
(cd-error-pages-gexp))
";"))))))
(raw-content (list "error_page 502 /error/502.html;"))))
(define (laminar-reverse-proxy-server-block laminar-bind-http webhook-port published-channel-names)
"Return an <nginx-server-configuration> object to reverse proxy
laminar. The nginx server will reverse proxy to laminar listening on
LAMINAR-BIND-HTTP. WEBHOOK-PORT is the port the webhook server is
listening on. PUBLISHED-CHANNEL-NAMES is a list of channel names for
which a channels.scm should be published."
(nginx-server-configuration
(server-name (list %ci-domain))
(locations
(list (nginx-location-configuration
(uri "/")
(body (list (string-append "proxy_pass http://" laminar-bind-http ";")
;; Disable proxy buffering in host's nginx. We
;; need this to allow Laminar's Server-Sent
;; Events to pass through.
"proxy_pass_header X-Accel-Buffering;")))
;; Reverse proxy webhook server.
(nginx-location-configuration
(uri "/hooks/")
(body (list (string-append "proxy_pass http://localhost:"
(number->string webhook-port) ";")
"proxy_set_header Host $host;")))
;; Publish the channels.scm used to build this container.
(nginx-location-configuration
(uri "= /channels.scm")
(body (list #~(string-append
"root "
#$(computed-file "channels.scm"
(channels-scm-gexp published-channel-names))
";"))))))))
;; Port on which tissue is listening
(define %tissue-port 9083)
(define (tissue-reverse-proxy-server-block)
"Return an <nginx-server-configuration> object to reverse proxy
tissue."
(nginx-server-configuration
(server-name '("issues.genenetwork.org"))
(root "/var/lib/tissue/issues.genenetwork.org/website")
(try-files (list "$uri" "$uri.html" "@tissue-search"))
(locations
(list (nginx-location-configuration
(uri "@tissue-search")
(body (list (string-append "proxy_pass http://localhost:" (number->string %tissue-port) ";")
"proxy_set_header Host $host;")))))))
(define (gn-auth-reverse-proxy-server-block)
"Return an <nginx-server-configuration> object to reverse proxy
gn-auth."
(nginx-server-configuration
(server-name '("auth-cd.genenetwork.org"))
(locations
(list (nginx-location-configuration
(uri "/")
(body (list (string-append "proxy_pass http://localhost:"
(number->string %gn-auth-port)
";")
"proxy_set_header Host $host;")))))))
(define (gn-guile-reverse-proxy-server-block)
"Return an <nginx-server-configuration> object to reverse proxy
gn-guile to display RDF pages."
(nginx-server-configuration
(server-name '("rdf.genenetwork.org"))
(locations
(list (nginx-location-configuration
(uri "/")
(body (list (string-append "proxy_pass http://localhost:"
(number->string %gn-guile-port)
";")
"proxy_set_header Host $host;")))))))
(define set-build-directory-permissions-gexp
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(for-each (lambda (file)
(chown file
(passwd:uid (getpw "laminar"))
(passwd:gid (getpw "laminar"))))
(append (find-files #$%xapian-directory
#:directories? #t)
(find-files #$%virtuoso-data-dir
#:directories? #t))))))
;; Port on which webhook is listening
(define %webhook-port 9091)
;; Port on which genenetwork2 is listening
(define %genenetwork2-port 9092)
;; Port on which genenetwork3 is listening
(define %genenetwork3-port 9093)
;; Port on which gn-auth is listening
(define %gn-auth-port 9094)
;; Port on which virtuoso's SPARQL endpoint is listening
(define %virtuoso-sparql-port 9082)
;; Port on which gn-guile is listening
(define %gn-guile-port 8091)
(operating-system
(host-name "genenetwork-development")
(timezone "UTC")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
(targets (list "/dev/sdX"))))
(file-systems %base-file-systems)
(users %base-user-accounts)
(packages (cons* curl coreutils-minimal %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 gn-guile, "
(file-append shepherd "/bin/herd") " restart genenetwork2, "
(file-append shepherd "/bin/herd") " start genenetwork3, "
(file-append shepherd "/bin/herd") " stop genenetwork3, "
(file-append shepherd "/bin/herd") " restart genenetwork3,"
(file-append shepherd "/bin/herd") " start gn-auth, "
(file-append shepherd "/bin/herd") " stop gn-auth, "
(file-append shepherd "/bin/herd") " restart gn-auth\n"
;; Permit the acme user to restart nginx.
"\nacme ALL = NOPASSWD: " (file-append shepherd "/bin/herd") " restart nginx\n"))
(services (cons* (service forge-service-type
(forge-configuration
(projects (list transform-genenetwork-database-project
gn-gemtext-threads-project
guile-gsl-project
guile-lapack-project
guile-lmdb-project
guix-bioinformatics-project))))
(service cgit-service-type
(cgit-configuration
(server-name "git.genenetwork.org")
(repository-directory "/home/git/public")))
(service laminar-service-type
(laminar-configuration
(title "GeneNetwork CI")
(bind-http "localhost:9089")))
(service mcron-service-type
(mcron-configuration
(jobs (list #~(job '(next-hour)
#$(program-file "build-xapian-index-cron"
build-xapian-index-cron-gexp)
#:user "laminar")
;; Run cron once a week at midnight on Sunday morning
;; Verify using: https://crontab.guru/#0_0_*_*_0
#~(job "0 0 * * 0"
#$(program-file "update-virtuoso"
(transform-genenetwork-database-gexp
%connection-settings
%virtuoso-data-dir
"https://git.genenetwork.org/gn-transform-databases"))
#:user "laminar")))))
(simple-service 'install-laminar-template
activation-service-type
(install-laminar-template-gexp
(computed-file
"laminar-template.html"
(laminar-template-gexp "https://issues.genenetwork.org"))))
(service webhook-service-type
(webhook-configuration
(socket (forge-ip-socket
(ip "127.0.0.1")
(port %webhook-port)))))
(service redis-service-type)
(service virtuoso-service-type
(virtuoso-configuration
(number-of-buffers 4000000)
(maximum-dirty-buffers 3000000)
(server-port 9081)
(dirs-allowed (list "/var/lib/data"))
(http-server-port %virtuoso-sparql-port)))
(service genenetwork-service-type
(genenetwork-configuration
(gn2-port %genenetwork2-port)
(gn3-port %genenetwork3-port)
(gn-auth-port %gn-auth-port)
(gn2-secrets "/etc/genenetwork/conf/gn2")
(gn3-secrets "/etc/genenetwork/conf/gn3/secrets.py")
(gn-auth-secrets "/etc/genenetwork/conf/gn-auth")
(genotype-files "/export/data/genenetwork/genotype_files")
(sparql-endpoint (string-append "http://localhost:"
(number->string %virtuoso-sparql-port)
"/sparql"))
(data-directory "/export/data/genenetwork")
(xapian-db-path %xapian-directory)))
(simple-service 'set-build-directory-permissions
activation-service-type
set-build-directory-permissions-gexp)
(service tissue-service-type
(tissue-configuration
(socket
(forge-ip-socket
(port %tissue-port)))
(hosts
(list (tissue-host
(name "issues.genenetwork.org")
(projects (list (tissue-project
(name "issues.genenetwork.org")
(user "laminar")
(base-path "/")
(upstream-repository
"https://github.com/genenetwork/gn-gemtext-threads")))))))))
(service forge-nginx-service-type
(forge-nginx-configuration
(http-listen (forge-ip-socket
(ip "0.0.0.0")
(port 9080)))
(https-listen (forge-ip-socket
(ip "0.0.0.0")
(port 9090)))
(server-blocks
(list (development-server-reverse-proxy-server-block
%genenetwork2-port %genenetwork3-port)
(laminar-reverse-proxy-server-block
"localhost:9089" %webhook-port
(list 'gn-bioinformatics
'guix-bioinformatics))
(tissue-reverse-proxy-server-block)
(gn-auth-reverse-proxy-server-block)
(gn-guile-reverse-proxy-server-block)))))
(service guile-sheepdog-service-type
(guile-sheepdog-configuration
(settings-file "/etc/genenetwork/conf/sheepdog.scm")))
(service acme-service-type
(acme-configuration
(email "arunisaac@systemreboot.net")))
%base-services)))
