blob: 990193af980207bb806b1331e7ffd607e86d30f5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
(define-module (ldp precondition)
#:use-module (ldp etag)
#:use-module (web request)
#:use-module (oop goops))
(define-class <precondition> ()
(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 <precondition>)
(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 <precondition>
#: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))))
|
