~abcdw/rde-devel

rde: serializers: Add nginx. v1 APPLIED

Andrew Tropin <andrew@trop.in>
5 months ago 
Andrew Tropin: 1
 rde: serializers: Add nginx.

 2 files changed, 426 insertions(+), 0 deletions(-)
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git: 

curl -s https://lists.sr.ht/~abcdw/rde-devel/patches/40053/mbox | git am -3
Learn more about email & git
Reply to thread View this thread in the archives

[PATCH] rde: serializers: Add nginx. Export this patch

Andrew Tropin <andrew@trop.in>
5 months ago 
---
It's already applied, but we can still discuss and adjust it.

There are a few important things about this particular serializer:

It's covered with tests, which work as examples and ensure that implementation
works as expected in various scenarios and no regression introduced after
introducing new changes or doing refactoring.

It was build with TDD approach, which I hope we will adopt to get a better
test coverage and to improve automated QA.

It exposes API according to
https://git.sr.ht/~abcdw/rde/tree/498dec88/doc/decision-log/0002-serialization-api.org#L1

 src/rde/serializers/nginx.scm        | 157 ++++++++++++++++
 tests/rde/serializers/nginx-test.scm | 269 +++++++++++++++++++++++++++
 2 files changed, 426 insertions(+)
 create mode 100644 src/rde/serializers/nginx.scm
 create mode 100644 tests/rde/serializers/nginx-test.scm

diff --git a/src/rde/serializers/nginx.scm b/src/rde/serializers/nginx.scm
new file mode 100644
index 0000000..b86de2e
--- /dev/null
+++ b/src/rde/serializers/nginx.scm
@@ -0,0 +1,157 @@
;;; rde --- Reproducible development environment.
;;;
;;; Copyright © 2023 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of rde.
;;;
;;; rde 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.
;;;
;;; rde 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 rde.  If not, see <http://www.gnu.org/licenses/>.

(define-module (rde serializers nginx)
  #:use-module (guix diagnostics)
  #:use-module (guix gexp)
  #:use-module (guix ui)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (rde serializers utils)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-43)
  #:export (nginx-serialize
            nginx-merge
            nginx-config?

            serialize-nginx-term
            serialize-nginx-vector
            serialize-nginx-context))

(define (nginx-term? t)
  (fold (lambda (x acc) (or acc (x t)))
        #f
        (list symbol? number? string? file-like? gexp?)))

(define (aligner nestness)
  (apply string-append
         ;; 4 spaces is too much for highly nested contexts.
         (map (const "  ") (iota nestness))))

(define (serialize-nginx-term term)
    (match term
      ((? symbol? e) (symbol->string e))
      ((? number? e) (number->string e))
      ((? string? e) (format #f "~s" e))
      ((or
        (? file-like? e)
        (? gexp? e))
       e)
      (e (raise (formatted-message
               (G_ "\
Nginx term should be string, number, symbol, or gexp. Provided term is:\n ~a")
               e)))))

(define (nginx-vector? v)
  (and (vector? v)
       (vector-fold
        (lambda (i acc x) (and acc (nginx-term? x)))
        #t v)))

(define (serialize-nginx-vector v)
  (append
   (list "(")
   (interpose
    (reverse
     (vector-fold (lambda (i acc x)
                    (cons (serialize-nginx-term x) acc))
                  '()
                  v))
    " ")
   (list ")")))

(define (serialize-nginx-element t)
  (if (nginx-term? t)
      (list (serialize-nginx-term t))
      (serialize-nginx-vector t)))

(define (context-item? x)
  (or (list? x)
      (gexp? x)))

(define (nginx-context? x)
  (and (list? x)
       (every context-item? x)))

(define* (serialize-nginx-expression
          expr #:optional (nestness 0))
  (match expr
    ;; context's top-level gexp
    ((? gexp? e)
     (list e "\n"))

    ;; (element context)
    ((element (? nginx-context? context))
     (append
      (serialize-nginx-element element)
      (list " {\n")
      (serialize-nginx-context context (1+ nestness))
      `(,(aligner nestness)
        "}\n")))

    ;; subexpression:

    ;; (element . rest)
    ((element rest ..1)
     (append
      (serialize-nginx-element element) (list " ")
      (serialize-nginx-expression rest nestness)))

    ;; last element of subexpression
    ((element)
     `(,@(serialize-nginx-element element) ";" "\n"))

    (e
     (raise (formatted-message
             (G_ "Nginx expression should be a list of terms \
optionally ending with context, but provided expression is:\n ~a")
             e)))))

(define* (serialize-nginx-context
          context #:optional (nestness 0))
  (match context
    ;; config:
    ;; ((expr1) (expr2) (expr3))
    ((? nginx-context? expressions)
     (append-map
      (lambda (e)
        (append (list (if (gexp? e)
                          (aligner 0)
                          (aligner nestness)))
                (serialize-nginx-expression e nestness)))
      expressions))
    (e
     (raise (formatted-message
             (G_ "Nginx context should be a list of expressions, \
where each expression is also a list or gexp, but provided value is:\n ~a") e))) ))

(define (serialize-nginx-config f c)
  #~(apply string-append
           (list #$@(serialize-nginx-context c))))

(define (nginx-serialize config)
  (serialize-nginx-config #f config))

(define (nginx-merge config1 config2 . rest)
  "Naive implementation, without actual merging logic."
  (apply append config1 config2 rest))

(define (nginx-config? config)
  "Naive implementation, without traversing nested structures."
  (nginx-context? config))
diff --git a/tests/rde/serializers/nginx-test.scm b/tests/rde/serializers/nginx-test.scm
new file mode 100644
index 0000000..4394206
--- /dev/null
+++ b/tests/rde/serializers/nginx-test.scm
@@ -0,0 +1,269 @@
;;; rde --- Reproducible development environment.
;;;
;;; Copyright © 2023 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of rde.
;;;
;;; rde 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.
;;;
;;; rde 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 rde.  If not, see <http://www.gnu.org/licenses/>.

(define-module (rde serializers nginx-test)
  #:use-module (guix gexp)
  #:use-module (rde serializers nginx)
  #:use-module (rde tests)
  #:use-module (rde tests store)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-64))

(define (serialize-config config)
  (eval-with-store (nginx-serialize config)))

(define-test nginx-terms
  (test-group "nginx terms"
    (test-equal "number"
      "123"
      (serialize-nginx-term 123))
    (test-equal "string"
      "\"string here\""
      (serialize-nginx-term "string here"))
    (test-equal "symbol"
      "symbol-here"
      (serialize-nginx-term 'symbol-here))
    (test-assert "gexp"
      (gexp?
       (serialize-nginx-term #~"gexp")))
    (test-assert "file-like"
      (file-like?
       (serialize-nginx-term (plain-file "name" "content"))))

    (test-error "true" #t (serialize-nginx-term #t))
    (test-error "false" #t (serialize-nginx-term #f))
    (test-error "list" #t (serialize-nginx-term '(a b c)))
    (test-error "vector" #t (serialize-nginx-term #(a b c)))))

(define-test nginx-vectors
  (test-group "nginx vectors (conditions)"
    (test-assert "vector with a few terms"
      (match (serialize-nginx-vector
              `#(symbol "string" 123 ,#~(format #f "gexp")))
        (("(" "symbol" " " "\"string\"" " " "123" " " (? gexp? _) ")") #t)
        (_ #f)))

    (test-error "nested list" #t (serialize-nginx-vector #(())))
    (test-error "nested vector" #t (serialize-nginx-vector #(#())))))


(define-test nginx-contexts
  (test-group "nginx contexts"
    (test-assert "simple nested config"
      (match (serialize-nginx-context
              `((a b ((c d)))))
        (("" "a" " " "b" " {\n"
          "  " "c" " " "d" ";" "\n"
          "" "}\n") #t)
        (_ #f)))

    (test-assert "double nested config"
      (match (serialize-nginx-context
              `((a ((b ((c d)))))))
        (("" "a" " {\n"
          "  " "b" " {\n"
          "    " "c" " " "d" ";" "\n"
          "  " "}\n"
          "" "}\n") #t)
        (_ #f)))

    (test-assert "double nested config with vector"
      (match (serialize-nginx-context
              `((a ((b #() ((c)))))))
        (("" "a" " {\n"
          "  " "b" " " "(" ")" " {\n"
          "    " "c" ";" "\n"
          "  " "}\n"
          "" "}\n") #t)
        (_ #f)))))

(define-test basic-config
  (test-group "basic config"
    (test-equal "key-value pairs"
      "\
a b;
c d;
"
      (serialize-config '((a b)
                          (c d))))

    (test-equal "nested context"
      "\
a b {
  c d;
}
"
      (serialize-config '((a b ((c d))))))

    (test-equal "simple if statement"
      "\
if (a ~ b) {
  c d;
}
"
      (serialize-config '((if #(a ~ b) ((c d))))))))

(define-test gexps
  (test-group "gexps"
    (test-equal "simple gexps"
      "\
a hehe;
"
      (serialize-config
       `((a ,#~(format #f "hehe")))))

    (test-equal "simple identation of gexps"
      "\
a {
# gexp
}
"
      (serialize-config
       `((a (,#~"# gexp")))))

    (test-equal "advanced identation of gexps"
      "\
a {
  a gexp-generated value;
# unindented
  # indented again;
}
"
      (serialize-config
       `((a ((a ,#~"gexp-generated" value)
             ,#~"# unindented"
             (,#~"# indented again"))))))))

(define-test example-config
  (test-group "example config"
    (test-equal "location with nested if and empty body"
      "\
location ~* ^/if-and-alias/(?<file>.*) {
  alias /tmp/$file;
  set $true 1;
  if ($true) {
    # nothing;
  }
}
"
      (serialize-config
       `((location ~*
                   #{^/if-and-alias/(?<file>.*)}# ; guile symbol read syntax
                   ;; ,#~"^/if-and-alias/(?<file>.*)"
                   ((alias /tmp/$file)
                    (set $true 1)
                    (if #($true) ((,#~"# nothing"))))))))

    (test-equal "location with nested if 2"
      "\
location / {
  error_page 418 = @other;
  recursive_error_pages on;
  if ($something) {
    return 418;
  }
}
"
      (serialize-config
       '((location / ((error_page 418 = @other)
                      (recursive_error_pages on)
                      (if #($something)
                          ((return 418))))))))))

(define-test nginx-config-merge
  (test-group "nginx config merge"
    (test-equal "naive merge"
      '((a ((b c)))
        (d ((e f)))
        (g ((h i))))
      (nginx-merge '((a ((b c)))) '((d ((e f)))) `((g ((h i))))))

    ;; Right now nginx-merge doesn't actually merge, it just concatenates.
    ;; Fix the implementation and remove test-expect-fail.
    (test-expect-fail 1)
    (test-equal "advanced merge"
      '((a ((b c)
            (e f)
            (h i))))
      (nginx-merge '((a ((b c)))) '((a ((e f)))) `((a ((h i))))))

    (test-expect-fail 1)
    (test-equal "deep merge"
      '((a ((b ((c d)
                (e f)
                (g h)))
            (i j))))
      (nginx-merge '((a ((b ((c d))))))
                   '((a ((b ((e f))))))
                   '((a ((b ((g h)))
                         (i j))))))))

(define-test nginx-config-predicate
  (test-group "nginx config predicate"
    (test-assert "valid: simple case"
      (nginx-config? `((if #(ho) ((b c)))
                       ,#~"# heh")))

    ;; Current implementation doesn't traverse the data structure and doesn't
    ;; check elements of nginx expression.
    (test-expect-fail 1)
    (test-assert "not valid: two subcontext"
      (not (nginx-config? '((a ((e f)) ((b c)))))))

    ;; Current implementation doesn't traverse the data structure and checks
    ;; only the top level context.
    (test-expect-fail 1)
    (test-assert "not valid: incorrect subcontext"
      (not (nginx-config? '((a (c))))))))

;; if ($http_user_agent ~ MSIE) {
;;     rewrite ^(.*)$ /msie/$1 break;
;; }

;; if ($http_cookie ~* "id=([^;]+)(?:;|$)") {
;;     set $id $1;
;; }

;; if ($request_method = POST) {
;;     return 405;
;; }

;; if ($slow) {
;;     limit_rate 10k;
;; }

;; if ($invalid_referer) {
;;     return 403;
;; }

;; location ~* ^/if-and-alias/(?<file>.*) {
;;     alias /tmp/$file;
;;     set $true 1;
;;     if ($true) {
;;         # nothing
;;     }
;; }

;; if ($args ~ post=140){
;;   rewrite ^ http://example.com/ permanent;
;; }

;; https://www.digitalocean.com/community/tutorials/understanding-the-nginx-configuration-file-structure-and-configuration-contexts
;; https://stackoverflow.com/questions/2936260/what-language-are-nginx-conf-files
;; https://www.nginx.com/blog/using-free-ssltls-certificates-from-lets-encrypt-with-nginx/
-- 
2.39.2