;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 

(define-module (tests webfinger)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (json)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (webfinger webfinger))

(test-begin "webfinger")

(define (json-has-key? json key)
  (match json
    (((k . v) json ...)
     (or (equal? key k) (json-has-key? json key)))
    (_ #f)))

(define (alist-include? j1 j2)
  (fold
    (lambda (elem acc)
      (if acc
          (match elem
            ((key . value)
             (and
               (json-has-key? j2 key)
               (json-equal? value (assoc-ref j2 key))))
            (_ #f))
          #f))
    #t
    j1))

(define (json-equal? j1 j2)
  (cond
    ((list? j1)
     (and (list? j2)
          (alist-include? j1 j2)
          (alist-include? j2 j1)))
    ((string? j1)
     (equal? j1 j2))
    ((array? j1)
     (let loop ((j1 j1) (j2 j2))
       (match (cons j1 j2)
         ((#() . #())
          #t)
         ((#(v1 j1 ...) . #(v2 j2 ...))
          (and (json-equal? v1 v2)
               (loop `#(,@j1) `#(,@j2))))
         (_ #f))))
    (else (equal? j1 j2))))

(define simple-record-scm
  '(("subject" . "acct:carol@example.com")
    ("links" . #((("rel" . "http://openid.net/specs/connect/1.0/issuer")
                  ("href" . "https://openid.example.com"))))))
(define simple-record
  (make-jrd-record
    "acct:carol@example.com"
    '()
    *unspecified*
    (list
      (make-link-record
        "http://openid.net/specs/connect/1.0/issuer"
        *unspecified*
        "https://openid.example.com"
        *unspecified*
        *unspecified*))))

(test-assert "json-equality"
  (and (json-equal? #t #t)
       (json-equal? #f #f)
       (json-equal? "abc" "abc")
       (not (json-equal? "abc" "cba"))
       (json-equal? #() #())
       (json-equal? #(1 2) #(1 2))
       (not (json-equal? #(1 2) #(2 1)))
       (json-equal? '(("a" . 1) ("b" . 2))
                    '(("a" . 1) ("b" . 2)))
       (json-equal? '(("a" . 1) ("b" . 2))
                    '(("b" . 2) ("a" . 1)))))

(test-assert "simple example decode"
  (let ((converted-simple-record (json->jrd-record simple-record-scm)))
    (if (equal? converted-simple-record simple-record)
        #t
        (pk 'fail converted-simple-record #f))))

(test-assert "simple example encode"
  (let ((converted-simple-record-scm (jrd-record->json simple-record)))
    (if (json-equal? simple-record-scm
                     (json-string->scm converted-simple-record-scm))
        #t
        (pk 'fail converted-simple-record-scm
            (scm->json-string simple-record-scm) #f))))

(test-end "webfinger")