We can insert!

deps.edn

@@ -4,23 +4,25 @@
          ;; Application setup
          com.lambdaisland/webbing {:local/root "/home/arne/github/lambdaisland/webbing"}
          ;;         {:mvn/version "0.4.20-alpha"}
+
          ;; Incoming HTTP
-         ring/ring-core              {:mvn/version "1.9.6"}
+         ring/ring-core          {:mvn/version "1.9.6"}
-         ring/ring-jetty-adapter     {:mvn/version "1.9.6"}
+         ring/ring-jetty-adapter {:mvn/version "1.9.6"}
-         ring/ring-mock              {:mvn/version "0.4.0"}
+         ring/ring-mock          {:mvn/version "0.4.0"}
-         metosin/malli               {:mvn/version "0.9.2"}
+         metosin/muuntaja        {:mvn/version "0.6.8"}
-         metosin/muuntaja            {:mvn/version "0.6.8"}
+         metosin/reitit          {:mvn/version "0.5.18"}
-         metosin/reitit              {:mvn/version "0.5.18"}
 
          ;; Outgoing HTTP
-         hato/hato         {:mvn/version "0.9.0"}
+         hato/hato {:mvn/version "0.9.0"}
 
          ;; Formats
          cheshire/cheshire {:mvn/version "5.11.0"}
+         metosin/malli     {:mvn/version "0.9.2"}
 
          ;; Database
          seancorfield/next.jdbc            {:mvn/version "1.2.659"}
          com.impossibl.pgjdbc-ng/pgjdbc-ng {:mvn/version "0.8.9"}
+         com.mchange/c3p0                  {:mvn/version "0.9.5.5"}
 
          ;; Logging
          ;; Webbing pulls in pedestal-log/glogi, but does not dictate the logging sink
@@ -28,8 +30,9 @@
          org.slf4j/jcl-over-slf4j       {:mvn/version "2.0.3"}
          org.slf4j/log4j-over-slf4j     {:exclusions [org.slf4j/slf4j-nop], :mvn/version "2.0.3"}
          ch.qos.logback/logback-classic {:exclusions [org.slf4j/slf4j-api org.slf4j/slf4j-nop] :mvn/version "1.4.4"}
-         }
+
+         djblue/portal {:mvn/version "0.35.0"}}
 
  :aliases
- {:dev {:extra-paths ["dev"]}
+ {:dev  {:extra-paths ["dev"]}
   :souk {:main-opts ["-m" "lambdaisland.souk"]}}}

repl_sessions/pg_stuff.clj

@@ -16,12 +16,12 @@
   (let [ds (jdbc/get-datasource (pg-url "postgres"))]
     (jdbc/execute! ds [(str "DROP DATABASE IF EXISTS " name)])
     (jdbc/execute! ds [(str "CREATE DATABASE " name)])))
-
+(pg-url "souk")
 (recreate-db! "souk")
 
 (defn sql-ident [v]
   (if (sequential? v)
-    (str/join "." (map identifier v))
+    (str/join "." (map sql-ident v))
     (str "\""
          (if (keyword? v)
            (subs (str v) 1)

repl_sessions/second_stream.clj

@@ -0,0 +1,32 @@
+(ns repl-sessions.second-stream
+  (:require [lambdaisland.souk.db :as db]
+            [lambdaisland.souk.activitypub :as ap]
+            [lambdaisland.souk.sql :as sql]
+            [next.jdbc :as jdbc]))
+
+(let [{:keys [schema ds]} (user/value :storage/db)
+      table :activitystreams/Actor
+      person (ap/GET "https://toot.cat/users/plexus/")]
+  #_
+  (jdbc/execute! ds
+                 (db/insert-sql table
+                                (select-keys person (get schema table))
+                                (apply dissoc person :rdf/type (get schema table))))
+  [(select-keys person (get schema table))
+   (apply dissoc person :rdf/type (get schema table))]
+  )
+
+(count
+ {:rdf/type :activitystreams/Person,
+  :rdf/id "https://toot.cat/users/plexus",
+  :activitystreams/published
+  "2017-04-11T00:00Z",
+  :activitystreams/outbox "https://toot.cat/users/plexus/outbox",
+  :activitystreams/name "Arne Brasseur",
+  :activitystreams/summary
+  "<p>Founder of Gaiwan.co — creator of Kaocha — drinks tea and writes Clojure, in that order.</p><p>Alts: <span class=\"h-card\"><a href=\"https://mastodon.social/@plexus\" class=\"u-url mention\">@<span>plexus</span></a></span> / <span class=\"h-card\"><a href=\"https://toot.berlin/@plexus\" class=\"u-url mention\">@<span>plexus</span></a></span></p>",
+  :activitystreams/preferredUsername "plexus",
+  :activitystreams/url "https://toot.cat/@plexus",
+  :ldp/inbox "https://toot.cat/users/plexus/inbox"})
+
+(jdbc/execute! (:ds (user/value :storage/db)) [(sql/sql 'drop-table :activitystreams/Actor)])

resources/lambdaisland/souk/config.edn

@@ -5,4 +5,9 @@
  :http/server
  {:gx/component lambdaisland.souk.components.jetty/component
   :gx/props     {:jetty-options {:port #setting :port}
-                 :router        (gx/ref :http/router)}}}
+                 :router        (gx/ref :http/router)
+                 :db            (gx/ref :storage/db)}}
+
+ :storage/db
+ {:gx/component lambdaisland.souk.db/component
+  :gx/props     {:url #setting :jdbc/url}}}

resources/lambdaisland/souk/settings-dev.edn

@@ -1 +1,2 @@
-{:dev/reload-routes? true}
+{:dev/reload-routes? true
+ :jdbc/url "jdbc:pgsql://localhost:5432/souk?user=postgres"}

src/lambdaisland/souk/activitypub.clj

@@ -16,3 +16,5 @@
 
 (defn GET [url]
   (ld/internalize (ld/expand (:body (ld/json-get url))) common-prefixes))
+
+(GET "https://toot.cat/users/plexus")

src/lambdaisland/souk/db.clj

@@ -0,0 +1,100 @@
+(ns lambdaisland.souk.db
+  (:require [lambdaisland.souk.sql :as sql]
+            [next.jdbc :as jdbc]
+            [next.jdbc.date-time :as jdbc-date-time]
+            [next.jdbc.plan]
+            [next.jdbc.result-set :as rs]
+            [next.jdbc.sql :as nsql]
+            [cheshire.core :as json]
+            [lambdaisland.glogc :as log])
+  (:import (com.mchange.v2.c3p0 ComboPooledDataSource)))
+
+(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]])
+
+(def set-ts-trigger-def "CREATE OR REPLACE FUNCTION trigger_set_timestamp()\nRETURNS TRIGGER AS $$\nBEGIN\n  NEW.\"meta/updated-at\" = NOW();\n  RETURN NEW;\nEND;\n$$ LANGUAGE plpgsql;")
+
+(def tables
+  [[:activitystreams/Actor
+    [[:activitystreams/name 'text 'not-null]
+     [:activitystreams/preferredUsername 'text 'not-null]
+     [:activitystreams/url 'text 'not-null]
+     [:activitystreams/summary 'text]
+     [:ldp/inbox 'text 'not-null]
+     [:activitystreams/outbox 'text 'not-null]
+     [:activitystreams/published 'timestamp-with-time-zone]]]])
+
+(defn create-table! [ds table-name columns]
+  (log/info :table/creating {:name table-name :columns columns})
+  (jdbc/execute! ds [(sql/sql 'create-table 'if-not-exists table-name
+                              (concat
+                               default-properties
+                               columns))])
+  (jdbc/execute! ds [(sql/sql 'drop-trigger 'if-exists :set-timestamp
+                              'on table-name)])
+  (jdbc/execute! ds [(sql/sql 'create-trigger  :set-timestamp
+                              'before-update
+                              'on table-name
+                              'for-each-row
+                              'execute-procedure [:fn 'trigger_set_timestamp])]))
+
+(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) props)
+          (map (comp pg-coerce val) props)))))
+
+(defn start! [{:keys [props]}]
+  (let [ds (doto (ComboPooledDataSource.)
+             (.setDriverClass "com.impossibl.postgres.jdbc.PGDriver")
+             (.setJdbcUrl (:url props)))]
+    (jdbc/execute! ds [set-ts-trigger-def])
+    (doseq [[table columns] tables]
+      (create-table! ds table columns))
+    (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/setup.clj

@@ -32,7 +32,6 @@
     {:schemas schemas
      :keys    (:dev/start-keys local-config start-keys)
      :sources {:config   [(proj-resource "config.edn")
-                          (proj-resource "config-development.edn")
                           (dissoc local-config :dev/start-keys)]
                :secrets   [(config/dotenv)
                            (config/env)

src/lambdaisland/souk/sql.clj

@@ -0,0 +1,56 @@
+(ns lambdaisland.souk.sql
+  (:require [clojure.string :as str]))
+
+(defn sql-ident [v]
+  (if (sequential? v)
+    (str/join "." (map sql-ident v))
+    (str "\""
+         (if (keyword? v)
+           (subs (str v) 1)
+           v)
+         "\"")))
+
+(defn sql-kw [k]
+  (str/upper-case
+   (str/replace
+    (if (keyword? k)
+      (name k)
+      k)
+    #"-" " ")))
+
+(defn sql-str [& ss]
+  (str "'" (str/replace (apply str ss) #"'" "''") "'"))
+
+(defn sql-list
+  ([items]
+   (sql-list "(" ")" ", " items))
+  ([before after separator items]
+   (str before (apply str (str/join separator items)) after)))
+
+(defn strs [& items]
+  (str/join " " items))
+
+(defn sql [& items]
+  (apply strs
+         (map (fn [x]
+                (cond
+                  (vector? x)
+                  (case (first x)
+                    :ident (sql-ident (second x))
+                    :kw (sql-kw (second x))
+                    :str (sql-str (second x))
+                    :raw (second x)
+                    :list (sql-list (map sql (next x)))
+                    :commas (sql-list "" "" ", " (map sql (next x)))
+                    :fn (str (second x)
+                             (sql-list (map sql (nnext x))))
+                    (apply sql x))
+                  (keyword? x)
+                  (sql-ident x)
+                  (symbol? x)
+                  (sql-kw x)
+                  (string? x)
+                  (sql-str x)
+                  (sequential? x)
+                  (sql-list "(" ")" ", " (map sql x))))
+              items)))