From e8ae17ca0eb9070e8c101661083c4d452f47b5fc Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Tue, 8 Feb 2022 13:29:03 +0530 Subject: forge: Support explicit specification of Guix daemon URI. * forge/forge.scm: Import (srfi srfi-26). Export forge-configuration-guix-daemon-uri. ()[guix-daemon-uri]: New field. (forge-project-configuration-laminar-jobs): Accept forge configuration as argument and pass on guix-daemon-uri to gexp-producer->job-script. (forge-activation, forge-service-type): Pass forge configuration to forge-project-configuration-laminar-jobs. (gexp-producer->job-script): Accept guix-daemon-uri as argument and parameterize store accesses with it. --- forge/forge.scm | 67 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 37 insertions(+), 30 deletions(-) (limited to 'forge/forge.scm') diff --git a/forge/forge.scm b/forge/forge.scm index 2c79777..c21ac48 100644 --- a/forge/forge.scm +++ b/forge/forge.scm @@ -20,6 +20,7 @@ (define-module (forge forge) #:use-module (gnu) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (gnu packages ci) #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) @@ -34,6 +35,7 @@ #:use-module (forge laminar) #:export (forge-service-type forge-configuration + forge-configuration-guix-daemon-uri forge-configuration-projects forge-project-configuration forge-project-configuration-user @@ -75,14 +77,17 @@ (define-record-type* forge-configuration make-forge-configuration forge-configuration? + (guix-daemon-uri forge-configuration-guix-daemon-uri + (default (%daemon-socket-uri))) (projects forge-configuration-projects (default '()))) -(define (forge-project-configuration-laminar-jobs project) +(define (forge-project-configuration-laminar-jobs project config) "Return CI jobs of PROJECT as a list of -objects. PROJECT is a object. If PROJECT -has jobs described by objects, transform them -to objects." +objects. PROJECT is a object that is +part of CONFIG, a object. If PROJECT has jobs +described by objects, transform them to + objects." (map (lambda (job) (if (forge-derivation-job? job) (forge-laminar-job @@ -94,7 +99,8 @@ to objects." #:git-checkout-name (string-append (forge-project-configuration-name project) "-checkout") #:derivation-name (string-append (forge-derivation-job-name job) - "-derivation"))) + "-derivation") + #:guix-daemon-uri (forge-configuration-guix-daemon-uri config))) (after (forge-derivation-job-after job))) job)) (forge-project-configuration-ci-jobs project))) @@ -122,7 +128,7 @@ to objects." (post-receive-hook (forge-project-configuration-name project) (map forge-laminar-job-name - (forge-project-configuration-laminar-jobs project))))) + (forge-project-configuration-laminar-jobs project config))))) (forge-configuration-projects config)))) #~(begin (use-modules (rnrs io ports) @@ -166,7 +172,7 @@ to objects." (name (guix-module-name? name)))) (define* (gexp-producer->job-script git-repository git-branch gexp-producer - #:key git-checkout-name derivation-name) + #:key git-checkout-name derivation-name guix-daemon-uri) "Return a G-expression describing a laminar job script. GEXP-PRODUCER is a G-expression that expands to a lambda function. The lambda function takes one argument---the latest git checkout of @@ -185,26 +191,27 @@ derivation to run." (guix store) (rnrs exceptions)) - (with-store store - (guard (condition ((store-protocol-error? condition) - (exit #f))) - (format (current-error-port) - "Built ~a successfully~%" - (run-with-store store - (mlet* %store-monad ((git-checkout (latest-git-checkout #$git-checkout-name - #$git-repository - #$git-branch - #:git-command #$(file-append git-minimal "/bin/git"))) - (tests-drv (gexp->derivation #$derivation-name - (#$gexp-producer git-checkout) - #:guile-for-build (read-derivation-from-file - #$(raw-derivation-file - (with-store store - (package-derivation store guile-3.0)))) - #:substitutable? #f))) - (mbegin %store-monad - (built-derivations (list tests-drv)) - (return (derivation->output-path tests-drv)))))))))))) + (parameterize ((%daemon-socket-uri #$guix-daemon-uri)) + (with-store store + (guard (condition ((store-protocol-error? condition) + (exit #f))) + (format (current-error-port) + "Built ~a successfully~%" + (run-with-store store + (mlet* %store-monad ((git-checkout (latest-git-checkout #$git-checkout-name + #$git-repository + #$git-branch + #:git-command #$(file-append git-minimal "/bin/git"))) + (tests-drv (gexp->derivation #$derivation-name + (#$gexp-producer git-checkout) + #:guile-for-build (read-derivation-from-file + #$(raw-derivation-file + (with-store store + (package-derivation store guile-3.0)))) + #:substitutable? #f))) + (mbegin %store-monad + (built-derivations (list tests-drv)) + (return (derivation->output-path tests-drv))))))))))))) (define forge-service-type (service-type @@ -216,11 +223,11 @@ derivation to run." (lambda (config) (append ;; jobs - (append-map forge-project-configuration-laminar-jobs + (append-map (cut forge-project-configuration-laminar-jobs <> config) (forge-configuration-projects config)) ;; groups (filter-map (lambda (project) - (match (forge-project-configuration-laminar-jobs project) + (match (forge-project-configuration-laminar-jobs project config) (() #f) ((job) #f) (jobs @@ -242,7 +249,7 @@ derivation to run." #$(post-receive-hook (forge-project-configuration-name project) (map forge-laminar-job-name - (forge-project-configuration-laminar-jobs project))) + (forge-project-configuration-laminar-jobs project config))) #:user "laminar"))) (forge-configuration-projects config)))))) (default-value (forge-configuration)))) -- cgit v1.2.3