Commit (old) progress

config.local.edn

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

deps.edn

@@ -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"]}

dev/user.clj

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

repl_sessions/json_ld_stuff.clj

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

repl_sessions/webfinger.clj

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

resources/lambdaisland/souk/ActivityStreams.edn

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

resources/lambdaisland/souk/config.edn

@@ -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"]}}}

resources/lambdaisland/souk/settings-dev.edn

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

src/lambdaisland/souk/activitypub.clj

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

src/lambdaisland/souk/components/db.clj

@@ -9,56 +9,15 @@
             [lambdaisland.glogc :as log])
   (:import (com.mchange.v2.c3p0 ComboPooledDataSource)))
 
-(defn pg-coerce [val]
+(defn start! [{:keys [props]}]
-  (cond
+  {:schema (:schema props)
-    (instance? java.time.ZonedDateTime val)
+   :ds (doto (ComboPooledDataSource.)
-    (.toOffsetDateTime val)
+         (.setDriverClass "com.impossibl.postgres.jdbc.PGDriver")
-    :else
+         (.setJdbcUrl (:url props)))})
-    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 stop! [{ds :value}]
-  #_(.close ds))
+  )
 
-;; cpds.setUser("dbuser");
-;; cpds.setPassword("dbpassword");
 (def component
   {:gx/start {:gx/processor #'start!}
    :gx/stop {:gx/processor #'stop!}})

src/lambdaisland/souk/components/db_schema.clj

@@ -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
+  (doseq [[table {:keys [properties store-as]}] schemas
-          [table {:keys [properties store-as]}] (aero/read-config schema)
           :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)
+    (let [schemas (apply merge (map aero/read-config schemas))
-    (table-columns ds)))
+          _ (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)

src/lambdaisland/souk/components/router.clj

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

src/lambdaisland/souk/db.clj

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

src/lambdaisland/souk/factories.clj

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

src/lambdaisland/souk/json_ld.clj

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