diff options
Diffstat (limited to 'module/vcomponent/data-stores/caldav.scm')
| -rw-r--r-- | module/vcomponent/data-stores/caldav.scm | 270 |
1 files changed, 270 insertions, 0 deletions
diff --git a/module/vcomponent/data-stores/caldav.scm b/module/vcomponent/data-stores/caldav.scm new file mode 100644 index 00000000..f9ba61c1 --- /dev/null +++ b/module/vcomponent/data-stores/caldav.scm @@ -0,0 +1,270 @@ +(define-module (vcomponent data-stores caldav) + ) + +(use-modules (srfi srfi-71) + (srfi srfi-88) + (rnrs bytevectors) + (rnrs io ports) + ((ice-9 binary-ports) :select (call-with-output-bytevector)) + (web request) + (web response) + (web client) + (web uri) + ;; (web http) ; + (sxml simple) + (oop goops) + (vcomponent data-stores common) + ((hnh util) :select (->)) + (web http dav) + ) + + + +(define-class <caldav-data-store> (<calendar-data-store>) + (host init-keyword: host: + getter: host) + (user init-keyword: user: + getter: user) + (calendar-path init-keyword: calendar-path: + accessor: calendar-path) + (password init-keyword: password: + getter: store-password)) + + +(define local-uri + (case-lambda ((this path) + (build-uri 'https + host: (host this) + path: path)) + ((this) + (build-uri 'https + host: (host this) + path: (calendar-path this))))) + + +(define* (make-caldav-store key: host user path password) + (define store + (make <caldav-data-store> + host: host + user: user + password: (string->symbol password) + calendar-path: path)) + + + (let* ((principal-path + (get-principal (local-uri store "/") + password: (store-password store))) + (calendar-home-set + (get-calendar-home-set (local-uri store principal-path) + password: (store-password store))) + (calendar-paths + (get-calendar-paths (local-uri store calendar-home-set) + password: (store-password store)))) + (set! (calendar-path store) + (car calendar-paths))) + + store) + +(define-method (write (this <caldav-data-store>) port) + (write `(make-caldav-store host: ,(host this) + user: ,(user this) + calendar-path: ,(calendar-path this) + password: ,(store-password this)) + port)) + +(define store + (make-caldav-store host: "dav.fruux.com" + user: "a3298201184" + password: "YjMyOTc0NjUwMDk6YXRhc3llanY2MGtu")) + +#; +(define-method (calendar-base (this <caldav-data-store>)) + (build-uri 'https + host: (host this) + path: (calendar-path this))) + + +;; (define-method (get-all (this <caldav-data-store>)) +;; ) + +(define-method (get-by-uid (this <caldav-data-store>) + (uid <string>)) + (let ((uids + (dav (local-uri this) + method: 'REPORT + authorization: `(Basic ,(store-password this)) + depth: 1 + body: + `(c:calendar-query + (@ (xmlns:c ,caldav)) + (d:prop (@ (xmlns:d "DAV:")) + (d:getetag) + #; (c:calendar-data) + ) + (c:filter + (c:comp-filter + (@ (name "VCALENDAR")) + (c:comp-filter + (@ (name "VEVENT")) + (c:prop-filter + (@ (name "UID")) + (c:text-match (@ (collation "i;octet")) + ,uid))))))))) + uids)) + + +(define-method (search (this <caldav-data-store>) + (filter <pair>)) + (let ((uids + (dav (local-uri this) + method: 'REPORT + authorization: `(Basic ,(store-password this)) + depth: 1 + body: + `(c:calendar-query + (@ (xmlns:c ,caldav)) + (d:prop (@ (xmlns:d "DAV:")) + (d:getetag) + (c:calendar-data + (c:comp (@ (name "VCALENDAR")) + (c:prop (@ (name "PRODID"))))) + #; (c:calendar-data) + ) + ,filter)))) + uids)) + +(define-method (search (this <caldav-data-store>) + (filter <string>) + (field <string>)) + (search store + `(c:filter + (c:comp-filter + (@ (name "VCALENDAR")) + (c:comp-filter + (@ (name "VEVENT")) + (c:prop-filter + (@ (name ,field)) + (c:text-match (@ (collation "i;octet")) + ,filter))))))) + + + +(define-method (list-calendars (this <caldav-data-store>)) + ) + + + + +(get-principal) ; => "/principals/uid/a3298201184/" + +(get-calendar-home-set "/principals/uid/a3298201184/") +;; => "/calendars/a3298201184/" + +(get-calendar-paths "/calendars/a3298201184/") +;; => ("/calendars/a3298201184/b85ba2e9-18aa-4451-91bb-b52da930e977/") + + + +(define user "a3298201184") +(define calendar "b85ba2e9-18aa-4451-91bb-b52da930e977") +(define password (string->symbol "YjMyOTc0NjUwMDk6YXRhc3llanY2MGtu")) +(define auth `(Basic ,password)) + + + + + + +(define uri + (build-uri 'https + host: "dav.fruux.com" + path: "/calendars/a3298201184/b85ba2e9-18aa-4451-91bb-b52da930e977/ff95c36c-6ae9-4aa0-b08f-c52d84bf4f26.ics")) + +(define-values (response body) + (dav uri + method: 'GET + authorization: auth)) + + + + +(define-values (response body) + (dav uri + method: 'PROPFIND + authorization: auth + body: + `(C:supported-collation-set (@ (xmlns:C ,caldav))))) + +(define-values (response body) + (dav uri + method: 'REPORT + authorization: auth + body: + `(C:calendar-query + (@ (xmlns:C ,caldav)) + (D:prop (@ (xmlns:D "DAV:")) + (D:getetac) + (C:calendar-data)) + (C:filter + (C:comp-filter (@ (name "VCALENDAR")) + (C:comp-filter (@ (name "VEVENT")) + (C:prop-filter (@ (name "UID")) + (C:text-match (@ (collation "i;utf-8")) + "Admittansen")))))))) + + + + + + +(define (add) + ;; add new event + (http-request 'PUT + path: "/path-on-server/<filename>.ics" + headers: + ((if-none-match "*") + (content-type "text/calendar")) + body: (ics:serialize event-with-wrapping-calendar) + )) + + +(define (get-by-time-range) + (http-request 'REPORT + path: "/calendar/<calendar-name>" + body: + ;; See RFC 4791 7.8.1 + `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (C:calendar-query + (@ (xmlns:D "DAV:") + (xmlns:C "urn:ietf:params:xml:ns:caldav")) + (D:prop + (D:getetag) + (C:calendar-data + (C:comp + (@ (name "VCALENDAR")) + (C:prop (@ (name "VERSION"))) + (C:prop (@ name "VEVENT") + (C:prop (@ (name "SUMMARY"))) + ...)))) + (C:filter + (C:comp-filter + (@ (name "VCALENDAR")) + (C:comp-filter + (@ (name "VEVENT")) + (C:time-range + (@ (start ,(datetime->string + start + "~Y~m~dT~H~M~S~Z")) + (end ,(datetime->string + end + "~Y~m~dT~H~M~S~Z"))))))))))) + + + + + +;; (use-modules (curl)) +;; (define c (curl-easy-init)) +;; (curl-easy-setopt c 'url "https://hornquist.se") + +;; (curl-easy-perform handle) |