From 4b6e56ebb435f16374cebf38923393dc2f27f3ce Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Sat, 9 Jan 2021 11:57:23 +0100 Subject: Initial commit --- ldp/precondition.scm | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 ldp/precondition.scm (limited to 'ldp/precondition.scm') diff --git a/ldp/precondition.scm b/ldp/precondition.scm new file mode 100644 index 0000000..990193a --- /dev/null +++ b/ldp/precondition.scm @@ -0,0 +1,55 @@ +(define-module (ldp precondition) + #:use-module (ldp etag) + #:use-module (web request) + #:use-module (oop goops)) + +(define-class () + (if-match #:init-keyword #:if-match #:getter precondition-if-match) + (if-none-match #:init-keyword #:if-match #:getter precondition-if-none-match)) + +(define (the-precondition x) + (unless (is-a? x ) + (scm-error 'wrong-type-arg + "the-precondition" + "Expected a precondition." + '() + (list x))) + x) + +(define (the-string x) + (unless (string? x) + (scm-error 'wrong-type-arg + "the-string" + "Expected a string." + '() + (list x))) + x) + +(define-public (make-precondition if-match if-none-match) + (unless if-match + (set! if-match '("*"))) + (unless if-none-match + (set! if-none-match '())) + (set! if-match (map the-string if-match)) + (set! if-none-match (map the-string if-none-match)) + (make + #:if-match if-match + #:if-none-match if-none-match)) + +(define-public (request->precondition request) + (make-precondition + (request-if-match request) + (request-if-none-match request))) + +(define-public (precondition-valid? x etag) + (define (check-matching list) + (and (not (null? list)) + (or (string=? etag (car list)) + (string=? (car list) "*") + (check-matching (cdr list))))) + (define (check-non-matching list) + (or (null? list) + (and (not (string=? etag (car list))) + (check-non-matching (cdr list))))) + (and (check-matching (precondition-if-match x)) + (check-non-matching (precondition-if-none-match x)))) -- cgit v1.2.3