meissa/activity-pub-poc
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Now having ld as clj map

Browse source
This commit is contained in:
Michael Jerger 2023-06-16 18:42:59 +02:00
parent 50ff2f4617
commit 9aed2c89a9
3 changed files with 204 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
project.clj
View file

@ -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 {})

81
src/main/clj/dda/activity_pub_poc/activitypub.clj Normal file
View file

@ -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))

121
src/main/clj/dda/activity_pub_poc/json_ld.clj
View file

@ -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)))