summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/render/emit_ics.ml67
-rw-r--r--lib/render/emit_ics.mli15
-rw-r--r--test/test_colitur.ml3
-rw-r--r--test/test_ics.ml100
4 files changed, 184 insertions, 1 deletions
diff --git a/lib/render/emit_ics.ml b/lib/render/emit_ics.ml
new file mode 100644
index 0000000..e1a5ad0
--- /dev/null
+++ b/lib/render/emit_ics.ml
@@ -0,0 +1,67 @@
+(* emit_ics.ml *)
+module T = Template
+
+let get v k = match v with T.Obj kvs -> List.assoc_opt k kvs | _ -> None
+let s v k = match get v k with Some (T.Str x) -> x | _ -> ""
+
+let compact iso = (* "2027-01-13" -> "20270113" *)
+ String.concat "" (String.split_on_char '-' iso)
+
+(* Civil-date successor without touching the kernel: parse, add, re-format via
+ Colitur_kernel.Date, which is already total and validated over 1583..9999. *)
+let next_day iso =
+ match Colitur_kernel.Date.of_iso8601 iso with
+ | Ok d -> Colitur_kernel.Date.to_iso8601 (Colitur_kernel.Date.add_days d 1)
+ | Error _ -> iso
+
+let esc x = Escape.apply Escape.Ics x
+let line b l = Buffer.add_string b (Escape.fold_ics l)
+
+let event b ~rite ~dtstamp d =
+ let iso = s d "iso" in
+ if iso <> "" then begin
+ let name =
+ match get d "name" with
+ | Some (T.Obj kvs) -> (
+ match List.assoc_opt "en" kvs with
+ | Some (T.Str x) when x <> "" -> x
+ | _ -> ( match List.assoc_opt "la" kvs with Some (T.Str x) -> x | _ -> s d "slug"))
+ | _ -> s d "slug"
+ in
+ let summary = Printf.sprintf "%s (%s, %s)" name (s d "rank") (s d "colour") in
+ let desc =
+ String.concat "\n"
+ (List.filter (fun x -> x <> "")
+ [ (if s d "first" <> "" then "Epistle " ^ s d "first" else "");
+ (if s d "gospel" <> "" then "Gospel " ^ s d "gospel" else "") ])
+ in
+ line b "BEGIN:VEVENT";
+ (* RFC 5545 section 3.8.4.7: the UID must be stable across regenerations,
+ or every subscriber gets a duplicate of the whole year. *)
+ line b (Printf.sprintf "UID:%s-%s@colitur" (compact iso) rite);
+ line b ("DTSTAMP:" ^ dtstamp);
+ line b ("DTSTART;VALUE=DATE:" ^ compact iso);
+ (* RFC 5545 section 3.6.1: DTEND is EXCLUSIVE for an all-day event. *)
+ line b ("DTEND;VALUE=DATE:" ^ compact (next_day iso));
+ line b ("SUMMARY:" ^ esc summary);
+ if desc <> "" then line b ("DESCRIPTION:" ^ esc desc);
+ line b "TRANSP:TRANSPARENT";
+ line b "END:VEVENT"
+ end
+
+let year ?dtstamp ?calname v =
+ let rite = s v "rite" in
+ let y = s v "year" in
+ let dtstamp = match dtstamp with Some x -> x | None -> y ^ "0101T000000Z" in
+ let calname = match calname with Some x -> x | None -> "colitur " ^ rite ^ " " ^ y in
+ let b = Buffer.create (256 * 1024) in
+ line b "BEGIN:VCALENDAR";
+ line b "VERSION:2.0";
+ line b "PRODID:-//colitur//liturgical calendar//EN";
+ line b "CALSCALE:GREGORIAN";
+ line b "METHOD:PUBLISH";
+ (* Non-standard but universally honoured; without it clients show the URL. *)
+ line b ("X-WR-CALNAME:" ^ esc calname);
+ (match get v "days" with Some (T.List l) -> List.iter (event b ~rite ~dtstamp) l | _ -> ());
+ line b "END:VCALENDAR";
+ Buffer.contents b
diff --git a/lib/render/emit_ics.mli b/lib/render/emit_ics.mli
new file mode 100644
index 0000000..270bd76
--- /dev/null
+++ b/lib/render/emit_ics.mli
@@ -0,0 +1,15 @@
+(* emit_ics.mli *)
+(** RFC 5545 iCalendar. NOT a template job: folding, escaping, exclusive DTEND
+ and stable UIDs are rules a logic-less template cannot enforce, and getting
+ any of them wrong produces a feed that fails silently in a subscriber's
+ client (spec section 6). *)
+
+(** [year ?dtstamp ?calname view].
+
+ [dtstamp] defaults to [YYYY0101T000000Z] for the view's own year. It is a
+ PARAMETER, never a clock read: RFC 5545 requires DTSTAMP, the obvious
+ implementation reads the wall clock, and that would both violate the
+ kernel's determinism rule and make two feeds from identical data differ
+ byte-for-byte -- defeating reproducible builds and a reviewable git diff on
+ a published tree. Same data in, same bytes out. *)
+val year : ?dtstamp:string -> ?calname:string -> Template.value -> string
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index ca61415..d4ba6d3 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -12,4 +12,5 @@ let () =
Test_template.render_suite;
Test_view.suite;
Test_emit.suite;
- Test_emit.xml_suite ]
+ Test_emit.xml_suite;
+ Test_ics.suite ]
diff --git a/test/test_ics.ml b/test/test_ics.ml
new file mode 100644
index 0000000..ac0c9ee
--- /dev/null
+++ b/test/test_ics.ml
@@ -0,0 +1,100 @@
+module Ics = Colitur_render.Emit_ics
+
+let out_2027 () = Ics.year (Test_view.view_of 2027)
+
+let lines s =
+ String.split_on_char '\n' s
+ |> List.map (fun l -> if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l)
+ |> List.filter (fun l -> l <> "")
+
+let count_prefix p ls =
+ List.length (List.filter (fun l -> String.length l >= String.length p && String.sub l 0 (String.length p) = p) ls)
+
+let test_envelope () =
+ let ls = lines (out_2027 ()) in
+ Alcotest.(check string) "first line" "BEGIN:VCALENDAR" (List.hd ls);
+ Alcotest.(check string) "last line" "END:VCALENDAR" (List.nth ls (List.length ls - 1));
+ Alcotest.(check int) "version" 1 (count_prefix "VERSION:2.0" ls);
+ Alcotest.(check int) "prodid" 1 (count_prefix "PRODID:" ls);
+ Alcotest.(check int) "365 events" 365 (count_prefix "BEGIN:VEVENT" ls)
+
+(* RFC 5545 section 3.6.1: for an all-day event DTEND is EXCLUSIVE. Getting
+ this wrong shows every event a day short in every client. *)
+let test_dtend_is_exclusive () =
+ let ls = lines (out_2027 ()) in
+ let starts = List.filter_map (fun l ->
+ if count_prefix "DTSTART;VALUE=DATE:" [l] = 1 then
+ Some (String.sub l (String.length "DTSTART;VALUE=DATE:") 8) else None) ls in
+ let ends = List.filter_map (fun l ->
+ if count_prefix "DTEND;VALUE=DATE:" [l] = 1 then
+ Some (String.sub l (String.length "DTEND;VALUE=DATE:") 8) else None) ls in
+ Alcotest.(check int) "same count" (List.length starts) (List.length ends);
+ Alcotest.(check string) "1 Jan starts" "20270101" (List.hd starts);
+ Alcotest.(check string) "1 Jan ends on the 2nd" "20270102" (List.hd ends);
+ Alcotest.(check string) "31 Dec ends on 1 Jan next" "20280101"
+ (List.nth ends (List.length ends - 1))
+
+let test_uids_unique_and_shaped () =
+ let ls = lines (out_2027 ()) in
+ let uids = List.filter_map (fun l ->
+ if count_prefix "UID:" [l] = 1 then Some (String.sub l 4 (String.length l - 4)) else None) ls in
+ Alcotest.(check int) "365 uids" 365 (List.length uids);
+ let sorted = List.sort_uniq String.compare uids in
+ Alcotest.(check int) "all unique" 365 (List.length sorted);
+ Alcotest.(check string) "shape" "20270101-ef@colitur" (List.hd uids)
+
+(* The rule that punishes silently, months later, in someone else's phone:
+ regenerating a feed must not duplicate every event. *)
+let test_output_is_byte_stable_across_runs () =
+ Alcotest.(check string) "two runs identical" (out_2027 ()) (out_2027 ())
+
+let test_every_line_folded_and_crlf () =
+ let raw = out_2027 () in
+ List.iter
+ (fun l ->
+ if String.length l > 75 then Alcotest.failf "line of %d octets: %s" (String.length l) l)
+ (lines raw);
+ (* Every physical line ends CRLF (RFC 5545 section 3.1). *)
+ let n = String.length raw in
+ let rec check i =
+ if i >= n then ()
+ else if raw.[i] = '\n' then (
+ if i = 0 || raw.[i - 1] <> '\r' then Alcotest.failf "bare LF at offset %d" i;
+ check (i + 1))
+ else check (i + 1)
+ in
+ check 0
+
+let test_no_rrule () =
+ Alcotest.(check int) "no RRULE" 0 (count_prefix "RRULE" (lines (out_2027 ())))
+
+let test_text_escaped () =
+ let ls = lines (Ics.year (Test_view.view_of 2035)) in
+ (* 2035-04-03 is St Joseph, whose English name contains a comma. *)
+ let joseph = List.find (fun l -> count_prefix "SUMMARY:St. Joseph" [l] = 1) ls in
+ Alcotest.(check bool) "comma escaped" true
+ (let re = "\\," in
+ let n = String.length re in
+ let rec f i = i + n <= String.length joseph && (String.sub joseph i n = re || f (i + 1)) in
+ f 0)
+
+let test_dtstamp_is_a_parameter () =
+ let a = Ics.year ~dtstamp:"20200101T000000Z" (Test_view.view_of 2027) in
+ let b = Ics.year ~dtstamp:"20210101T000000Z" (Test_view.view_of 2027) in
+ Alcotest.(check bool) "differs with the parameter" true (a <> b);
+ (* DTSTAMP is a per-VEVENT property (RFC 5545 section 3.8.7.2), not a
+ calendar-level one -- every one of the 365 events carries the same
+ default value, not just one line in the whole feed. *)
+ Alcotest.(check int) "default is deterministic" 365
+ (count_prefix "DTSTAMP:20270101T000000Z" (lines (out_2027 ())))
+
+let suite =
+ ( "Emit/ics",
+ [ Alcotest.test_case "envelope" `Quick test_envelope;
+ Alcotest.test_case "DTEND exclusive" `Quick test_dtend_is_exclusive;
+ Alcotest.test_case "uids unique and shaped" `Quick test_uids_unique_and_shaped;
+ Alcotest.test_case "byte-stable across runs" `Quick test_output_is_byte_stable_across_runs;
+ Alcotest.test_case "folded and CRLF" `Quick test_every_line_folded_and_crlf;
+ Alcotest.test_case "no RRULE" `Quick test_no_rrule;
+ Alcotest.test_case "text escaped" `Quick test_text_escaped;
+ Alcotest.test_case "DTSTAMP is a parameter" `Quick test_dtstamp_is_a_parameter ] )
generated by cgit v1.3 (git 2.53.0) at 2026-09-19 12:10:47 +0000