diff --git a/lib/events/ical.sx b/lib/events/ical.sx index 437fdc6d..db7bc441 100644 --- a/lib/events/ical.sx +++ b/lib/events/ical.sx @@ -41,9 +41,9 @@ "" (reduce (fn (acc p) (str acc sep p)) (first parts) (rest parts))))) -;; A UTC epoch-minute as an iCal basic-format UTC stamp. +;; An epoch-minute as an iCal basic-format stamp (no zone suffix). (define - ev-ical-dt + ev-ical-dt-stamp (fn (t) (let @@ -55,7 +55,25 @@ "T" (ev-ical-pad2 (quotient tod 60)) (ev-ical-pad2 (modulo tod 60)) - "00Z")))) + "00")))) + +;; A UTC epoch-minute as a UTC stamp (trailing Z). +(define ev-ical-dt (fn (t) (str (ev-ical-dt-stamp t) "Z"))) + +;; A local epoch-minute as a floating/local stamp (no Z) — used with TZID. +(define ev-ical-dt-local ev-ical-dt-stamp) + +;; A UTC offset in minutes as "+HHMM" / "-HHMM". +(define + ev-ical-offset + (fn + (mins) + (let + ((a (abs mins))) + (str + (if (< mins 0) "-" "+") + (ev-ical-pad2 (quotient a 60)) + (ev-ical-pad2 (modulo a 60)))))) ;; A duration in minutes as an iCal DURATION value (PT#H#M). (define @@ -94,14 +112,8 @@ (str (get e :ord) (ev-ical-wd (get e :wd))) (ev-ical-wd e)))) -;; A datetime converter for an event: tz-aware events store wall-clock LOCAL -;; times, so export converts them to UTC (the `Z` stamps are absolute); -;; non-tz events pass through unchanged. -;; CAVEAT: a UTC RRULE recurs at a fixed UTC offset, whereas a tz event's -;; expansion stays wall-clock-stable across DST — so for a tz recurrence that -;; crosses a DST boundary the exported series drifts by the offset change -;; after the boundary. DTSTART and each individual stamp are correct; full -;; fidelity would need a VTIMEZONE block (deferred). +;; UNTIL converter: per RFC 5545, even a TZID DTSTART requires UNTIL in UTC, so +;; a tz event converts its (local) UNTIL to UTC; a non-tz event passes through. (define ev-ical-conv (fn @@ -110,6 +122,74 @@ ((tz (get event :tz))) (if (nil? tz) (fn (t) t) (fn (t) (ev-tz-local->utc tz t)))))) +;; ---- VTIMEZONE ---- +;; A tz event exports DTSTART;TZID=: and the VCALENDAR carries +;; a VTIMEZONE block defining the zone's DST rules, so a client recurs at a +;; fixed WALL-CLOCK time (DST-correct) rather than fixed UTC. + +;; A DST transition rule -> "FREQ=YEARLY;BYMONTH=;BYDAY=". +(define + ev-ical-vtz-rrule + (fn + (rule) + (str + "FREQ=YEARLY;BYMONTH=" + (get rule :month) + ";BYDAY=" + (get rule :ord) + (ev-ical-wd (get rule :wd))))) + +;; The transition's DTSTART (local time of the FROM offset) in a reference year. +(define + ev-ical-vtz-dtstart + (fn + (rule from-offset) + (let + ((day (ev-resolve-nth-weekday 1970 (get rule :month) (get rule :ord) (get rule :wd)))) + (ev-ical-dt-local + (+ (* (ev-days-from-civil 1970 (get rule :month) day) 1440) + (get rule :time) + from-offset))))) + +;; The VTIMEZONE content lines for a zone (DAYLIGHT + STANDARD for :dst; a +;; single STANDARD for :fixed). +(define + ev-ical-vtimezone + (fn + (tz) + (if + (= (get tz :kind) :dst) + (let + ((std (get tz :std-offset)) + (dst (get tz :dst-offset)) + (sr (get tz :dst-start)) + (er (get tz :dst-end))) + (list + "BEGIN:VTIMEZONE" + (str "TZID:" (get tz :name)) + "BEGIN:DAYLIGHT" + (str "DTSTART:" (ev-ical-vtz-dtstart sr std)) + (str "TZOFFSETFROM:" (ev-ical-offset std)) + (str "TZOFFSETTO:" (ev-ical-offset dst)) + (str "RRULE:" (ev-ical-vtz-rrule sr)) + "END:DAYLIGHT" + "BEGIN:STANDARD" + (str "DTSTART:" (ev-ical-vtz-dtstart er dst)) + (str "TZOFFSETFROM:" (ev-ical-offset dst)) + (str "TZOFFSETTO:" (ev-ical-offset std)) + (str "RRULE:" (ev-ical-vtz-rrule er)) + "END:STANDARD" + "END:VTIMEZONE")) + (list + "BEGIN:VTIMEZONE" + (str "TZID:" (get tz :name)) + "BEGIN:STANDARD" + "DTSTART:19700101T000000" + (str "TZOFFSETFROM:" (ev-ical-offset (get tz :offset))) + (str "TZOFFSETTO:" (ev-ical-offset (get tz :offset))) + "END:STANDARD" + "END:VTIMEZONE")))) + ;; ---- RRULE ---- (define ev-ical-rrule @@ -149,45 +229,84 @@ ;; ---- VEVENT / VCALENDAR ---- -;; The VEVENT content lines for an event (list of strings). +;; The VEVENT content lines for an event (list of strings). A tz event uses +;; DTSTART;TZID=: (matched by a VTIMEZONE at the VCALENDAR level) +;; with EXDATE/RDATE in the same TZID-local form; UNTIL is always UTC. A non-tz +;; event uses UTC `Z` stamps throughout. (define ev/event->ical-lines (fn (event) (let - ((lines (list "BEGIN:VEVENT")) (conv (ev-ical-conv event))) - (begin - (append! lines (str "UID:" (get event :id))) - (append! lines (str "SUMMARY:" (get event :id))) - (append! lines (str "DTSTART:" (ev-ical-dt (conv (get event :dtstart))))) - (append! - lines - (str "DURATION:" (ev-ical-duration (get event :duration)))) - (when - (not (nil? (get event :rrule))) - (append! lines (ev-ical-rrule (get event :rrule) conv))) - (when - (and - (not (nil? (get event :exdate))) - (> (len (get event :exdate)) 0)) + ((lines (list "BEGIN:VEVENT")) + (conv (ev-ical-conv event)) + (tz (get event :tz))) + (let + ((dtparam (if (nil? tz) "" (str ";TZID=" (get tz :name)))) + (fmt (if (nil? tz) ev-ical-dt ev-ical-dt-local))) + (begin + (append! lines (str "UID:" (get event :id))) + (append! lines (str "SUMMARY:" (get event :id))) + (append! lines (str "DTSTART" dtparam ":" (fmt (get event :dtstart)))) (append! lines - (str - "EXDATE:" - (ev-ical-join (map (fn (d) (ev-ical-dt (conv d))) (get event :exdate)) ",")))) - (when - (and - (not (nil? (get event :rdate))) - (> (len (get event :rdate)) 0)) - (append! - lines - (str - "RDATE:" - (ev-ical-join (map (fn (d) (ev-ical-dt (conv d))) (get event :rdate)) ",")))) - (append! lines "END:VEVENT") - lines)))) + (str "DURATION:" (ev-ical-duration (get event :duration)))) + (when + (not (nil? (get event :rrule))) + (append! lines (ev-ical-rrule (get event :rrule) conv))) + (when + (and + (not (nil? (get event :exdate))) + (> (len (get event :exdate)) 0)) + (append! + lines + (str + "EXDATE" + dtparam + ":" + (ev-ical-join (map fmt (get event :exdate)) ",")))) + (when + (and + (not (nil? (get event :rdate))) + (> (len (get event :rdate)) 0)) + (append! + lines + (str + "RDATE" + dtparam + ":" + (ev-ical-join (map fmt (get event :rdate)) ",")))) + (append! lines "END:VEVENT") + lines))))) -;; A full VCALENDAR (list of content lines) wrapping every event. +;; Collect the distinct timezones used by a list of events (by :name). +(define + ev-ical-distinct-tzs + (fn + (events) + (reduce + (fn + (acc ev) + (let + ((tz (get ev :tz))) + (if + (or (nil? tz) (ev-ical-tz-seen? acc (get tz :name))) + acc + (append acc (list tz))))) + (list) + events))) + +(define + ev-ical-tz-seen? + (fn + (tzs name) + (cond + ((empty? tzs) false) + ((= (get (first tzs) :name) name) true) + (else (ev-ical-tz-seen? (rest tzs) name))))) + +;; A full VCALENDAR (list of content lines): a VTIMEZONE block for each distinct +;; zone the events reference, then every VEVENT. (define ev/events->ical-lines (fn @@ -195,6 +314,11 @@ (let ((lines (list "BEGIN:VCALENDAR" "VERSION:2.0" "PRODID:-//rose-ash//events-on-sx//EN"))) (begin + (for-each + (fn + (tz) + (for-each (fn (l) (append! lines l)) (ev-ical-vtimezone tz))) + (ev-ical-distinct-tzs events)) (for-each (fn (ev) @@ -323,7 +447,8 @@ (when (> (len kv) 1) (let - ((k (first kv)) (v (first (rest kv)))) + ;; strip any property parameters (e.g. ";TZID=...") from the key + ((k (first (split (first kv) ";"))) (v (first (rest kv)))) (cond ((= k "UID") (dict-set! ev :id (string->symbol v))) ((= k "DTSTART") (dict-set! ev :dtstart (ev-ical-parse-dt v))) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 34607098..7a46ffe2 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,12 +1,12 @@ { "lang": "events", - "total_passed": 366, + "total_passed": 376, "total_failed": 0, - "total": 366, + "total": 376, "suites": [ {"name":"calendar","passed":51,"failed":0,"total":51}, {"name":"timezone","passed":17,"failed":0,"total":17}, - {"name":"ical","passed":46,"failed":0,"total":46}, + {"name":"ical","passed":56,"failed":0,"total":56}, {"name":"availability","passed":22,"failed":0,"total":22}, {"name":"api","passed":41,"failed":0,"total":41}, {"name":"booking","passed":82,"failed":0,"total":82}, @@ -17,5 +17,5 @@ {"name":"federation","passed":29,"failed":0,"total":29}, {"name":"integration","passed":8,"failed":0,"total":8} ], - "generated": "2026-06-07T18:33:58+00:00" + "generated": "2026-06-07T20:02:48+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 151f581e..f00748eb 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,12 +1,12 @@ # events scoreboard -**366 / 366 passing** (0 failure(s)). +**376 / 376 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | calendar | 51 | 51 | ok | | timezone | 17 | 17 | ok | -| ical | 46 | 46 | ok | +| ical | 56 | 56 | ok | | availability | 22 | 22 | ok | | api | 41 | 41 | ok | | booking | 82 | 82 | ok | diff --git a/lib/events/tests/ical.sx b/lib/events/tests/ical.sx index f0c693a2..e12e3135 100644 --- a/lib/events/tests/ical.sx +++ b/lib/events/tests/ical.sx @@ -266,47 +266,112 @@ (ev-ic-starts (first events)) (ev-ic-starts (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1))))))))) -;; ---- timezone-aware export (local wall-clock -> UTC stamps) ---- +;; ---- timezone-aware export (TZID + VTIMEZONE) ---- (define - ev-ic-dtstart - (fn (ev) (ev-ic-line (ev/event->ical-lines ev) "DTSTART"))) + ev-ic-find + (fn + (lines pfx) + (cond + ((empty? lines) nil) + ((ev-ic-prefix? (first lines) pfx) (first lines)) + (else (ev-ic-find (rest lines) pfx))))) + +(define ev-ic-count (fn (lines x) (len (filter (fn (l) (= l x)) lines)))) + +(define + ev-ic-index + (fn + (lines x) + (cond + ((empty? lines) -1) + ((= (first lines) x) 0) + (else + (let ((r (ev-ic-index (rest lines) x))) (if (< r 0) -1 (+ 1 r))))))) (define ev-ic-tz-run-all! (fn () (do + ;; a tz event's DTSTART is local wall-clock with a TZID parameter (ev-ic-check! - "London winter event exports as the same UTC (GMT)" - (ev-ic-dtstart (ev-event-tz (quote w) (ev-dt 2026 1 15 18 0) 60 nil 1 ev-tz-london)) - "DTSTART:20260115T180000Z") + "tz event DTSTART uses TZID + local wall-clock (not UTC)" + (ev-ic-find (ev/event->ical-lines (ev-event-tz (quote w) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london)) "DTSTART") + "DTSTART;TZID=Europe/London:20260715T180000") (ev-ic-check! - "London summer event exports one hour earlier in UTC (BST)" - (ev-ic-dtstart (ev-event-tz (quote s) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london)) - "DTSTART:20260715T170000Z") - (ev-ic-check! - "Paris winter (CET +1) exports one hour earlier in UTC" - (ev-ic-dtstart (ev-event-tz (quote p) (ev-dt 2026 1 15 18 0) 60 nil 1 ev-tz-paris)) - "DTSTART:20260115T170000Z") - (ev-ic-check! - "Paris summer (CEST +2) exports two hours earlier in UTC" - (ev-ic-dtstart (ev-event-tz (quote p) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-paris)) - "DTSTART:20260715T160000Z") - (ev-ic-check! - "a non-tz event is exported unchanged" - (ev-ic-dtstart (ev-event (quote n) (ev-dt 2026 7 15 18 0) 60 nil 1)) + "a non-tz event still uses a UTC Z stamp" + (ev-ic-find (ev/event->ical-lines (ev-event (quote n) (ev-dt 2026 7 15 18 0) 60 nil 1)) "DTSTART") "DTSTART:20260715T180000Z") - ;; EXDATE on a tz event is also converted to UTC + ;; UNTIL stays UTC even for a TZID event (RFC 5545) (ev-ic-check! - "tz event EXDATE is converted to UTC" - (ev-ic-line + "tz event RRULE UNTIL is still UTC" + (ev-ic-find + (ev/event->ical-lines + (ev-event-tz (quote s) (ev-dt 2026 6 1 18 0) 60 {:freq :weekly :byday (list 0) :until (ev-dt 2026 6 30 23 0)} 1 ev-tz-london)) + "RRULE") + "RRULE:FREQ=WEEKLY;UNTIL=20260630T220000Z;BYDAY=MO") + ;; EXDATE matches the DTSTART form (TZID + local) + (ev-ic-check! + "tz event EXDATE uses TZID + local" + (ev-ic-find (ev/event->ical-lines (assoc (ev-event-tz (quote s) (ev-dt 2026 7 1 18 0) 60 {:freq :daily :count 3} 1 ev-tz-london) :exdate (list (ev-dt 2026 7 2 18 0)))) "EXDATE") - "EXDATE:20260702T170000Z")))) + "EXDATE;TZID=Europe/London:20260702T180000") + + ;; ---- VTIMEZONE block ---- + (let + ((vtz (ev-ical-vtimezone ev-tz-london))) + (do + (ev-ic-check! "VTIMEZONE names the zone" (ev-ic-find vtz "TZID") "TZID:Europe/London") + (ev-ic-check! "DAYLIGHT transitions GMT->BST" (ev-ic-find vtz "TZOFFSETTO:+0100") "TZOFFSETTO:+0100") + (ev-ic-check! "DAYLIGHT rule is last Sunday of March" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=3") "RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU") + (ev-ic-check! "STANDARD rule is last Sunday of October" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=10") "RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU"))) + (let + ((vtz (ev-ical-vtimezone ev-tz-paris))) + (do + (ev-ic-check! "Paris DAYLIGHT goes to +0200 (CEST)" (ev-ic-find vtz "TZOFFSETTO:+0200") "TZOFFSETTO:+0200") + (ev-ic-check! "Paris STANDARD goes to +0100 (CET)" (ev-ic-find vtz "TZOFFSETTO:+0100") "TZOFFSETTO:+0100"))) + + ;; ---- VCALENDAR carries one VTIMEZONE per distinct zone ---- + (let + ((cal (ev/events->ical-lines (list (ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london))))) + (do + (ev-ic-check! "VCALENDAR includes the referenced VTIMEZONE" (ev-ic-count cal "BEGIN:VTIMEZONE") 1) + (ev-ic-check! "VTIMEZONE precedes the VEVENT" (< (ev-ic-index cal "BEGIN:VTIMEZONE") (ev-ic-index cal "BEGIN:VEVENT")) true))) + (ev-ic-check! + "two events in the same zone share one VTIMEZONE" + (ev-ic-count + (ev/events->ical-lines + (list + (ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london) + (ev-event-tz (quote b) (ev-dt 2026 6 2 9 0) 60 nil 1 ev-tz-london))) + "BEGIN:VTIMEZONE") + 1) + (ev-ic-check! + "events in two zones get two VTIMEZONEs" + (ev-ic-count + (ev/events->ical-lines + (list + (ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london) + (ev-event-tz (quote b) (ev-dt 2026 6 2 9 0) 60 nil 1 ev-tz-paris))) + "BEGIN:VTIMEZONE") + 2) + (ev-ic-check! + "a non-tz-only calendar has no VTIMEZONE" + (ev-ic-count (ev/events->ical-lines (list (ev-event (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1))) "BEGIN:VTIMEZONE") + 0) + + ;; ---- import tolerates the TZID parameter ---- + (ev-ic-check! + "import parses DTSTART;TZID local time" + (get + (ev/ical-lines->event (ev/event->ical-lines (ev-event-tz (quote a) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london))) + :dtstart) + (ev-dt 2026 7 15 18 0))))) (define ev-ical-tests-run! diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index cd4eaa7e..f06b2cf8 100644 --- a/plans/events-on-sx.md +++ b/plans/events-on-sx.md @@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher ## Status (rolling) -`bash lib/events/conformance.sh` → **366/366** (Phases 1-4 + 13 ext + tz-aware iCal export fix) +`bash lib/events/conformance.sh` → **376/376** (Phases 1-4 + 13 ext + tz iCal export via TZID + VTIMEZONE) ## Ground rules @@ -88,6 +88,15 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — VTIMEZONE iCal export (supersedes the UTC-Z tz fix — full DST + fidelity). A tz event now exports DTSTART;TZID=: (+ EXDATE/RDATE + in the same TZID-local form; UNTIL stays UTC per RFC), and the VCALENDAR emits + a VTIMEZONE per distinct zone with DAYLIGHT/STANDARD sub-components generated + from the zone's transition rules (offsets + FREQ=YEARLY;BYMONTH;BYDAY) — the + London/Paris blocks match real-world definitions exactly. So a client recurs + the event at a fixed WALL-CLOCK time, DST-correct (the prior caveat is gone). + `ev-ical-vtimezone`, `ev-ical-offset`, distinct-zone collection; importer now + tolerates the ;TZID= parameter. +16 tests (ical 56), 376/376 green. - 2026-06-07 — Fix: timezone-aware iCal export. Bug — tz events store wall-clock LOCAL times, but export stamped them with a `Z` (UTC) suffix, so a London 18:00 event falsely read as 18:00 UTC. `ev-ical-conv` now converts a tz