Make copirate a proper package

3 files changed, 189 insertions, 62 deletions

diff --git a/copirate/modules/copirate-site.scm b/copirate/modules/copirate-site.scm
deleted file mode 100644
index 61083ba..0000000
--- a/copirate/modules/copirate-site.scm
+++ /dev/null
@@ -1,62 +0,0 @@
-(define-module (copirate modules copirate-site)
-  #:use-module (guix gexp)
-  #:use-module (guix modules)
-  #:use-module (gnu packages audio)
-  #:use-module (gnu packages music)
-  #:use-module (gnu packages imagemagick)
-  #:export
-  (
-   build-copirate-site
-   ))
-
-(define (build-copirate-site source)
-  (computed-file
-   "copirate-site"
-   (with-imported-modules
-    (source-module-closure '((guix build utils)))
-    #~(begin
-        (use-modules (guix build utils) (ice-9 ftw))
-        (mkdir-p #$output)
-        (copy-recursively #$source #$output)
-        (with-directory-excursion
-         #$output
-         (let ((enter? (lambda (name stat result) #t))
-               (leaf (lambda (name stat result)
-                       (when (string-suffix? ".ly" name)
-                         (invoke #$(file-append lilypond "/bin/lilypond") name))))
-               (down (lambda (name stat result) #t))
-               (up (lambda (name stat result) #t))
-               (skip (lambda (name stat result) #t))
-               (error (lambda (name stat errno result) #t)))
-           (file-system-fold enter? leaf down up skip error #t "."))
-         (let ((enter? (lambda (name stat result) #t))
-               (leaf (lambda (name stat result)
-                       (when (string-suffix? ".pdf" name)
-                       (format (current-error-port) "PDF file: ~s…\n" name)
-                         (let ((miniature-name
-                                (string-append
-                                 (substring name 0 (- (string-length name) (string-length ".pdf")))
-                                 "-miniature.png")))
-                           (invoke #$(file-append imagemagick "/bin/convert")
-                                   "-resize" "210x297" "+append"
-                                   (string-append name "[0-4]")
-                                   miniature-name)))))
-               (down (lambda (name stat result) #t))
-               (up (lambda (name stat result) #t))
-               (skip (lambda (name stat result) #t))
-               (error (lambda (name stat errno result) #t)))
-           (file-system-fold enter? leaf down up skip error #t "."))
-       (let ((enter? (lambda (name stat result) #t))
-             (leaf (lambda (name stat result)
-                     (format (current-error-port) "Potentially midi file: ~s…\n" name)
-                     (when (string-prefix? "./" name)
-                       (set! name (substring name (string-length "./"))))
-                     (when (string-suffix? ".midi" name)
-                       (format (current-error-port) "Midi file: ~s…\n" name)
-                       (invoke #$(file-append timidity++ "/bin/timidity")
-                               "-Ov" name))))
-             (down (lambda (name stat result) #t))
-             (up (lambda (name stat result) #t))
-             (skip (lambda (name stat result) #t))
-             (error (lambda (name stat errno result) #t)))
-         (file-system-fold enter? leaf down up skip error #t ".")))))))
diff --git a/guix/vkraus/packages/copirate-site.scm b/guix/vkraus/packages/copirate-site.scm
new file mode 100644
index 0000000..5be4da9
--- /dev/null
+++ b/guix/vkraus/packages/copirate-site.scm
@@ -0,0 +1,115 @@
+(define-module (vkraus packages copirate-site)
+  #:use-module ((guix packages)
+		#:select (package origin base32))
+  #:use-module ((guix git-download)
+		#:select (git-fetch
+			  git-file-name
+			  git-reference))
+  #:use-module ((guix build-system gnu)
+		#:select (gnu-build-system))
+  #:use-module ((guix gexp)
+		#:select (gexp))
+  #:use-module ((gnu packages music)
+		#:select (lilypond))
+  #:use-module ((gnu packages imagemagick)
+		#:select (imagemagick))
+  #:use-module ((gnu packages audio)
+		#:select (timidity++))
+  #:export (copirate-site)
+  #:declarative? #t)
+
+(define copirate-site
+  (package
+   (name "copirate-site")
+   (version "2023")
+   (source
+    (origin
+     (method git-fetch)
+     (uri
+      (git-reference
+       (url "https://labo.planete-kraus.eu/copirate-site.git")
+       (commit
+	"87eb4ed037ff72bc278721f3c6dfd7750fc4b61b")))
+     (file-name
+      (git-file-name name version))
+     (sha256
+      (base32 "0l0j9slqbz68iparqyy5jchwd8rc23di30dkzc94lq4s3859xypv"))))
+   (build-system gnu-build-system)
+   (arguments
+    (list
+     #:phases
+     #~(modify-phases
+	%standard-phases
+	(delete 'configure)
+	(delete 'build)
+	(delete 'check)
+	(replace
+	 'install
+	 (lambda* (#:key native-inputs inputs #:allow-other-keys)
+	   (use-modules (ice-9 ftw))
+	   (let ((lilypond
+		  (search-input-file (or native-inputs inputs)
+				     "/bin/lilypond"))
+		 (convert
+		  (search-input-file (or native-inputs inputs)
+				     "/bin/convert"))
+		 (timidity
+		  (search-input-file (or native-inputs inputs)
+				     "/bin/timidity")))
+	   (mkdir-p #$output)
+	   (copy-recursively "." #$output)
+           (with-directory-excursion
+            #$output
+            (let ((enter? (lambda (name stat result) #t))
+		  (leaf (lambda (name stat result)
+			  (when (string-suffix? ".ly" name)
+                            (invoke lilypond name))))
+		  (down (lambda (name stat result) #t))
+		  (up (lambda (name stat result) #t))
+		  (skip (lambda (name stat result) #t))
+		  (error (lambda (name stat errno result) #t)))
+              (file-system-fold enter? leaf down up skip error #t "."))
+            (let ((enter? (lambda (name stat result) #t))
+		  (leaf (lambda (name stat result)
+			  (when (string-suffix? ".pdf" name)
+			    (format (current-error-port) "PDF file: ~s…\n" name)
+                            (let ((miniature-name
+                                   (string-append
+                                    (substring name 0 (- (string-length name) (string-length ".pdf")))
+                                    "-miniature.png")))
+                              (invoke convert
+                                      "-resize" "210x297" "+append"
+                                      (string-append name "[0-4]")
+                                      miniature-name)))))
+		  (down (lambda (name stat result) #t))
+		  (up (lambda (name stat result) #t))
+		  (skip (lambda (name stat result) #t))
+		  (error (lambda (name stat errno result) #t)))
+              (file-system-fold enter? leaf down up skip error #t "."))
+	    (let ((enter? (lambda (name stat result) #t))
+		  (leaf (lambda (name stat result)
+			  (format (current-error-port) "Potentially midi file: ~s…\n" name)
+			  (when (string-prefix? "./" name)
+			    (set! name (substring name (string-length "./"))))
+			  (when (string-suffix? ".midi" name)
+			    (format (current-error-port) "Midi file: ~s…\n" name)
+			    (invoke timidity
+				    "-Ov" name))))
+		  (down (lambda (name stat result) #t))
+		  (up (lambda (name stat result) #t))
+		  (skip (lambda (name stat result) #t))
+		  (error (lambda (name stat errno result) #t)))
+              (file-system-fold enter? leaf down up skip error #t ".")))))))))
+   (native-inputs
+    (list lilypond imagemagick timidity++))
+   (synopsis
+    "The content of the copirate website")
+   (description
+    "This package contains the full contents of the copirate website.")
+   (home-page
+    "https://copirate.planete-kraus.eu")
+   (license
+    ((@@ (guix licenses) license)
+     "No license"
+     ""
+     "No license"))))
diff --git a/guix/vkraus/services/copirate-site.scm b/guix/vkraus/services/copirate-site.scm
new file mode 100644
index 0000000..c4f40a1
--- /dev/null
+++ b/guix/vkraus/services/copirate-site.scm
@@ -0,0 +1,74 @@
+(define-module (vkraus services copirate-site)
+  #:use-module ((gnu services)
+                #:select (service-type
+                          service-extension))
+  #:use-module ((gnu services web)
+                #:select (nginx-service-type
+                          nginx-server-configuration
+                          nginx-location-configuration))
+  #:use-module ((gnu services certbot)
+                #:select (certbot-service-type
+                          certificate-configuration))
+  #:use-module ((vkraus services simple-firewall)
+                #:select (simple-firewall-configuration
+                          simple-firewall-service-type))
+  #:use-module ((vkraus packages copirate-site)
+                #:select ((copirate-site . package:copirate-site)))
+  #:use-module ((guix gexp)
+                #:select (file-append program-file gexp))
+  #:use-module ((oop goops)
+                #:select (define-class
+                           define-method
+                           make
+                           slot-ref
+                           slot-set!
+                           deep-clone))
+  #:re-export (make)
+  #:export (<copirate-site-configuration>
+            copirate-site-service-type)
+  #:duplicates (merge-generics)
+  #:declarative? #t)
+
+(define-class <copirate-site-configuration> ()
+  (domain-name #:init-keyword #:domain-name)
+  (copirate-site #:init-keyword #:copirate-site
+		 #:init-value package:copirate-site))
+
+(define-method (nginx-extension (cfg <copirate-site-configuration>))
+  (list
+   (nginx-server-configuration
+    (server-name (list (slot-ref cfg 'domain-name)))
+    (listen '("443 ssl" "[::]:443 ssl"))
+    (ssl-certificate
+     (format #f "/etc/letsencrypt/live/~a/fullchain.pem"
+             (slot-ref cfg 'domain-name)))
+    (ssl-certificate-key
+     (format #f "/etc/letsencrypt/live/~a/privkey.pem"
+             (slot-ref cfg 'domain-name)))
+    (index '("index.xhtml"))
+    (root (build-copirate-site (slot-ref cfg 'copirate-source))))))
+
+(define-method (certbot-extension (cfg <copirate-site-configuration>))
+  (list
+   (certificate-configuration
+    (domains (list (slot-ref cfg 'domain-name)))
+    (deploy-hook
+     (program-file
+      "refresh-nginx"
+      #~(let ((pid (call-with-input-file "/var/run/nginx/pid" read)))
+	  (kill pid SIGHUP)))))))
+
+(define-method (simple-firewall-extension (cfg <copirate-site-configuration>))
+  (list
+   (simple-firewall-configuration #f '(http https) '(http https))))
+
+(define copirate-site-service-type
+  (service-type
+   (name 'copirate-site)
+   (description
+    "Serve the copirate site.")
+   (extensions
+    (list
+     (service-extension nginx-service-type nginx-extension)
+     (service-extension certbot-service-type certbot-extension)
+     (service-extension simple-firewall-service-type simple-firewall-extension)))))