meissa/souk
7
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Commit (old) progress

Browse source
This commit is contained in:
Arne Brasseur 2023-06-14 17:57:29 +02:00
parent 8184ee40da
commit 89e338feb5
19 changed files with 406 additions and 10316 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
config.local.edn
View file

@ -1 +1 @@
{:dev/start-keys [:storage/schema]}
{:dev/start-keys []}

5
deps.edn
View file

@ -33,7 +33,10 @@
djblue/portal {:mvn/version "0.35.0"}
lambdaisland/uri {:mvn/version "1.13.95"}
com.lambdaisland/facai {:mvn/version "0.7.59-alpha"}}
;; Test data
com.lambdaisland/facai {:mvn/version "0.8.68-alpha"}
com.lambdaisland/faker {:mvn/version "0.2.8"}}
:aliases
{:dev {:extra-paths ["dev"]}

3
dev/user.clj
View file

@ -43,6 +43,9 @@
(add-tap (jit portal.api/submit))
p))
(defn system []
((jit k16.gx.beta.system/values) sys-id))
(defn value [k]
(get ((jit k16.gx.beta.system/values) sys-id) k))

BIN
preview-image.png
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 502 KiB

After

Width:  |  Height:  |  Size: 1.3 MiB

5139
preview-image.svg
View file

File diff suppressed because one or more lines are too long
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 434 KiB

After

Width:  |  Height:  |  Size: 434 KiB

2
repl_sessions/json_ld_stuff.clj
View file

@ -35,6 +35,8 @@
:http-client {:redirect-policy :normal}
:as :json-string-keys}))
(json-fetch "https://toot.cat/users/plexus")
(def expand-context
(memoize
(fn

22
repl_sessions/webfinger.clj
View file

@ -11,6 +11,28 @@
"https://toot.cat/@plexus"
"http://toot.cat/users/plexus"
"https://toot.cat/users/plexus"
"acct:plexus@toot.cat"
(for [resource ["acct:plexus@toot.cat"
"https://toot.cat/u/plexus"
"https://toot.cat/users/plexus"]
:let [origin (uri/uri "https://toot.cat")]]
(let [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})
)))
(into {} (uri/uri "acct://plexus@toot.cat"))
;; rel seems to be ignored

6
resources/lambdaisland/souk/ActivityStreams.edn
View file

@ -1,6 +1,7 @@
{:activitystreams/Actor
{:properties
[[:activitystreams/name text]
[[:souk/origin text]
[:activitystreams/name text]
[:activitystreams/preferredUsername text]
[:activitystreams/url rdf/iri]
[:activitystreams/summary text]
@ -18,10 +19,11 @@
{:properties
[[:activitystreams/summary text]
[:activitystreams/content text]
[:activitystreams/published datetime]
[ :activitystreams/attributedTo rdf/iri]
]}
#_
{:rdf/type :activitystreams/Note,
:rdf/id "https://plexus.osrx.chat/users/plexus/statuses/109495602955086656",
:activitystreams/inReplyTo nil,

8
resources/lambdaisland/souk/config.edn
View file

@ -2,7 +2,7 @@
{:gx/component lambdaisland.souk.components.router/component
:gx/props {:dev-router? #setting :dev/reload-routes?
:storage/db (gx/ref :storage/db)
:instance/domain #setting :instance/domain}}
:instance/origin #setting :instance/origin}}
:http/server
{:gx/component lambdaisland.souk.components.jetty/component
@ -11,11 +11,11 @@
:storage/db
{:gx/component lambdaisland.souk.components.db/component
:gx/props {:url #setting :jdbc/url
:gx/props {:url #setting :jdbc/url
:schema (gx/ref :storage/schema)}}
:storage/schema
{:gx/component lambdaisland.souk.components.db-schema/component
:gx/props {:url #setting :jdbc/url
:gx/props {:url #setting :jdbc/url
:admin-url #setting :jdbc/admin-url
:schemas [#resource "lambdaisland/souk/ActivityStreams.edn"]}}}
:schemas [#resource "lambdaisland/souk/ActivityStreams.edn"]}}}

6
resources/lambdaisland/souk/settings-dev.edn
View file

@ -1,4 +1,4 @@
{:dev/reload-routes? true
:jdbc/url "jdbc:pgsql://localhost:55432/souk?user=postgres"
:jdbc/admin-url "jdbc:pgsql://localhost:55432/postgres?user=postgres"
:instance/domain "dev.squid.casa"}
:jdbc/url "jdbc:pgsql://localhost:55432/souk?user=postgres"
:jdbc/admin-url "jdbc:pgsql://localhost:55432/postgres?user=postgres"
:instance/origin "https://dev.squid.casa"}

61
src/lambdaisland/souk/activitypub.clj
View file

@ -1,6 +1,9 @@
(ns lambdaisland.souk.activitypub
"Interact with ActivityPub instances"
(:require [lambdaisland.souk.json-ld :as ld]))
(:require
[clojure.string :as str]
[lambdaisland.souk.json-ld :as ld]
[lambdaisland.uri :as uri]))
(def common-prefixes
{"dcterms" "http://purl.org/dc/terms/"
@ -15,5 +18,61 @@
"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 (:body (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}))))

53
src/lambdaisland/souk/components/db.clj
View file

@ -9,56 +9,15 @@
[lambdaisland.glogc :as log])
(:import (com.mchange.v2.c3p0 ComboPooledDataSource)))
(defn pg-coerce [val]
(cond
(instance? java.time.ZonedDateTime val)
(.toOffsetDateTime val)
:else
val))
(defn insert-sql [table entity props]
(into [(sql/sql 'insert-into table
(cons :rdf/props
(map key entity))
'values
(repeat (inc (count entity)) '?)
'on-conflict [:raw "(\"rdf/id\")"]
'do
'update-set
(into [:commas]
(map (fn [[k]]
[k '= '?]))
entity))]
(cons
(json/encode props)
(concat
(map (comp pg-coerce val) entity)
(map (comp pg-coerce val) entity)))))
(defn start! [{:keys [props schema]}]
(let [ds (doto (ComboPooledDataSource.)
(.setDriverClass "com.impossibl.postgres.jdbc.PGDriver")
(.setJdbcUrl (:url props)))]
(let [table-columns
(into {}
(with-open [con (jdbc/get-connection ds {})]
(let [md (.getMetaData con)]
(doall
(for [{:keys [pg_class/TABLE_NAME]}
(-> md
(.getTables nil nil nil (into-array ["TABLE" "VIEW"]))
(rs/datafiable-result-set ds {}))]
[(keyword TABLE_NAME)
(map (comp keyword :COLUMN_NAME)
(rs/datafiable-result-set (.getColumns md nil nil TABLE_NAME nil) ds {}))])))))]
{:schema table-columns
:ds ds})))
(defn start! [{:keys [props]}]
{:schema (:schema props)
:ds (doto (ComboPooledDataSource.)
(.setDriverClass "com.impossibl.postgres.jdbc.PGDriver")
(.setJdbcUrl (:url props)))})
(defn stop! [{ds :value}]
#_(.close ds))
)
;; cpds.setUser("dbuser");
;; cpds.setPassword("dbpassword");
(def component
{:gx/start {:gx/processor #'start!}
:gx/stop {:gx/processor #'stop!}})

22
src/lambdaisland/souk/components/db_schema.clj
View file

@ -11,6 +11,7 @@
(def default-properties
[[:rdf/id 'text 'primary-key]
[:rdf/type 'text]
[:rdf/props 'jsonb 'default "{}"]
[:meta/created-at 'timestamp-with-time-zone 'default [:fn 'now] 'not-null]
[:meta/updated-at 'timestamp-with-time-zone]])
@ -67,8 +68,7 @@
properties))])
(defn migrate-tables! [url schemas]
(doseq [schema schemas
[table {:keys [properties store-as]}] (aero/read-config schema)
(doseq [[table {:keys [properties store-as]}] schemas
:when (not store-as)]
(let [ds (jdbc/get-datasource url)
table-cols (table-columns ds nil)
@ -84,7 +84,7 @@
(log/info :table/altered {:table table :new-props (map first new-props)}))
(do
(jdbc/execute! ds (create-table-sql table all-props))
(jdbc/execute! ds [(sql/sql 'create-trigger :set-timestamp
(jdbc/execute! ds [(sql/sql 'create-trigger :set-timestamp
'before-update
'on table
'for-each-row
@ -103,8 +103,20 @@
(throw e))))
(let [ds (jdbc/get-datasource url)]
(jdbc/execute! ds [set-ts-trigger-def])
(migrate-tables! url schemas)
(table-columns ds)))
(let [schemas (apply merge (map aero/read-config schemas))
_ (migrate-tables! url schemas)]
(into {}
(map (fn [[type {:keys [properties store-as]}]]
[type
(cond-> {:table (or store-as type)
:properties
(into {:rdf/id 'rdf/iri
:rdf/type 'rdf/iri}
(or properties
(get-in schemas [store-as :properties])))})]))
schemas))))
(def component
{:gx/start {:gx/processor #'start!}})
(user/value :storage/schema)

52
src/lambdaisland/souk/components/router.clj
View file

@ -1,7 +1,10 @@
(ns lambdaisland.souk.components.router
"Reitit routes and router"
(:require
[lambdaisland.souk.activitypub :as activitypub]
[lambdaisland.souk.db :as db]
[lambdaisland.souk.util.dev-router :as dev-router]
[lambdaisland.uri :as uri]
[muuntaja.core :as muuntaja]
[reitit.dev.pretty :as pretty]
[reitit.ring :as reitit-ring]
@ -9,13 +12,60 @@
[reitit.ring.middleware.muuntaja :as reitit-muuntaja]
[reitit.ring.middleware.parameters :as reitit-parameters]))
(defn db-conn [req]
(get-in req [:souk/ctx :storage/db]))
(defn origin [req]
(get-in req [:souk/ctx :instance/origin]))
(defn routes [opts]
[["/"
{:get
{:handler
(fn [req]
{:status 200
:body "OK!"})}}]])
:body "OK!"})}}]
["/.well-known/webfinger"
{:get
{:handler
(fn [{:keys [query-params] :as req}]
(tap> req)
(let [{:strs [resource]} query-params
_ (tap> resource)
{:keys [domain username]} (doto (activitypub/parse-user-resource
(origin req)
resource)
tap>)]
(if-let [user (db/retrieve (db-conn req)
:activitystreams/Actor
(assoc (uri/uri (origin req))
:path (str "/users/" username))
)]
{:status 200
:body
{:subject resource
:aliases [(:activitystreams/url user)
(:rdf/id user)
(str "acct:" domain "@" username)]
:links
[{:rel "http://webfinger.net/rel/profile-page"
:type "text/html"
:href (:activitystreams/url user)}
{:rel "self"
:type "application/activity+json"
:href (:rdf/id user)}]}}
{:status 404})))}}]
["/users/:user-id"
{:get
{:handler
(fn [{:keys [path-params] :as req}]
{:status 200
:body (activitypub/externalize
(db/retrieve
(db-conn req)
:activitystreams/Actor
(assoc (uri/uri (origin req))
:path (str "/users/" (:user-id path-params)))))})}}]])
(defn wrap-request-context [handler ctx]
(fn [req]

100
src/lambdaisland/souk/db.clj
View file

@ -1 +1,99 @@
(ns lambdaisland.souk.db)
(ns lambdaisland.souk.db
(:require
[charred.api :as json]
[lambdaisland.souk.activitypub :as activitypub]
[lambdaisland.souk.sql :as sql]
[next.jdbc.result-set :as rs]
[next.jdbc :as jdbc]))
(defn pg-coerce [val]
(cond
(instance? java.time.ZonedDateTime val)
(.toOffsetDateTime val)
:else
val))
(defn upsert-sql [table entity props]
(into [(sql/sql 'insert-into table
(cons :rdf/props
(map key entity))
'values
(repeat (inc (count entity)) '?)
'on-conflict [:raw "(\"rdf/id\")"]
'do
'update-set
(into [:bare-list]
(map (fn [[k]]
[k '= '?]))
entity))]
(cons
(json/write-json-str props)
(concat
(map (comp pg-coerce val) entity)
(map (comp pg-coerce val) entity)))))
(defn upsert! [{:keys [ds schema] :as conn} entity]
(let [rdf-type (:rdf/type entity)
{:keys [table properties]} (get schema rdf-type)
known-props (keys properties)
json-props (apply dissoc entity known-props)
_
(assert table (str "Don't know how to store "
(if rdf-type rdf-type (str "entity " entity))))
entity-props (into {}
(map (fn [[k v]]
[k
(let [type (get properties k)]
(case type
'rdf/iri
(activitypub/kw->iri
(if (map? v)
(do
(upsert! conn v)
(:rdf/id v))
v))
v))]))
(select-keys entity known-props))]
(jdbc/execute! ds (upsert-sql table entity-props json-props))))
(defrecord MyMapResultSetBuilder [^java.sql.ResultSet rs rsmeta cols]
rs/RowBuilder
(->row [this] (transient {}))
(column-count [this] (count cols))
(with-column [this row i]
(rs/with-column-value this row (nth cols (dec i))
(if (= java.sql.Types/TIMESTAMP_WITH_TIMEZONE (.getColumnType rsmeta i))
(.getObject rs ^Integer i ^Class java.time.OffsetDateTime)
(rs/read-column-by-index (.getObject rs ^Integer i) rsmeta i))))
(with-column-value [this row col v]
(assoc! row col v))
(row! [this row] (persistent! row))
rs/ResultSetBuilder
(->rs [this] (transient []))
(with-row [this mrs row]
(conj! mrs row))
(rs! [this mrs] (persistent! mrs)))
(defn my-builder
[rs opts]
(let [rsmeta (.getMetaData rs)
cols (rs/get-unqualified-column-names rsmeta opts)]
(->MyMapResultSetBuilder rs rsmeta cols)))
(defn retrieve [{:keys [ds schema] :as conn} type iri]
(let [{:keys [table]} (get schema type)]
(let [{:rdf/keys [props] :as result}
(jdbc/execute-one! ds [(sql/sql 'select '* 'from table 'where :rdf/id '= '?)
(str iri)]
{:builder-fn my-builder})]
(when result
(merge (dissoc result :rdf/props)
(doto (json/read-json props :key-fn keyword) prn))))))
;; (upsert!
;; (user/value :storage/db)
;; p)
;; p
;; (retrieve (user/value :storage/db) :activitystreams/Actor "http://example.com/users/amber30")

60
src/lambdaisland/souk/factories.clj Normal file
View file

@ -0,0 +1,60 @@
(ns lambdaisland.souk.factories
(:require
[clojure.string :as str]
[lambdaisland.facai :as f]
[lambdaisland.faker :as faker]
[lambdaisland.uri :as uri]))
(defn fake [faker]
(fn []
(faker/fake faker)))
(def now #(java.time.Instant/now))
(def ^:dynamic *origin* "http://example.com")
(defn local-uri [& parts]
(str (uri/join *origin* (str "/" (str/join "/" parts)))))
(f/defactory Person
{:rdf/type :activitystreams/Person
:souk/origin (fn [] *origin*)
:activitystreams/name (fake #{[:simpsons :characters] [:tolkien :characters]})
:activitystreams/summary (fake [:lorem :sentence])
:activitystreams/published now}
:after-build
(fn [ctx]
(f/update-result
ctx
(fn [{:activitystreams/keys [name] :as res}]
(let [username (str (str/lower-case (first (str/split name #" ")))
(rand-int 100))]
(assoc res
:rdf/id (local-uri "users" username)
:activitystreams/preferredUsername username
:activitystreams/url (local-uri "u" username)
:ldp/inbox (local-uri "users" username "inbox")
:activitystreams/outbox (local-uri "users" username "outbox")))))))
(f/defactory Note
{:rdf/id (local-uri "/notes/" (rand-int 999999999))
:rdf/type :activitystreams/Note
:activitystreams/attributedTo Person
:activitystreams/content [:lorem :sentence]})
(binding [*origin* "https://dev.squid.casa"]
(Person))
(Note)
(binding [*origin* "https://dev.squid.casa"]
(lambdaisland.souk.db/upsert!
(user/value :storage/db)
(Person)
))
@plexus@toot.cat
https://toot.cat/users/plexus
https://toot.cat/@plexus
acct:plexus@toot.cat

23
src/lambdaisland/souk/json_ld.clj
View file

@ -142,6 +142,29 @@
: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)))
;; (compact
;; (expand (:body (json-get "https://toot.cat/users/plexus")))
;; common-prefixes)

BIN
stream-preview.png
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 507 KiB

After

Width:  |  Height:  |  Size: 527 KiB

5158
stream-preview.svg
View file

File diff suppressed because one or more lines are too long
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 435 KiB

After

Width:  |  Height:  |  Size: 436 KiB