From 9aed2c89a9ba4e15b80c161c5cc320391bba981e Mon Sep 17 00:00:00 2001 From: Michael Jerger Date: Fri, 16 Jun 2023 18:42:59 +0200 Subject: [PATCH] Now having ld as clj map --- project.clj | 3 +- .../clj/dda/activity_pub_poc/activitypub.clj | 81 ++++++++++++ src/main/clj/dda/activity_pub_poc/json_ld.clj | 121 ++++++++++++++++++ 3 files changed, 204 insertions(+), 1 deletion(-) create mode 100644 src/main/clj/dda/activity_pub_poc/activitypub.clj diff --git a/project.clj b/project.clj index ed084c6..76e8032 100644 --- a/project.clj +++ b/project.clj @@ -13,7 +13,8 @@ ;; Outgoing HTTP [hato "0.9.0"] [cheshire/cheshire "5.11.0"] - [com.cognitect/transit-clj "1.0.333"]] + [com.cognitect/transit-clj "1.0.333"] + [lambdaisland/uri "1.13.95"]] :main ^:skip-aot activity-pub-poc.core :target-path "target/%s" :profiles {}) diff --git a/src/main/clj/dda/activity_pub_poc/activitypub.clj b/src/main/clj/dda/activity_pub_poc/activitypub.clj new file mode 100644 index 0000000..98d38c8 --- /dev/null +++ b/src/main/clj/dda/activity_pub_poc/activitypub.clj @@ -0,0 +1,81 @@ +(ns dda.activity-pub-poc.activitypub + "Interact with ActivityPub instances" + (:require + [clojure.string :as str] + [dda.activity-pub-poc.json-ld :as ld] + [lambdaisland.uri :as uri] + [clojure.inspector :as ins])) + +(def common-prefixes + {"dcterms" "http://purl.org/dc/terms/" + "ldp" "http://www.w3.org/ns/ldp#" + "schema" "http://schema.org/" + "vcard" "http://www.w3.org/2006/vcard/ns#" + "mastodon" "http://joinmastodon.org/ns#" + "security" "https://w3id.org/security#" + "activitystreams" "https://www.w3.org/ns/activitystreams#" + "xsd" "http://www.w3.org/2001/XMLSchema#" + "owl" "http://www.w3.org/2002/07/owl#" + "rdfs" "http://www.w3.org/2000/01/rdf-schema#" + "ostatus" "http://ostatus.org#"}) + +(def default-context + ["https://www.w3.org/ns/activitystreams" + "https://w3id.org/security/v1" + {"identityKey" {"@type" "@id" "@id" "toot:identityKey"} + "EncryptedMessage" "toot:EncryptedMessage" + "Ed25519Key" "toot:Ed25519Key" + "devices" {"@type" "@id" "@id" "toot:devices"} + "manuallyApprovesFollowers" "as:manuallyApprovesFollowers" + "schema" "http://schema.org#" + "PropertyValue" "schema:PropertyValue" + "Curve25519Key" "toot:Curve25519Key" + "claim" {"@type" "@id" "@id" "toot:claim"} + "value" "schema:value" + "movedTo" {"@id" "as:movedTo" "@type" "@id"} + "discoverable" "toot:discoverable" + "messageType" "toot:messageType" + "messageFranking" "toot:messageFranking" + "cipherText" "toot:cipherText" + "toot" "http://joinmastodon.org/ns#" + "alsoKnownAs" {"@id" "as:alsoKnownAs" "@type" "@id"} + "featured" {"@id" "toot:featured" "@type" "@id"} + "featuredTags" {"@id" "toot:featuredTags" "@type" "@id"} + "Ed25519Signature" "toot:Ed25519Signature" + "focalPoint" {"@container" "@list" "@id" "toot:focalPoint"} + "fingerprintKey" {"@type" "@id" "@id" "toot:fingerprintKey"} + "Device" "toot:Device" + "publicKeyBase64" "toot:publicKeyBase64" + "deviceId" "toot:deviceId" + "suspended" "toot:suspended"}]) + +(defn GET [url] + (ld/internalize (ld/expand (ld/json-get url)) common-prefixes)) + +(defn kw->iri [kw] + (if (string? kw) + kw + (let [prefix (namespace kw) + base (get common-prefixes prefix)] + (assert base (str "Base IRI not found for prefix: " prefix)) + (str base (name kw))))) + +(defn externalize [v] + (ld/externalize v default-context common-prefixes)) + +(defn parse-user-resource [origin resource] + (let [origin (uri/uri origin) + iri (uri/uri resource)] + (cond + (#{"http" "https"} (:scheme iri)) + (if (and (= (:scheme origin) (:scheme iri)) + (= (:host origin) (:host iri))) + (if-let [[_ _ u] (re-find #"^/(u|users)/([^/]+)$" (:path iri))] + {:domain (:host iri) + :username u})) + (#{"acct"} (:scheme iri)) + (let [[username domain] (str/split (:path iri) #"@")] + {:domain domain + :username username})))) + +(ins/inspect-tree (GET ld/team-url)) diff --git a/src/main/clj/dda/activity_pub_poc/json_ld.clj b/src/main/clj/dda/activity_pub_poc/json_ld.clj index ae212ec..cb856a3 100644 --- a/src/main/clj/dda/activity_pub_poc/json_ld.clj +++ b/src/main/clj/dda/activity_pub_poc/json_ld.clj @@ -2,6 +2,7 @@ (:require [hato.client :as http] [clojure.string :as str] + [clojure.walk :as walk] [clojure.inspector :as ins] )) @@ -49,5 +50,125 @@ [k (if (map? v) v {"@id" v})])))) new-context)))) +(defn expand-id [id ctx] + (if (string? id) + (if-let [t (get-in ctx [id "@id"])] + t + (if (str/includes? id ":") + (let [[prefix suffix] (str/split id #":")] + (if-let [prefix-url (get-in ctx [prefix "@id"])] + (str prefix-url suffix) + id)) + id)) + id)) + +(defn apply-context [v ctx] + (cond + (map? v) + (into {} + (map (fn [[k v]] + (let [attr (get ctx k) + k (get-in ctx [k "@id"] k) + v (apply-context v ctx)] + [k (if attr + (cond + (and (#{"@id" "@type"} k) (string? v)) + (expand-id v ctx) + (and (= "@id" (get attr "@type")) (string? v)) + (assoc attr "@id" (expand-id v ctx)) + :else + (assoc (dissoc (cond-> attr + (contains? attr "@type") + (update "@type" expand-id ctx)) + "@id") + "@value" v)) + v)]))) + v) + + (sequential? v) + (into (empty v) (map #(apply-context % ctx)) v) + + (and (string? v) (str/includes? v ":")) + (expand-id v ctx) + + :else + v)) + +(defn expand [json-ld] + (let [ctx (expand-context {} (get json-ld "@context"))] + (apply-context (dissoc json-ld "@context") ctx))) + +(defn internalize [v prefixes] + (let [shorten #(if (and (string? %) (str/includes? % "://")) + (or (some (fn [[ns url]] + (when (.startsWith % url) + (keyword ns + (subs % (.length url))))) + prefixes) + %) + %)] + (cond + (sequential? v) + (into (empty v) (map #(internalize % prefixes)) v) + + (map? v) + (-> v + (cond-> (contains? v "@type") + (update "@type" shorten)) + (update-keys (fn [k] + (case k + "@id" :rdf/id + "@type" :rdf/type + "@value" :rdf/value + (if-let [kw (shorten k)] + kw + k)))) + (update-vals (fn [v] + (cond + (map? v) + (let [{id "@id" type "@type" value "@value"} v] + (cond + (and (= "@id" type) (contains? v "@id")) + id + (contains? v "@value") + (case type + "http://www.w3.org/2001/XMLSchema#dateTime" + (java.time.ZonedDateTime/parse value) + (internalize value prefixes)) + :else + (internalize v prefixes))) + + (string? v) + (shorten v) + + :else + (internalize v prefixes))))) + :else + v))) + +(defn kw->iri [kw prefixes] + (if (keyword? kw) + (let [prefix (namespace kw) + base (get prefixes prefix)] + (if base + (str base (name kw)) + kw)) + kw)) + +(defn externalize [v context prefixes] + (let [iri->prop (into {} + (map (fn [[k v]] + [(get v "@id") k])) + (expand-context context)) + convert-val (fn [v] + (let [v (cond + (= :rdf/type v) "@type" + (= :rdf/id v) "@id" + :else v) + ?iri (kw->iri v prefixes)] + (get iri->prop ?iri ?iri)))] + (assoc (walk/postwalk convert-val v) "@context" context))) (expand-context (get (json-get team-url) "@context")) + +(ins/inspect-tree (expand (json-get team-url)))