diff options
Diffstat (limited to 'guix/forge/forge.scm')
| -rw-r--r-- | guix/forge/forge.scm | 106 |
1 files changed, 70 insertions, 36 deletions
diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm index 20d534c..49cc0d5 100644 --- a/guix/forge/forge.scm +++ b/guix/forge/forge.scm @@ -51,6 +51,7 @@ forge-configuration? forge-configuration-web-domain forge-configuration-tissue-web-domain + forge-configuration-websites-directory forge-configuration-web-root forge-configuration-projects forge-project @@ -61,8 +62,8 @@ forge-project-repository forge-project-repository-branch forge-project-web-domain - forge-project-website-directory forge-project-tissue? + forge-project-website-ci-job forge-project-ci-jobs forge-project-ci-jobs-trigger forge-project-parallel-ci-job-runs @@ -89,10 +90,12 @@ (default #f)) (web-domain forge-project-web-domain (default #f)) - (website-directory forge-project-website-directory - (default #f)) (tissue? forge-project-tissue? (default #f)) + (website-ci-job forge-project-website-ci-job + ;; TODO: Add default website builder. + (default #f) + (thunked)) (ci-jobs forge-project-ci-jobs (default '()) (thunked)) (ci-jobs-trigger forge-project-ci-jobs-trigger ; one of 'post-receive-hook, 'cron, 'webhook @@ -113,6 +116,8 @@ (web-domain forge-configuration-web-domain) (tissue-web-domain forge-configuration-tissue-web-domain (default #f)) + (websites-directory forge-configuration-websites-directory + (default "/srv/http/forge")) (web-root forge-configuration-web-root (default (computed-file "forge-web-root" (forge-web-root-gexp this-forge-configuration))) @@ -185,12 +190,11 @@ (list (forge-project-user project) (forge-project-repository project) (forge-project-description project) - (forge-project-website-directory project) (program-file (string-append (forge-project-name project) "-post-receive-hook") (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) + (forge-project-all-ci-jobs project config) #:reason "post-receive hook")) (forge-project-ci-jobs-trigger project))) (forge-configuration-projects config)))) @@ -205,8 +209,14 @@ '(regular directory))) #:directories? #t)) + ;; Set ownership of forge websites directory. + (let ((user (getpw "laminar"))) + (chown #$(forge-configuration-websites-directory config) + (passwd:uid user) + (passwd:gid user))) + (for-each (match-lambda - ((username repository description website-directory ci-jobs-trigger ci-jobs-trigger-type) + ((username repository description ci-jobs-trigger ci-jobs-trigger-type) ;; For local repositories only (when (string-prefix? "/" repository) ;; Set description. @@ -228,12 +238,7 @@ (let ((hook-link (string-append repository "/hooks/post-receive"))) (when (file-exists? hook-link) (delete-file hook-link)) - (symlink ci-jobs-trigger hook-link))) - ;; Set ownership of website directory. - (when website-directory - (let ((user (getpw "laminar"))) - (chown (dirname website-directory) - (passwd:uid user) (passwd:gid user)))))) + (symlink ci-jobs-trigger hook-link))))) '#$projects)))) (define (import-module? name) @@ -485,36 +490,51 @@ that were built." (package-channels pkg)))))))) inferior)))))))) +(define (switch-symlinks-gexp link target) + "Return a G-expression that links @var{link} to @var{target}. @var{target} is a +singleton list of targets as returned by @code{guix-channel-job-gexp}." + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (switch-symlinks #$link + (match #$target + ((target) target)))))) + (define (forge-nginx-server-blocks config) "Return list of @code{<nginx-server-configuration>} extensions for forge configuration @var{config}." (cons (nginx-server-configuration (server-name (list (forge-configuration-web-domain config))) (root (forge-configuration-web-root config)) + ;; Serve HTML files without extension. + (try-files (list "$uri" "$uri.html" "$uri/index.html" "=404")) (locations - ;; Configure location blocks for projects that have a website - ;; directory but no web domain. + ;; Configure location blocks for projects that have no web domain. (filter-map (lambda (project) (match-record project <forge-project> - (name web-domain website-directory) + (name web-domain) (and (not web-domain) - website-directory (nginx-location-configuration (uri (string-append "/" name "/")) (body - (list (string-append "alias " - (file-name-as-directory website-directory) + (list (string-append "root " + (forge-configuration-websites-directory config) ";"))))))) (forge-configuration-projects config)))) - ;; Configure nginx server blocks for projects that have a web domain and - ;; a website directory. + ;; Configure nginx server blocks for projects that have a web domain. (filter-map (match-record-lambda <forge-project> - (web-domain website-directory) + (name web-domain) (and web-domain - website-directory (nginx-server-configuration (server-name (list web-domain)) - (root website-directory)))) + (root (string-append (forge-configuration-websites-directory config) + "/" + name)) + ;; Serve HTML files without extension. + (try-files (list "$uri" "$uri.html" + "$uri/index.html" "=404"))))) (forge-configuration-projects config)))) (define (forge-tissue-hosts config) @@ -540,17 +560,31 @@ forge configuration @var{config}." projects)))) (list)))) +(define (forge-project-all-ci-jobs project config) + "Return list of all CI jobs for @var{project} in forge configuration +@var{config}." + ;; Add project context to CI jobs. + (map (lambda (job) + (forge-laminar-job + (inherit job) + (contexts (cons (forge-project-name project) + (forge-laminar-job-contexts job))))) + ;; Prepend website CI job to the other CI jobs. + (if (forge-project-website-ci-job project) + (cons (forge-laminar-job + (inherit (forge-project-website-ci-job project)) + (run (switch-symlinks-gexp + (string-append (forge-configuration-websites-directory config) + "/" + (forge-project-name project)) + (forge-laminar-job-run (forge-project-website-ci-job project))))) + (forge-project-ci-jobs project)) + (forge-project-ci-jobs project)))) + (define (forge-ci-jobs config) "Return list of CI jobs for forge configuration @var{config}. Each value of the returned list is a @code{<forge-laminar-job>} object." - (append-map (lambda (project) - ;; Add project context to CI jobs. - (map (lambda (job) - (forge-laminar-job - (inherit job) - (contexts (cons (forge-project-name project) - (forge-laminar-job-contexts job))))) - (forge-project-ci-jobs project))) + (append-map (cut forge-project-all-ci-jobs <> config) (forge-configuration-projects config))) (define (forge-ci-job-contexts config) @@ -568,7 +602,7 @@ value of the returned list is a @code{<forge-laminar-job>} object." @var{config}. Each element of the returned list is a @code{<forge-laminar-group>} object." (filter-map (lambda (project) - (match (forge-project-ci-jobs project) + (match (forge-project-all-ci-jobs project config) (() #f) ((job) #f) (jobs @@ -597,13 +631,13 @@ mcron job specification." (and (eq? (forge-project-ci-jobs-trigger project) 'cron) (any forge-laminar-job-trigger? - (forge-project-ci-jobs project)) + (forge-project-all-ci-jobs project config)) #~(job '(next-day) #$(program-file (string-append (forge-project-name project) "-cron-job") (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) + (forge-project-all-ci-jobs project config) #:reason "Cron job")) #:user "laminar"))) (forge-configuration-projects config))) @@ -615,11 +649,11 @@ value is a list of @code{<webhook-hook>} objects." (and (eq? (forge-project-ci-jobs-trigger project) 'webhook) (any forge-laminar-job-trigger? - (forge-project-ci-jobs project)) + (forge-project-all-ci-jobs project config)) (webhook-hook (id (forge-project-name project)) (run (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) + (forge-project-all-ci-jobs project config) #:reason "Webhook"))))) (forge-configuration-projects config))) |