;; disfluid, implementation of the Solid specification
;; Copyright (C) 2020, 2021  Vivien Kraus

;; This program 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.

;; 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 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 <https://www.gnu.org/licenses/>.

(define-module (webid-oidc server precondition)
  #:use-module (webid-oidc errors)
  #:use-module (webid-oidc server resource path)
  #:use-module (webid-oidc server resource content)
  #:use-module (webid-oidc cache)
  #:use-module (webid-oidc fetch)
  #:use-module (webid-oidc server resource wac)
  #:use-module ((webid-oidc stubs) #:prefix stubs:)
  #:use-module (webid-oidc rdf-index)
  #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
  #:use-module ((webid-oidc parameters) #:prefix p:)
  #:use-module (web uri)
  #:use-module (web response)
  #:use-module (rdf rdf)
  #:use-module (turtle tordf)
  #:use-module (turtle fromrdf)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 exceptions)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 iconv)
  #:use-module (ice-9 textual-ports)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 threads)
  #:use-module (rnrs bytevectors)
  #:use-module (oop goops)
  #:export
  (

   &precondition-failed
   make-precondition-failed
   precondition-failed?
   precondition-failed-path
   precondition-failed-if-match
   precondition-failed-if-none-match
   precondition-failed-etag

   check-precondition

   ))

(define-exception-type
  &precondition-failed
  &external-error
  make-precondition-failed
  precondition-failed?
  (path precondition-failed-path)
  (if-match precondition-failed-if-match)
  (if-none-match precondition-failed-if-none-match)
  (etag precondition-failed-etag))

(define (the-etag object)
  ;; Sometimes the user passes a pair as an etag (just like what
  ;; request-if-match may return).
  (if (pair? object)
      (car object)
      object))

(define (check-if-match if-match real-etag)
  ;; if-match is #f if no filter is used
  (or (not if-match)
      (eq? if-match '*)
      (let check-rest ((precondition if-match))
        (and (not (null? precondition))
             (let ((first (the-etag (car precondition)))
                   (rest (cdr precondition)))
               (or (equal? first real-etag)
                   (check-rest rest)))))))

(define (check-if-none-match if-none-match real-etag)
  ;; if-none-match is #f if there is no filter
  (or (not if-none-match)
      (if (eq? if-none-match '*)
          (not real-etag)
          ;; if-none-match is a list
          (let check-rest ((forbidden if-none-match))
            (or (null? forbidden)
                (let ((first (the-etag (car forbidden)))
                      (rest (cdr forbidden)))
                  (and (not (equal? first real-etag))
                       (check-rest rest))))))))

(define (check-precondition path if-match if-none-match real-etag)
  (unless (and (check-if-match if-match real-etag)
               (check-if-none-match if-none-match real-etag))
    (let ((error
           (make-precondition-failed path if-match if-none-match real-etag)))
      (unless real-etag
        (set! error
              (make-exception error (make-path-not-found path))))
      (raise-exception error))))