;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021 GNUnet e.V.
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet 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
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL3.0-or-later

(import (gnu gnunet config db)
	(gnu gnunet config expand)
	(gnu gnunet config fs)
	(gnu gnunet config parser)
	(rnrs exceptions)
	(srfi srfi-1)
	(srfi srfi-64))
(test-begin "config-fs")

(define (alist->getenv alist)
  (lambda (x)
    (assoc-ref alist x)))

(test-equal "locate-user-configuraton, XDG_CONFIG_HOME + HOME"
  "/somewhere/unusual/gnunet.conf"
  (locate-user-configuration
   #:getenv
   (alist->getenv '(("HOME" . "/a/home")
		    ("XDG_CONFIG_HOME" . "/somewhere/unusual")))))

(test-equal "locate-user-configuraton, XDG_CONFIG_HOME without HOME"
  "/somewhere/unusual/gnunet.conf"
  (locate-user-configuration
   #:getenv
   (alist->getenv '(("XDG_CONFIG_HOME" . "/somewhere/unusual")))))

(test-equal "locate-user-configuration, no XDG_CONFIG_HOME"
  "/a/home/.config/gnunet.conf"
  (locate-user-configuration
   #:getenv
   (alist->getenv '(("HOME" . "/a/home")))))

(test-equal "locate-user-configuration, empty XDG_CONFIG_HOME"
  "/a/home/.config/gnunet.conf"
  (locate-user-configuration
   #:getenv
   (alist->getenv '(("HOME" . "/a/home")
		    ("XDG_CONFIG_HOME" . "")))))

(test-equal "locate-user-configuration, no XDG_CONFIG_HOME, no HOME"
  #false
  (locate-user-configuration
   #:getenv
   (alist->getenv '())))

(test-equal "locate-user-configuration, no XDG_CONFIG_HOME, empty HOME"
  #false
  (locate-user-configuration
   #:getenv
   (alist->getenv '(("HOME" . "")))))

(define (load-string->alist/unexpanded s)
  (call-with-input-string s
    (lambda (p)
      (define a '())
      (define (set-value! section key value)
	(pk 's section key value)
	(set! a `(((,section . ,key) . ,value) ,@a))
	(values))
      (load-configuration/port! set-value! p)
      a)))

;; TODO: better error reporting

(test-equal "load-configuration/port!, literal read-value"
  `((("section" . "VAR")
     . #("VAR = VALUE" 2 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "[section]\nVAR = VALUE"))

(test-equal "load-configuration/port!, empty"
  '()
  (load-string->alist/unexpanded ""))

(test-error "load-configuration/port!, assignment outside section"
  "assignment outside section"
  (load-string->alist/unexpanded "VAR = VALUE"))

(test-equal "load-configuration/port!, literal read-value after empty line"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "[section]\n\nVAR = VALUE"))

(test-equal "load-configuration/port!, section after empty line"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "\n[section]\nVAR = VALUE"))

(test-error "load-configuration/port!, bogus syntax before section"
  "unrecognised syntax at line ???"
  (load-string->alist/unexpanded "]\n[section]\n"))

(test-error "load-configuration/port!, bogus syntax after section"
  "unrecognised syntax at line ???"
  (load-string->alist/unexpanded "[section]\n]"))

(test-equal "load-configuration/port!, skip comment (#) after section"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "[section]\n#\nVAR = VALUE"))

(test-equal "load-configuration/port!, skip comment (%) after section"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "[section]\n#\nVAR = VALUE"))

(test-equal "load-configuration/port!, skip empty line after section"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "[section]\n\nVAR = VALUE"))

(test-equal "load-configuration/port!, skip comment (#) before section"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "#\n[section]\nVAR = VALUE"))

(test-equal "load-configuration/port!, skip comment (%) before section"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "%\n[section]\nVAR = VALUE"))

(test-equal "load-configuration/port!, skip empty line before section"
  `((("section" . "VAR")
     . #("VAR = VALUE" 3 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded "\n[section]\nVAR = VALUE"))

(test-equal "load-configuration/port!, two sections"
  `((("section2" . "VAR2")
     . #("VAR2 = VALUE2" 4 (,(make-literal-position 7 13))))
    (("section1" . "VAR")
     . #("VAR = VALUE" 2 (,(make-literal-position 6 11)))))
  (load-string->alist/unexpanded
   "[section1]\nVAR = VALUE\n[section2]\nVAR2 = VALUE2"))

(define (load-string->config/expanded text environment-variables)
  (make-expanded-configuration
   (lambda (set-value!)
     (call-with-input-string text
       (lambda (p)
	 (load-configuration/port! set-value! p))))
   #:getenv
   (alist->getenv environment-variables)))

(define (load-string->alist/expanded text interested environment-variables)
  (define config (load-string->config/expanded text environment-variables))
  (filter-map (lambda (section+key)
		`(,section+key
		  . ,(guard (c ((undefined-key-error? c) 'undefined))
		       (read-value identity config (car section+key)
				   (cdr section+key)))))
	      interested))

(test-equal "make-expanded-configuration, one variable"
  '((("sect" . "var") . "iable"))
  (load-string->alist/expanded "[sect]\nvar=iable"
			       '(("sect" . "var")) '()))

;; Detected a missing 'list'
(test-equal "make-expanded-configuration, expand variable (via getenv)"
  '((("sect" . "var") . "iable"))
  (load-string->alist/expanded "[sect]\nvar=i$a"
			       '(("sect" . "var")) '(("a" . "able"))))


(test-equal "make-expanded-configuration, expand variable (via getenv, fancyness)"
  '((("sect" . "var") . "i}\\$able%f'"))
  (load-string->alist/expanded "[sect]\nvar=i$a"
			       '(("sect" . "var"))
			       '(("a" . "}\\$able%f'"))))

(test-equal "make-expanded-configuration, expand variable (via PATHS)"
  '((("sect" . "var") . "iable")
    (("PATHS" . "something") . "able"))
  (load-string->alist/expanded
   "[sect]\nvar=i$something\n[PATHS]\nsomething=able"
   '(("sect" . "var")
     ("PATHS" . "something"))
   '()))

;; Detects incorrect implementation of substring=? (string=? was used instead)
(test-equal "make-expanded-configuration, expand variable (via PATHS + getenv)"
  '((("sect" . "var") . "iable")
    (("PATHS" . "something") . "able"))
  (load-string->alist/expanded
   "[sect]\nvar=i$something\n[PATHS]\nsomething=a$else"
   '(("sect" . "var")
     ("PATHS" . "something"))
   '(("else" . "ble"))))

;; Detect implementations of substring=? that always return #f.
(test-equal "make-expanded-configuration, loop detected"
  #t
  (guard (c ((expansion-loop-error? c) #t))
    (load-string->alist/expanded
     "[sect]\nvar=i${something}\n[PATHS]\nsomething=d${something}"
     '(("PATHS" . "something"))
     '(("something" . "unused")))))

(test-end "config-fs")