2 changed files with 188 additions and 1 deletions
@ -0,0 +1,186 @@ |
|||||||
|
#!/usr/bin/env racket |
||||||
|
|
||||||
|
;;; |
||||||
|
;;; Copyright (C) 2022, Maxim Lihachev, <envrm@yandex.ru> |
||||||
|
;;; |
||||||
|
;;; This program 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, version 3. |
||||||
|
;;; |
||||||
|
;;; This program 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 |
||||||
|
;;; this program. If not, see <https://www.gnu.org/licenses/>. |
||||||
|
;;; |
||||||
|
|
||||||
|
;;; terraform-compliance-generator can be used to generate |
||||||
|
;;; https://terraform-compliance.com/ compatible BDD scenario. |
||||||
|
|
||||||
|
#lang racket/base |
||||||
|
|
||||||
|
(require |
||||||
|
(for-syntax racket/base) |
||||||
|
json |
||||||
|
racket/format |
||||||
|
racket/function |
||||||
|
racket/list |
||||||
|
racket/path |
||||||
|
racket/port |
||||||
|
racket/string |
||||||
|
racket/stxparam |
||||||
|
racket/vector) |
||||||
|
|
||||||
|
;;; ---------------------------------------------------------------------------- |
||||||
|
;; |
||||||
|
;; Terraform plan JSON: |
||||||
|
;; |
||||||
|
;; { |
||||||
|
;; "resource_changes": [ |
||||||
|
;; { |
||||||
|
;; "type": "helm_release", |
||||||
|
;; "change": { |
||||||
|
;; "after": { |
||||||
|
;; "key": value, |
||||||
|
;; ... |
||||||
|
;; } |
||||||
|
;; } |
||||||
|
;; }, |
||||||
|
;; ... |
||||||
|
;; ] |
||||||
|
;; } |
||||||
|
;; |
||||||
|
|
||||||
|
(define (usage) |
||||||
|
(display-lines |
||||||
|
(list |
||||||
|
"terraform-bdd generates terraform-compliance acceptable BDD tests.\n" |
||||||
|
(format "USAGE: ~a [terraform.plan.json]~%" script-file) |
||||||
|
"Command line options:" |
||||||
|
" --help Show this help."))) |
||||||
|
|
||||||
|
;;; ---------------------------------------------------------------------------- |
||||||
|
|
||||||
|
(define-syntax-parameter <resource> |
||||||
|
(λ (stx) (raise-syntax-error '<resource> "Used outside of macro." stx))) |
||||||
|
|
||||||
|
(define-syntax-parameter <properties> |
||||||
|
(λ (stx) (raise-syntax-error '<properties> "Used outside of macro." stx))) |
||||||
|
|
||||||
|
(define (to-string x) |
||||||
|
(format "~a" x)) |
||||||
|
|
||||||
|
(define (read-terraform-plan plan-file) |
||||||
|
(if (file-exists? plan-file) |
||||||
|
(with-handlers |
||||||
|
((exn:fail? |
||||||
|
(λ (exn) |
||||||
|
(fprintf (current-error-port) |
||||||
|
"ERROR: Unable to read JSON data: ~a~%" (exn-message exn)) |
||||||
|
(exit 1)))) |
||||||
|
(with-input-from-file plan-file |
||||||
|
(λ () |
||||||
|
(hash-ref (read-json) 'resource_changes)))) |
||||||
|
(printf "ERROR: file ~a does not exist.~%" plan-file))) |
||||||
|
|
||||||
|
(define (fields l) |
||||||
|
(filter (λ (xs) |
||||||
|
(let ((x (cdr xs))) |
||||||
|
(not (or (null? x) |
||||||
|
(eq? (json-null) x) |
||||||
|
(hash? x) |
||||||
|
(list? x))))) |
||||||
|
l)) |
||||||
|
|
||||||
|
(define (get-properties change) |
||||||
|
(sort (fields |
||||||
|
(hash->list |
||||||
|
(hash-ref (hash-ref change 'change) 'after))) |
||||||
|
#:key car (λ (a b) (string<? (to-string a) (to-string b))))) |
||||||
|
|
||||||
|
(define (key pair) (car pair)) |
||||||
|
|
||||||
|
(define (value pair) |
||||||
|
(let ((v (cdr pair))) |
||||||
|
(cond ((boolean? v) |
||||||
|
(case v |
||||||
|
((#t) "true") |
||||||
|
((#f) "false"))) |
||||||
|
((number? v) v) |
||||||
|
(else (with-quotes v))))) |
||||||
|
|
||||||
|
(define (with-quotes s) |
||||||
|
(regexp-replace* #rx"(^\"+|\"+$)" (string-append "\"" s "\"") "\"")) |
||||||
|
|
||||||
|
(define (max-width fx l) |
||||||
|
(apply max |
||||||
|
(map |
||||||
|
(lambda (x) (string-length (to-string (fx x)))) l))) |
||||||
|
|
||||||
|
;;; ---------------------------------------------------------------------------- |
||||||
|
|
||||||
|
(define-syntax-rule (FEATURE terraform-plan expr ...) |
||||||
|
(display-lines |
||||||
|
(flatten |
||||||
|
(list "Feature: Test Terraform Module" |
||||||
|
(map (curry expr ...) terraform-plan))))) |
||||||
|
|
||||||
|
(define-syntax-rule (EXAMPLES properties) |
||||||
|
(let ((row (λ (q) (format " | ~a | ~a |" |
||||||
|
(~a (key q) #:min-width (max-width key properties)) |
||||||
|
(~a (value q) #:min-width (max-width value properties)))))) |
||||||
|
(list |
||||||
|
(format "~% Examples:") |
||||||
|
(row (cons "<key>" "<value>")) |
||||||
|
(map row properties)))) |
||||||
|
|
||||||
|
(define-syntax-rule (GIVEN resource expr ...) |
||||||
|
(λ (short-list properties) |
||||||
|
(list |
||||||
|
(format " Given I have ~a defined" (string-replace (hash-ref resource 'type) "_" " ")) |
||||||
|
(if short-list |
||||||
|
(map (curry expr ...) properties) |
||||||
|
(list |
||||||
|
(expr ... (cons (with-quotes "<key>") (with-quotes "<value>"))) |
||||||
|
(EXAMPLES properties)))))) |
||||||
|
|
||||||
|
(define-syntax-rule (THEN _ _) |
||||||
|
(λ (x) |
||||||
|
(syntax-parameterize |
||||||
|
((<properties> (make-rename-transformer #'x))) |
||||||
|
(format " Then it must have ~a~% And its value must be ~a" (key x) (value x))))) |
||||||
|
|
||||||
|
(define-syntax-rule (SCENARIO _ expr ...) |
||||||
|
(λ (x) |
||||||
|
(syntax-parameterize |
||||||
|
((<resource> (make-rename-transformer #'x))) |
||||||
|
(let* ((properties (get-properties x)) |
||||||
|
(long-list (<= (length properties) 3)) |
||||||
|
(resource-type (hash-ref x 'type)) |
||||||
|
(scenario-type (if long-list "" " Outline"))) |
||||||
|
(list |
||||||
|
(format "~%Scenario~a: Ensure that the ~a resource exists" scenario-type resource-type) |
||||||
|
(expr ... long-list properties)))))) |
||||||
|
|
||||||
|
;;; ---------------------------------------------------------------------------- |
||||||
|
|
||||||
|
(define script-file (file-name-from-path (find-system-path 'run-file))) |
||||||
|
(define args (current-command-line-arguments)) |
||||||
|
|
||||||
|
(when (or (vector-empty? args) |
||||||
|
(equal? (vector-ref args 0) "--help")) |
||||||
|
(usage) |
||||||
|
(exit)) |
||||||
|
|
||||||
|
(define terraform-plan |
||||||
|
(read-terraform-plan (vector-ref args 0))) |
||||||
|
|
||||||
|
;;; ---------------------------------------------------------------------------- |
||||||
|
|
||||||
|
(FEATURE terraform-plan |
||||||
|
(SCENARIO <resource> |
||||||
|
(GIVEN <resource> |
||||||
|
(THEN CHECK <properties>)))) |
||||||
|
|
Loading…
Reference in new issue