dasemu/Synapse
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fase B7: CalDAV/CardDAV sync with Nextcloud, and a Calendar view type

Browse Source 
- New built-in classes Event and Contact (schema 65.37), plus a
  Calendar View view type alongside table/list/gallery, backed by a new
  fixed month-grid calendar-view component in components/views.cljs
  reusing the existing scheduled/deadline properties.
- New worker/handler/caldav.cljs: a deliberately-scoped CalDAV
  (VEVENT/VTODO) + CardDAV (VCARD) client against a single Nextcloud
  calendar/addressbook collection, with its own minimal iCalendar/vCard
  encoder-decoder and namespace-agnostic multistatus XML extraction
  (no external ical/rrule/xml dependency exists in this project).
- RRULE <-> :logseq.property.repeat/* translation covers only the
  `plus` (advance-from-scheduled) repeat mode with a bare FREQ(;INTERVAL)
  rule -- dotted-plus/double-plus and anything with BYDAY/COUNT/UNTIL
  are left untranslated on purpose rather than mistranslated.
- Credentials live in the platform keychain (save-secret-text!), never
  in the graph. Sync runs Node-only, every 15 minutes per open repo,
  started/stopped alongside the repo's lifecycle in db_core.cljs.
  Conflicts are last-write-wins via ETag: a 412 on push is skipped and
  retried after the next pull refreshes the stored ETag.
This commit is contained in:
Darío Sevilla
2026-08-26 21:11:00 +02:00
parent dadeca7165
commit 0158430489
12 changed files with 896 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
deps/db/src/logseq/db/frontend/class.cljs vendored
View File

@@ -115,6 +115,25 @@
{:title "Area"
:properties {:logseq.property.class/extends :logseq.class/Page}}
;; :logseq.property/scheduled and :logseq.property/deadline (the actual
;; event start/end) are pre-existing baseline properties, not declared
;; here in :schema :properties -- a migrated-in class can only resolve
;; :schema :properties against properties added in that SAME migration
;; step (see `build-initial-classes*`), so a page can still be tagged
;; Event and given scheduled/deadline like any other public property.
:logseq.class/Event
{:title "Event"
:properties {:logseq.property.class/extends :logseq.class/Page
:logseq.property/icon {:type :tabler-icon :id "calendar-event"}}
:schema {:properties [:logseq.property.event/location]}}
:logseq.class/Contact
{:title "Contact"
:properties {:logseq.property.class/extends :logseq.class/Page
:logseq.property/icon {:type :tabler-icon :id "user"}}
:schema {:properties [:logseq.property.contact/email :logseq.property.contact/phone
:logseq.property.contact/organization]}}
;; TODO: Add more classes such as :book, :paper, :movie, :music)
)))

33
deps/db/src/logseq/db/frontend/property.cljs vendored
View File

@@ -422,6 +422,36 @@
;; TODO: Add more props :Estimate, :Cycle, :Project
:logseq.property.event/location {:title "Location"
:schema {:type :string
:public? true}
:queryable? true}
:logseq.property.contact/email {:title "Email"
:schema {:type :string
:public? true}
:queryable? true}
:logseq.property.contact/phone {:title "Phone"
:schema {:type :string
:public? true}
:queryable? true}
:logseq.property.contact/organization {:title "Organization"
:schema {:type :string
:public? true}
:queryable? true}
;; CalDAV/CardDAV sync bookkeeping, not user-facing
:logseq.property.caldav/uid {:title "CalDAV UID"
:schema {:type :string
:hide? true
:public? false}}
:logseq.property.caldav/href {:title "CalDAV Href"
:schema {:type :string
:hide? true
:public? false}}
:logseq.property.caldav/etag {:title "CalDAV ETag"
:schema {:type :string
:hide? true
:public? false}}
:logseq.property/icon {:title "Icon"
:schema {:type :map}}
:logseq.property/publishing-public? {:title "Publishing Public?"
@@ -455,7 +485,8 @@
:icon {:type :tabler-icon :id icon}})
[[:logseq.property.view/type.table "Table View" "table"]
[:logseq.property.view/type.list "List View" "list"]
[:logseq.property.view/type.gallery "Gallery View" "layout-grid"]])
[:logseq.property.view/type.gallery "Gallery View" "layout-grid"]
[:logseq.property.view/type.calendar "Calendar View" "calendar"]])
:properties {:logseq.property/default-value :logseq.property.view/type.table}
:queryable? true}

2
deps/db/src/logseq/db/frontend/schema.cljs vendored
View File

@@ -30,7 +30,7 @@
(map (juxt :major :minor)
[(parse-schema-version x) (parse-schema-version y)])))
(def version (parse-schema-version "65.36"))
(def version (parse-schema-version "65.37"))
(defn major-version
"Return a number.

12
deps/db/test/logseq/db/frontend/class_test.cljs vendored
View File

@@ -16,6 +16,18 @@
(is (not (contains? db-class/private-tags :logseq.class/Project)))
(is (not (contains? db-class/private-tags :logseq.class/Area)))))
(deftest event-and-contact-are-built-in-page-classes
(testing "Event and Contact are registered as built-in classes that behave like pages"
(is (contains? db-class/built-in-classes :logseq.class/Event))
(is (contains? db-class/built-in-classes :logseq.class/Contact))
(is (contains? db-class/page-children-classes :logseq.class/Event))
(is (contains? db-class/page-children-classes :logseq.class/Contact))
(is (not (contains? db-class/private-tags :logseq.class/Event)))
(is (not (contains? db-class/private-tags :logseq.class/Contact))))
(testing "Event's schema properties only reference properties migrated in the same step"
(is (= [:logseq.property.event/location]
(get-in db-class/built-in-classes [:logseq.class/Event :schema :properties])))))
(deftest get-class-objects-dedupes-inherited-tags-test
(let [conn (db-test/create-conn-with-blocks
{:classes {:Parent {:block/title "Parent"}

20
src/main/frontend/components/block/views.css
View File

@@ -241,3 +241,23 @@
}
}
}
.ls-calendar-grid {
@apply grid grid-cols-7 gap-px rounded-md border border-border bg-border overflow-hidden;
}
.ls-calendar-day {
@apply flex flex-col gap-1 bg-background p-1 min-h-[80px];
}
.ls-calendar-day-number {
@apply text-xs text-muted-foreground;
}
.ls-calendar-day-items {
@apply flex flex-col gap-0.5;
}
.ls-calendar-day-item {
@apply text-xs truncate rounded bg-secondary px-1 py-0.5;
}

54
src/main/frontend/components/views.cljs
View File

@@ -2342,6 +2342,57 @@
:outliner? false
:view-parent (:logseq.property/view-for (:view-entity table))}))])))
(defn- calendar-row-date-ms
"The date a row sits on in the calendar: whichever of scheduled/deadline is set."
[row]
(or (:logseq.property/scheduled row) (:logseq.property/deadline row)))
(defn- calendar-month-bounds
[cursor]
(let [month-start (t/first-day-of-the-month cursor)
month-end (t/plus month-start (t/months 1))]
[(tc/to-long month-start) (tc/to-long month-end)]))
(hsx/defc calendar-view
[_option _table _view-entity blocks]
(let [[cursor set-cursor!] (hooks/use-state #(t/today))
[start-ms end-ms] (calendar-month-bounds cursor)
days-in-month (t/number-of-days-in-the-month cursor)
page-cp (state/get-component :block/page-cp)
by-day (->> blocks
(keep (fn [row]
(when-let [ms (calendar-row-date-ms row)]
(when (and (>= ms start-ms) (< ms end-ms))
[(tf/unparse yyyy-MM-dd-formatter (tc/from-long ms)) row]))))
(reduce (fn [m [k row]] (update m k (fnil conj []) row)) {}))]
[:div.ls-calendar-view
[:div.flex.items-center.justify-between.mb-2
[:div.font-medium (tf/unparse (tf/formatter "MMMM yyyy") cursor)]
[:div.flex.gap-1
(shui/button {:variant "ghost" :size :sm
:on-click #(set-cursor! (t/minus cursor (t/months 1)))}
(ui/icon "chevron-left"))
(shui/button {:variant "ghost" :size :sm :on-click #(set-cursor! (t/today))}
(t :calendar/today))
(shui/button {:variant "ghost" :size :sm
:on-click #(set-cursor! (t/plus cursor (t/months 1)))}
(ui/icon "chevron-right"))]]
[:div.ls-calendar-grid
(for [day (range 1 (inc days-in-month))]
(let [d (t/date-time (t/year cursor) (t/month cursor) day)
k (tf/unparse yyyy-MM-dd-formatter d)
rows (get by-day k)]
^{:key k}
[:div.ls-calendar-day
[:div.ls-calendar-day-number (str day)]
[:div.ls-calendar-day-items
(for [row rows]
^{:key (str (:block/uuid row))}
[:div.ls-calendar-day-item
(if (fn? page-cp)
(page-cp {:disable-preview? true} row)
(:block/title row))])]]))]]))
(hsx/defc gallery-view
[{:keys [config view-parent view-feature-type] :as option} table view-entity blocks _row-selection *scroller-ref]
(let [config' (assoc config :container-id (view-container-id config))
@@ -2571,6 +2622,9 @@
:logseq.property.view/type.gallery
(gallery-view option table view-entity (:rows table) row-selection *scroller-ref)
:logseq.property.view/type.calendar
(calendar-view option table view-entity (:rows table))
(table-view table option row-selection *scroller-ref))]))
(defn- view-with-display-type

28
src/main/frontend/worker/db/migrate.cljs
View File

@@ -7,10 +7,12 @@
[frontend.worker-common.util :as worker-util]
[logseq.common.config :as common-config]
[logseq.common.util :as common-util]
[logseq.common.uuid :as common-uuid]
[logseq.db :as ldb]
[logseq.db.common.delete-blocks :as delete-blocks]
[logseq.db.frontend.class :as db-class]
[logseq.db.frontend.property :as db-property]
[logseq.db.frontend.property.build :as db-property-build]
[logseq.db.frontend.schema :as db-schema]
[logseq.db.sqlite.create-graph :as sqlite-create-graph]
[logseq.db.sqlite.util :as sqlite-util]
@@ -132,6 +134,21 @@
[[:db/add (:db/id a) :logseq.property.journal/next (:db/id b)]
[:db/add (:db/id b) :logseq.property.journal/previous (:db/id a)]])))))
(defn- add-calendar-view-type-closed-value
"Backfill the new `calendar` closed value onto the existing
:logseq.property.view/type property (its own migration ran in an earlier
version, so it won't pick up newly-added closed values on its own)."
[db]
(when (and (d/entity db :logseq.property.view/type)
(not (d/entity db :logseq.property.view/type.calendar)))
[(db-property-build/build-closed-value-block
(common-uuid/gen-uuid :db-ident-block-uuid :logseq.property.view/type.calendar)
:default
"Calendar View"
{:db/ident :logseq.property.view/type}
{:db-ident :logseq.property.view/type.calendar
:icon {:type :tabler-icon :id "calendar"}})]))
(def schema-version->updates
"A vec of tuples defining datascript migrations. Each tuple consists of the
schema version integer and a migration map. A migration map can have keys of :properties, :classes
@@ -179,7 +196,16 @@
:fix link-existing-journals}]
["65.35" {:classes [:logseq.class/Project :logseq.class/Area]}]
["65.36" {:classes [:logseq.class/Citation]
:properties [:logseq.property.citation/target :logseq.property.citation/context]}]])
:properties [:logseq.property.citation/target :logseq.property.citation/context]}]
["65.37" {:classes [:logseq.class/Event :logseq.class/Contact]
:properties [:logseq.property.event/location
:logseq.property.contact/email
:logseq.property.contact/phone
:logseq.property.contact/organization
:logseq.property.caldav/uid
:logseq.property.caldav/href
:logseq.property.caldav/etag]
:fix add-calendar-view-type-closed-value}]])
(let [[major minor] (last (sort (map (comp (juxt :major :minor) db-schema/parse-schema-version first)
schema-version->updates)))]

4
src/main/frontend/worker/db_core.cljs
View File

@@ -12,6 +12,7 @@
[frontend.worker.db.fix :as db-fix]
[frontend.worker.db.migrate :as db-migrate]
[frontend.worker.db.validate :as worker-db-validate]
[frontend.worker.handler.caldav :as caldav-handler]
[frontend.worker.handler.cli]
[frontend.worker.handler.comments]
[frontend.worker.handler.export]
@@ -364,6 +365,7 @@
(when-let [timer (get @*client-ops-cleanup-timers repo)]
(js/clearInterval timer))
(swap! *client-ops-cleanup-timers dissoc repo)
(caldav-handler/stop-sync! repo)
(swap! *sqlite-conns dissoc repo)
(when-let [vector-index (worker-state/get-vector-index repo)]
(when-let [close-fn (:close! vector-index)]
@@ -648,6 +650,8 @@
(db-listener/listen-db-changes! repo conn)
(caldav-handler/maybe-start-sync! repo)
nil))))))

576
src/main/frontend/worker/handler/caldav.cljs Normal file
View File

@@ -0,0 +1,576 @@
(ns frontend.worker.handler.caldav
"Nextcloud CalDAV (events, tasks) and CardDAV (contacts) sync.
Deliberately scoped, not a full RFC 4791/6352 client:
* one calendar collection + one addressbook collection per graph
* basic auth (Nextcloud app password), no OAuth
* VEVENT/VTODO/VCARD only, no VALARM/VTIMEZONE/recurrence overrides
* dates are read/written in UTC only
* RRULE support covers a single FREQ=DAILY|WEEKLY|MONTHLY|YEARLY(;INTERVAL=n)
rule, matching only the `plus` (advance-from-scheduled) repeat mode --
`dotted-plus` (advance-from-completion) and `double-plus` (skip-to-future)
depend on runtime state RRULE can't express, so those tasks are pushed
without a recurrence rule and incoming events always come back as `plus`.
* conflict handling is last-write-wins via ETag: a 412 on push is skipped
for that cycle and naturally retried after the next pull refreshes the
stored ETag -- there is no merge UI."
(:require [clojure.string :as string]
[datascript.core :as d]
[frontend.common.thread-api :refer [def-thread-api]]
[frontend.worker.handler.page :as page-handler]
[frontend.worker.platform :as platform]
[frontend.worker.state :as worker-state]
[lambdaisland.glogi :as log]
[logseq.db :as ldb]
[promesa.core :as p]))
;; -----------------------------------------------------------------------
;; Credentials
;; -----------------------------------------------------------------------
(defn- credential-secret-key
[repo]
(str "caldav:" repo))
(defn <save-credentials!
[repo config]
(platform/save-secret-text! (platform/current) (credential-secret-key repo)
(js/JSON.stringify (clj->js config))))
(defn <read-credentials
[repo]
(p/let [text (platform/read-secret-text (platform/current) (credential-secret-key repo))]
(when text
(js->clj (js/JSON.parse text) :keywordize-keys true))))
(defn <delete-credentials!
[repo]
(platform/delete-secret-text! (platform/current) (credential-secret-key repo)))
;; -----------------------------------------------------------------------
;; RRULE <-> :logseq.property.repeat/* translation (pure)
;; -----------------------------------------------------------------------
(def ^:private recur-unit->rrule-freq
{:logseq.property.repeat/recur-unit.day "DAILY"
:logseq.property.repeat/recur-unit.week "WEEKLY"
:logseq.property.repeat/recur-unit.month "MONTHLY"
:logseq.property.repeat/recur-unit.year "YEARLY"})
(def ^:private rrule-freq->recur-unit
(into {} (map (fn [[k v]] [v k])) recur-unit->rrule-freq))
(defn repeat->rrule
"Only the `plus` (advance-from-scheduled) repeat type maps onto RRULE;
anything else (or an unsupported unit) returns nil, meaning: push this
task/event without a recurrence rule rather than mistranslate it."
[{:keys [repeat-type recur-unit recur-frequency]}]
(when (and (= repeat-type :logseq.property.repeat/repeat-type.plus)
(contains? recur-unit->rrule-freq recur-unit))
(let [freq (get recur-unit->rrule-freq recur-unit)
interval (or recur-frequency 1)]
(if (> interval 1)
(str "FREQ=" freq ";INTERVAL=" interval)
(str "FREQ=" freq)))))
(defn rrule->repeat
"Only a bare single FREQ (+ optional INTERVAL) is understood. Anything else
(BYDAY, COUNT, UNTIL, multiple rules...) returns nil so the caller leaves
the incoming event/task non-recurring instead of silently mistranslating it."
[rrule-value]
(when (string? rrule-value)
(let [parts (into {}
(keep (fn [part]
(let [[k v] (string/split part #"=" 2)]
(when (and k v) [k v]))))
(string/split rrule-value #";"))
freq (get parts "FREQ")]
(when (and freq
(contains? rrule-freq->recur-unit freq)
(every? #{"FREQ" "INTERVAL"} (keys parts)))
{:repeat-type :logseq.property.repeat/repeat-type.plus
:recur-unit (get rrule-freq->recur-unit freq)
:recur-frequency (some-> (get parts "INTERVAL") parse-long)}))))
;; -----------------------------------------------------------------------
;; iCalendar / vCard text encoding (pure)
;; -----------------------------------------------------------------------
(defn- ical-escape
[s]
(-> (str s)
(string/replace "\\" "\\\\")
(string/replace ";" "\\;")
(string/replace "," "\\,")
(string/replace "\n" "\\n")))
(defn- ical-unescape
[s]
(-> (str s)
(string/replace "\\n" "\n")
(string/replace "\\," ",")
(string/replace "\\;" ";")
(string/replace "\\\\" "\\")))
(defn- epoch-ms->ical-utc
[ms]
(when (number? ms)
(-> (js/Date. ms)
.toISOString
(string/replace #"[-:]" "")
(string/replace #"\.\d+Z$" "Z"))))
(defn- ical-utc->epoch-ms
"\"YYYYMMDDTHHMMSSZ\" -> epoch ms. Anything else (local time, dates without
a time component, non-UTC) is out of scope and returns nil."
[value]
(when (and (string? value) (re-matches #"\d{8}T\d{6}Z" value))
(let [y (subs value 0 4) mo (subs value 4 6) d (subs value 6 8)
h (subs value 9 11) mi (subs value 11 13) s (subs value 13 15)]
(.getTime (js/Date. (str y "-" mo "-" d "T" h ":" mi ":" s "Z"))))))
(defn- ical-lines
[& lines]
(->> lines flatten (remove nil?) (string/join "\r\n")))
(defn block->vevent
[{:keys [uid summary description location dtstart dtend rrule]}]
(ical-lines
"BEGIN:VCALENDAR" "VERSION:2.0" "PRODID:-//LogDarioSeq//EN"
"BEGIN:VEVENT"
(str "UID:" uid)
(str "SUMMARY:" (ical-escape summary))
(when dtstart (str "DTSTART:" (epoch-ms->ical-utc dtstart)))
(when dtend (str "DTEND:" (epoch-ms->ical-utc dtend)))
(when rrule (str "RRULE:" rrule))
(when description (str "DESCRIPTION:" (ical-escape description)))
(when location (str "LOCATION:" (ical-escape location)))
"END:VEVENT" "END:VCALENDAR"))
(def ^:private status->ical-vtodo-status
{:logseq.property/status.done "COMPLETED"
:logseq.property/status.canceled "CANCELLED"
:logseq.property/status.doing "IN-PROCESS"})
(defn block->vtodo
[{:keys [uid summary description dtstart due rrule status-ident]}]
(ical-lines
"BEGIN:VCALENDAR" "VERSION:2.0" "PRODID:-//LogDarioSeq//EN"
"BEGIN:VTODO"
(str "UID:" uid)
(str "SUMMARY:" (ical-escape summary))
(when dtstart (str "DTSTART:" (epoch-ms->ical-utc dtstart)))
(when due (str "DUE:" (epoch-ms->ical-utc due)))
(when rrule (str "RRULE:" rrule))
(str "STATUS:" (get status->ical-vtodo-status status-ident "NEEDS-ACTION"))
(when description (str "DESCRIPTION:" (ical-escape description)))
"END:VTODO" "END:VCALENDAR"))
(defn contact->vcard
[{:keys [uid full-name email phone organization]}]
(ical-lines
"BEGIN:VCARD" "VERSION:3.0"
(str "UID:" uid)
(str "FN:" (ical-escape full-name))
(when email (str "EMAIL:" email))
(when phone (str "TEL:" phone))
(when organization (str "ORG:" (ical-escape organization)))
"END:VCARD"))
(defn- unfold-ical-lines
[text]
(-> (str text)
(string/replace "\r\n" "\n")
(string/replace #"\n[ \t]" "")
(string/split #"\n")))
(def ^:private ical-line-re #"([A-Za-z0-9-]+)(;[^:]*)?:(.*)")
(defn parse-ical-component
"Parses the first VEVENT or VTODO in an iCalendar text blob into a flat map.
Deliberately minimal: understands only the property lines this namespace
itself writes, ignores VALARM/VTIMEZONE/any other component or parameter."
[text]
(let [lines (unfold-ical-lines text)
component-type (some #(second (re-matches #"BEGIN:(VEVENT|VTODO)" %)) lines)]
(when component-type
(reduce
(fn [m line]
(if-let [[_ k _params v] (re-matches ical-line-re line)]
(case k
"UID" (assoc m :uid v)
"SUMMARY" (assoc m :summary (ical-unescape v))
"DESCRIPTION" (assoc m :description (ical-unescape v))
"LOCATION" (assoc m :location (ical-unescape v))
"DTSTART" (assoc m :dtstart (ical-utc->epoch-ms v))
"DTEND" (assoc m :dtend (ical-utc->epoch-ms v))
"DUE" (assoc m :due (ical-utc->epoch-ms v))
"RRULE" (assoc m :rrule v)
"STATUS" (assoc m :status v)
m)
m))
{:type component-type}
lines))))
(defn parse-vcard
[text]
(let [lines (unfold-ical-lines text)]
(when (some #{"BEGIN:VCARD"} lines)
(reduce
(fn [m line]
(if-let [[_ k _params v] (re-matches ical-line-re line)]
(case k
"UID" (assoc m :uid v)
"FN" (assoc m :full-name (ical-unescape v))
"EMAIL" (assoc m :email v)
"TEL" (assoc m :phone v)
"ORG" (assoc m :organization (ical-unescape v))
m)
m))
{}
lines))))
;; -----------------------------------------------------------------------
;; Minimal multistatus XML extraction (pure, namespace-prefix agnostic)
;; -----------------------------------------------------------------------
(defn- xml-unescape
[s]
(-> (str s)
(string/replace #"&#x([0-9a-fA-F]+);" (fn [[_ hex]] (js/String.fromCharCode (js/parseInt hex 16))))
(string/replace #"&#(\d+);" (fn [[_ dec]] (js/String.fromCharCode (js/parseInt dec 10))))
(string/replace "&lt;" "<")
(string/replace "&gt;" ">")
(string/replace "&quot;" "\"")
(string/replace "&apos;" "'")
(string/replace "&amp;" "&")))
(defn- xml-tag-values
[tag xml]
(->> (re-seq (re-pattern (str "<(?:[A-Za-z0-9]+:)?" tag "[^>]*>([\\s\\S]*?)</(?:[A-Za-z0-9]+:)?" tag ">"))
xml)
(map (comp xml-unescape second))))
(defn parse-multistatus
"Extracts {:href :etag :data} per <response> in a CalDAV/CardDAV multistatus
body. `data-tag` is \"calendar-data\" or \"address-data\"."
[data-tag multistatus-xml]
(->> (xml-tag-values "response" multistatus-xml)
(keep (fn [response-xml]
(let [href (first (xml-tag-values "href" response-xml))
etag (first (xml-tag-values "getetag" response-xml))
data (first (xml-tag-values data-tag response-xml))]
(when (and href data)
{:href href :etag etag :data data}))))))
;; -----------------------------------------------------------------------
;; HTTP (Node runtime only; injectable fetch-fn for testing)
;; -----------------------------------------------------------------------
(defn- join-url
[base path]
(str (string/replace base #"/$" "") "/" (string/replace path #"^/" "")))
(defn- basic-auth-header
[{:keys [username app-password]}]
(str "Basic " (js/btoa (str username ":" app-password))))
(defn- <dav-request
[fetch-fn config path {:keys [method headers body]}]
(-> (fetch-fn (join-url (:base-url config) path)
(clj->js (merge {:method (or method "GET")
:headers (merge {"Authorization" (basic-auth-header config)}
headers)}
(when body {:body body}))))
(p/then (fn [resp]
(p/let [text (.text resp)]
{:status (.-status resp)
:etag (some-> (.-headers resp) (.get "ETag"))
:body text})))))
(def ^:private events-query-body
(ical-lines
"<?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/></d:prop>"
"<c:filter><c:comp-filter name=\"VCALENDAR\"><c:comp-filter name=\"VEVENT\"/></c:comp-filter></c:filter>"
"</c:calendar-query>"))
(def ^:private tasks-query-body
(ical-lines
"<?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/></d:prop>"
"<c:filter><c:comp-filter name=\"VCALENDAR\"><c:comp-filter name=\"VTODO\"/></c:comp-filter></c:filter>"
"</c:calendar-query>"))
(def ^:private contacts-query-body
(ical-lines
"<?xml version=\"1.0\" encoding=\"utf-8\"?>"
"<c:addressbook-query xmlns:d=\"DAV:\" xmlns:c=\"urn:ietf:params:xml:ns:carddav\">"
"<d:prop><d:getetag/><c:address-data/></d:prop>"
"</c:addressbook-query>"))
(defn- <report
[fetch-fn config path body data-tag]
(-> (<dav-request fetch-fn config path
{:method "REPORT"
:headers {"Content-Type" "application/xml; charset=utf-8" "Depth" "1"}
:body body})
(p/then (fn [{:keys [status body]}]
(if (#{207} status)
(parse-multistatus data-tag body)
(do (log/warn :caldav/report-failed {:path path :status status})
[]))))))
(defn- <put!
[fetch-fn config href text content-type etag]
(<dav-request fetch-fn config href
{:method "PUT"
:headers (cond-> {"Content-Type" content-type}
etag (assoc "If-Match" etag))
:body text}))
;; -----------------------------------------------------------------------
;; Pull: upsert graph pages from remote components
;; -----------------------------------------------------------------------
(defn- find-page-by-caldav-uid
[db uid]
(when-let [eid (d/q '[:find ?e . :in $ ?uid
:where [?e :logseq.property.caldav/uid ?uid]]
db uid)]
(d/entity db eid)))
(defn- clean-properties
[m]
(into {} (remove (comp nil? val)) m))
(defn- caldav-diff-value
"Compares a datascript entity's current attribute value against an incoming
value that may be a `[:db/ident kw]` lookup ref (closed-value properties
like status), unwrapping both sides to their ident before comparing."
[existing-val new-val]
(let [existing-ident (:db/ident existing-val)
new-ident (when (and (vector? new-val) (= :db/ident (first new-val)))
(second new-val))]
(if (or existing-ident new-ident)
(not= existing-ident new-ident)
(not= existing-val new-val))))
(defn- upsert-page!
[conn tag-ident title properties]
(let [db @conn
uid (:logseq.property.caldav/uid properties)
existing (find-page-by-caldav-uid db uid)]
(if existing
(let [tx (->> properties
(keep (fn [[k v]]
(when (caldav-diff-value (get existing k) v)
[:db/add (:db/id existing) k v]))))]
(when (seq tx) (ldb/transact! conn tx))
(:block/uuid existing))
(let [[_title page-uuid] (page-handler/create! conn title
{:tags [tag-ident]
:properties (clean-properties properties)})]
page-uuid))))
(defn- <pull-events!
[conn fetch-fn config]
(p/let [items (<report fetch-fn config (:calendar-path config) events-query-body "calendar-data")]
(doseq [{:keys [href etag data]} items]
(when-let [{:keys [uid summary dtstart dtend]} (parse-ical-component data)]
(upsert-page! conn :logseq.class/Event (or summary uid)
{:logseq.property.caldav/uid uid
:logseq.property.caldav/href href
:logseq.property.caldav/etag etag
:logseq.property/scheduled dtstart
:logseq.property/deadline dtend})))
(count items)))
(def ^:private vtodo-status->status-ident
{"COMPLETED" [:db/ident :logseq.property/status.done]
"CANCELLED" [:db/ident :logseq.property/status.canceled]
"IN-PROCESS" [:db/ident :logseq.property/status.doing]})
(defn- <pull-tasks!
[conn fetch-fn config]
(p/let [items (<report fetch-fn config (:calendar-path config) tasks-query-body "calendar-data")]
(doseq [{:keys [href etag data]} items]
(when-let [{:keys [uid summary dtstart due status]} (parse-ical-component data)]
(upsert-page! conn :logseq.class/Task (or summary uid)
(cond-> {:logseq.property.caldav/uid uid
:logseq.property.caldav/href href
:logseq.property.caldav/etag etag
:logseq.property/scheduled dtstart
:logseq.property/deadline due}
(get vtodo-status->status-ident status)
(assoc :logseq.property/status (get vtodo-status->status-ident status))))))
(count items)))
(defn- <pull-contacts!
[conn fetch-fn config]
(p/let [items (<report fetch-fn config (:addressbook-path config) contacts-query-body "address-data")]
(doseq [{:keys [href etag data]} items]
(when-let [{:keys [uid full-name email phone organization]} (parse-vcard data)]
(upsert-page! conn :logseq.class/Contact (or full-name uid)
{:logseq.property.caldav/uid uid
:logseq.property.caldav/href href
:logseq.property.caldav/etag etag
:logseq.property.contact/email email
:logseq.property.contact/phone phone
:logseq.property.contact/organization organization})))
(count items)))
;; -----------------------------------------------------------------------
;; Push: send local changes for graph pages that carry (or need) a caldav uid
;; -----------------------------------------------------------------------
(defn- pushable-pages
[db tag-ident]
(->> (d/datoms db :avet :block/tags tag-ident)
(map (fn [datom] (d/entity db (:e datom))))
(remove #(or (:logseq.property/deleted-at %) (ldb/hidden? %)))))
(defn- ensure-uid!
[conn page]
(or (:logseq.property.caldav/uid page)
(let [uid (str (random-uuid))]
(ldb/transact! conn [[:db/add (:db/id page) :logseq.property.caldav/uid uid]])
uid)))
(defn- <push-page!
[conn fetch-fn config collection-path page ->text content-type]
(p/let [uid (ensure-uid! conn page)
href (or (:logseq.property.caldav/href page) (join-url collection-path (str uid ".ics")))
text (->text (assoc page :uid uid))
{:keys [status etag]} (<put! fetch-fn config href text content-type
(:logseq.property.caldav/etag page))]
(cond
(#{200 201 204} status)
(ldb/transact! conn (remove nil?
[[:db/add (:db/id page) :logseq.property.caldav/href href]
(when etag [:db/add (:db/id page) :logseq.property.caldav/etag etag])]))
(= 412 status)
(log/info :caldav/push-conflict {:href href :page-uuid (:block/uuid page)})
:else
(log/warn :caldav/push-failed {:href href :status status}))))
(defn- event-page->vevent-input
[page]
{:summary (:block/title page)
:location (:logseq.property.event/location page)
:dtstart (:logseq.property/scheduled page)
:dtend (:logseq.property/deadline page)})
(defn- task-page->vtodo-input
[page]
{:summary (:block/title page)
:dtstart (:logseq.property/scheduled page)
:due (:logseq.property/deadline page)
:rrule (repeat->rrule {:repeat-type (:db/ident (:logseq.property.repeat/repeat-type page))
:recur-unit (:db/ident (:logseq.property.repeat/recur-unit page))
:recur-frequency (:logseq.property.repeat/recur-frequency page)})
:status-ident (:db/ident (:logseq.property/status page))})
(defn- contact-page->vcard-input
[page]
{:full-name (:block/title page)
:email (:logseq.property.contact/email page)
:phone (:logseq.property.contact/phone page)
:organization (:logseq.property.contact/organization page)})
(defn- <push-all!
[conn fetch-fn config]
(let [db @conn]
(p/all
(concat
(map #(<push-page! conn fetch-fn config (:calendar-path config) %
(comp block->vevent event-page->vevent-input) "text/calendar; charset=utf-8")
(pushable-pages db :logseq.class/Event))
(map #(<push-page! conn fetch-fn config (:calendar-path config) %
(comp block->vtodo task-page->vtodo-input) "text/calendar; charset=utf-8")
(pushable-pages db :logseq.class/Task))
(map #(<push-page! conn fetch-fn config (:addressbook-path config) %
(comp contact->vcard contact-page->vcard-input) "text/vcard; charset=utf-8")
(pushable-pages db :logseq.class/Contact))))))
;; -----------------------------------------------------------------------
;; Orchestration
;; -----------------------------------------------------------------------
(def ^:private sync-interval-ms (* 15 60 1000))
(defonce ^:private *sync-intervals (atom {}))
(defonce ^:private *sync-status (atom {}))
(defn- <sync!
([repo] (<sync! repo js/fetch))
([repo fetch-fn]
(p/let [config (<read-credentials repo)]
(if-not config
(p/resolved {:status :not-connected})
(let [conn (worker-state/get-datascript-conn repo)]
(-> (p/let [events (<pull-events! conn fetch-fn config)
tasks (<pull-tasks! conn fetch-fn config)
contacts (<pull-contacts! conn fetch-fn config)
_ (<push-all! conn fetch-fn config)]
(swap! *sync-status assoc repo {:last-sync-at (js/Date.now()) :last-sync-error nil})
{:status :ok :events events :tasks tasks :contacts contacts})
(p/catch (fn [error]
(swap! *sync-status assoc repo {:last-sync-at (js/Date.now())
:last-sync-error (str error)})
(log/error :caldav/sync-failed {:repo repo :error error})
{:status :error :error (str error)}))))))))
(defn- node-runtime?
[]
(= :node (platform/env-flag (platform/current) :runtime)))
(defn stop-sync!
[repo]
(when-let [interval-id (get @*sync-intervals repo)]
(js/clearInterval interval-id))
(swap! *sync-intervals dissoc repo))
(defn maybe-start-sync!
"Starts the periodic CalDAV/CardDAV sync for `repo` if credentials are
configured. Node-only: the daemon is the only runtime with outbound
fetch and keychain access."
[repo]
(when (node-runtime?)
(-> (<read-credentials repo)
(p/then (fn [config]
(when config
(stop-sync! repo)
(<sync! repo)
(swap! *sync-intervals assoc repo
(js/setInterval #(<sync! repo) sync-interval-ms)))))
(p/catch (fn [error]
(log/error :caldav/maybe-start-sync-failed {:repo repo :error error}))))))
(def-thread-api :thread-api/caldav-connect!
[repo config]
(p/let [_ (<save-credentials! repo config)]
(maybe-start-sync! repo)
{:status :connected}))
(def-thread-api :thread-api/caldav-disconnect!
[repo]
(stop-sync! repo)
(swap! *sync-status dissoc repo)
(p/let [_ (<delete-credentials! repo)]
{:status :disconnected}))
(def-thread-api :thread-api/caldav-status
[repo]
(p/let [config (<read-credentials repo)]
(merge {:connected? (some? config)
:base-url (:base-url config)
:username (:username config)}
(get @*sync-status repo))))
(def-thread-api :thread-api/caldav-sync-now!
[repo]
(<sync! repo))

2
src/resources/dicts/en.edn
View File

@@ -190,6 +190,8 @@
:bug-report.issue/report-link "Report issue"
:bug-report.issue/title "Or..."
:calendar/today "Today"
:class/add-property "Add tag property"
:class/tag-properties-desc "Tag properties are inherited by all nodes using the tag. For example, each #Task node inherits 'Status' and 'Priority'."
:class/tagged-nodes "Tagged nodes"

12
src/test/frontend/components/views_test.cljs
View File

@@ -1,6 +1,8 @@
(ns frontend.components.views-test
(:require ["react" :as react]
["react-dom/server" :as react-dom-server]
[cljs-time.coerce :as tc]
[cljs-time.core :as t]
[cljs.test :refer [async deftest is use-fixtures]]
[clojure.string :as string]
[datascript.impl.entity :as de]
@@ -484,6 +486,16 @@
"An unmounted reaction resource starts no reload.")
(unmount! mounted-view))))))))
(deftest calendar-row-date-prefers-scheduled-over-deadline
(is (= 100 (#'views/calendar-row-date-ms {:logseq.property/scheduled 100 :logseq.property/deadline 200})))
(is (= 200 (#'views/calendar-row-date-ms {:logseq.property/deadline 200})))
(is (nil? (#'views/calendar-row-date-ms {}))))
(deftest calendar-month-bounds-spans-exactly-one-month
(let [[start end] (#'views/calendar-month-bounds (t/date-time 2026 2 15))]
(is (= (tc/to-long (t/date-time 2026 2 1)) start))
(is (= (tc/to-long (t/date-time 2026 3 1)) end))))
(deftest group-by-column-should-exclude-name-and-include-many-properties
(is (views/group-by-column? {:id :block/page}))
(is (not (views/group-by-column? {:id :block/title

137
src/test/frontend/worker/handler/caldav_test.cljs Normal file
View File

@@ -0,0 +1,137 @@
(ns frontend.worker.handler.caldav-test
(:require [cljs.test :refer [deftest is testing]]
[frontend.worker.handler.caldav :as caldav]))
(deftest repeat->rrule-only-translates-the-plus-repeat-type
(testing "advance-from-scheduled with a daily unit and no explicit interval"
(is (= "FREQ=DAILY"
(caldav/repeat->rrule {:repeat-type :logseq.property.repeat/repeat-type.plus
:recur-unit :logseq.property.repeat/recur-unit.day}))))
(testing "an interval > 1 is included"
(is (= "FREQ=WEEKLY;INTERVAL=2"
(caldav/repeat->rrule {:repeat-type :logseq.property.repeat/repeat-type.plus
:recur-unit :logseq.property.repeat/recur-unit.week
:recur-frequency 2}))))
(testing "dotted-plus (advance from completion) has no RRULE equivalent"
(is (nil? (caldav/repeat->rrule {:repeat-type :logseq.property.repeat/repeat-type.dotted-plus
:recur-unit :logseq.property.repeat/recur-unit.day}))))
(testing "double-plus (skip to future) has no RRULE equivalent"
(is (nil? (caldav/repeat->rrule {:repeat-type :logseq.property.repeat/repeat-type.double-plus
:recur-unit :logseq.property.repeat/recur-unit.day})))))
(deftest rrule->repeat-only-understands-a-bare-freq-and-interval
(testing "a plain FREQ round-trips to the plus repeat type"
(is (= {:repeat-type :logseq.property.repeat/repeat-type.plus
:recur-unit :logseq.property.repeat/recur-unit.month
:recur-frequency nil}
(caldav/rrule->repeat "FREQ=MONTHLY"))))
(testing "FREQ;INTERVAL round-trips with the interval preserved"
(is (= {:repeat-type :logseq.property.repeat/repeat-type.plus
:recur-unit :logseq.property.repeat/recur-unit.year
:recur-frequency 3}
(caldav/rrule->repeat "FREQ=YEARLY;INTERVAL=3"))))
(testing "anything with BYDAY/COUNT/UNTIL or another unsupported part is left untranslated"
(is (nil? (caldav/rrule->repeat "FREQ=WEEKLY;BYDAY=MO,WE,FR")))
(is (nil? (caldav/rrule->repeat "FREQ=DAILY;COUNT=5")))
(is (nil? (caldav/rrule->repeat "FREQ=DAILY;UNTIL=20260101T000000Z"))))
(testing "an unrecognized FREQ value is left untranslated"
(is (nil? (caldav/rrule->repeat "FREQ=SECONDLY"))))
(testing "nil/blank input is left untranslated"
(is (nil? (caldav/rrule->repeat nil)))))
(deftest block->vevent-round-trips-through-parse-ical-component
(let [ms (.getTime (js/Date. "2026-03-15T10:00:00Z"))
ical (caldav/block->vevent {:uid "evt-1"
:summary "Team sync"
:description "Weekly ; check-in, notes\nwith a line break"
:location "Room A"
:dtstart ms
:dtend (+ ms 3600000)
:rrule "FREQ=WEEKLY"})
parsed (caldav/parse-ical-component ical)]
(is (= "VEVENT" (:type parsed)))
(is (= "evt-1" (:uid parsed)))
(is (= "Team sync" (:summary parsed)))
(is (= "Weekly ; check-in, notes\nwith a line break" (:description parsed)))
(is (= "Room A" (:location parsed)))
(is (= ms (:dtstart parsed)))
(is (= (+ ms 3600000) (:dtend parsed)))
(is (= "FREQ=WEEKLY" (:rrule parsed)))))
(deftest block->vtodo-round-trips-through-parse-ical-component
(let [ms (.getTime (js/Date. "2026-03-15T10:00:00Z"))
ical (caldav/block->vtodo {:uid "task-1"
:summary "Ship the release"
:dtstart ms
:due (+ ms 86400000)
:status-ident :logseq.property/status.done})
parsed (caldav/parse-ical-component ical)]
(is (= "VTODO" (:type parsed)))
(is (= "task-1" (:uid parsed)))
(is (= "Ship the release" (:summary parsed)))
(is (= ms (:dtstart parsed)))
(is (= (+ ms 86400000) (:due parsed)))
(is (= "COMPLETED" (:status parsed)))))
(deftest parse-ical-component-returns-nil-for-non-ical-text
(is (nil? (caldav/parse-ical-component "not an ics file at all"))))
(deftest contact->vcard-round-trips-through-parse-vcard
(let [vcard (caldav/contact->vcard {:uid "contact-1"
:full-name "Ada, Lovelace"
:email "ada@example.com"
:phone "+1 555 0100"
:organization "Analytical Engines Ltd"})
parsed (caldav/parse-vcard vcard)]
(is (= "contact-1" (:uid parsed)))
(is (= "Ada, Lovelace" (:full-name parsed)))
(is (= "ada@example.com" (:email parsed)))
(is (= "+1 555 0100" (:phone parsed)))
(is (= "Analytical Engines Ltd" (:organization parsed)))))
(deftest parse-vcard-returns-nil-for-non-vcard-text
(is (nil? (caldav/parse-vcard "BEGIN:VEVENT\nEND:VEVENT"))))
(def ^:private sample-multistatus
"<?xml version=\"1.0\"?>
<d:multistatus xmlns:d=\"DAV:\" xmlns:cal=\"urn:ietf:params:xml:ns:caldav\">
<d:response>
<d:href>/remote.php/dav/calendars/dario/personal/evt-1.ics</d:href>
<d:propstat>
<d:prop>
<d:getetag>&quot;abc123&quot;</d:getetag>
<cal:calendar-data>BEGIN:VCALENDAR&#13;
BEGIN:VEVENT&#13;
UID:evt-1&#13;
SUMMARY:Team &amp; sync&#13;
END:VEVENT&#13;
END:VCALENDAR</cal:calendar-data>
</d:prop>
<d:status>HTTP/1.1 200 OK</d:status>
</d:propstat>
</d:response>
<d:response>
<d:href>/remote.php/dav/calendars/dario/personal/evt-2.ics</d:href>
<d:propstat>
<d:prop>
<d:getetag>&quot;def456&quot;</d:getetag>
<cal:calendar-data>BEGIN:VCALENDAR&#13;
BEGIN:VEVENT&#13;
UID:evt-2&#13;
SUMMARY:Retro&#13;
END:VEVENT&#13;
END:VCALENDAR</cal:calendar-data>
</d:prop>
<d:status>HTTP/1.1 200 OK</d:status>
</d:propstat>
</d:response>
</d:multistatus>")
(deftest parse-multistatus-extracts-href-etag-and-data-per-response
(let [items (caldav/parse-multistatus "calendar-data" sample-multistatus)]
(is (= 2 (count items)))
(is (= "/remote.php/dav/calendars/dario/personal/evt-1.ics" (:href (first items))))
(is (= "\"abc123\"" (:etag (first items))))
(is (= "evt-1" (:uid (caldav/parse-ical-component (:data (first items))))))
(is (= "Team & sync" (:summary (caldav/parse-ical-component (:data (first items))))))
(is (= "evt-2" (:uid (caldav/parse-ical-component (:data (second items))))))))