001  (ns clj-activitypub.core
002    (:require [clj-activitypub.internal.crypto :as crypto]
003              [clj-activitypub.internal.thread-cache :as thread-cache]
004              [clj-activitypub.internal.http-util :as http]
005              [clj-http.client :as client]
006              [clojure.string :as str]))
007  
008  (defn config
009    "Creates hash of computed data relevant for most ActivityPub utilities."
010    [{:keys [domain username username-route public-key private-key]
011      :or {username-route "/users/"
012           public-key nil
013           private-key nil}}]
014    (let [base-url (str "https://" domain)]
015      {:domain domain
016       :base-url base-url
017       :username username
018       :user-id (str base-url username-route username)
019       :public-key public-key
020       :private-key (when private-key
021                      (crypto/private-key private-key))}))
022  
023  (defn parse-account
024    "Given an ActivityPub handle (e.g. @jahfer@mastodon.social), produces
025     a map containing {:domain ... :username ...}."
026    [handle]
027    (let [[username domain] (filter #(not (str/blank? %))
028                                    (str/split handle #"@"))]
029      {:domain domain :username username}))
030  
031  (def ^:private user-cache (thread-cache/make))
032  (defn fetch-user
033    "Fetches the customer account details located at user-id from a remote
034     server. Will return cached results if they exist in memory."
035    [user-id]
036    ((:get-v user-cache)
037     user-id
038     #(:body
039       (client/get user-id {:as :json-string-keys
040                            :throw-exceptions false
041                            :ignore-unknown-host? true
042                            :headers {"Accept" "application/activity+json"}}))))
043  
044  (defn actor
045    "Accepts a config, and returns a map in the form expected by the ActivityPub
046     spec. See https://www.w3.org/TR/activitypub/#actor-objects for reference."
047    [{:keys [user-id username public-key]}]
048    {"@context" ["https://www.w3.org/ns/activitystreams"
049                 "https://w3id.org/security/v1"]
050     :id user-id
051     :type "Person"
052     :preferredUsername username
053     :inbox (str user-id "/inbox")
054     :outbox (str user-id "/outbox")
055     :publicKey {:id (str user-id "#main-key")
056                 :owner user-id
057                 :publicKeyPem (or public-key "")}})
058  
059  (def signature-headers ["(request-target)" "host" "date" "digest"])
060  
061  (defn- str-for-signature [headers]
062    (let [headers-xf (reduce-kv
063                      (fn [m k v]
064                        (assoc m (str/lower-case k) v)) {} headers)]
065      (->> signature-headers
066           (select-keys headers-xf)
067           (reduce-kv (fn [coll k v] (conj coll (str k ": " v))) [])
068           (interpose "\n")
069           (apply str))))
070  
071  (defn gen-signature-header
072    "Generates a HTTP Signature string based on the provided map of headers."
073    [config headers]
074    (let [{:keys [user-id private-key]} config
075          string-to-sign (str-for-signature headers)
076          signature (crypto/base64-encode (crypto/sign string-to-sign private-key))
077          sig-header-keys {"keyId" user-id
078                           "headers" (str/join " " signature-headers)
079                           "signature" signature}]
080      (->> sig-header-keys
081           (reduce-kv (fn [m k v]
082                        (conj m (str k "=" "\"" v "\""))) [])
083           (interpose ",")
084           (apply str))))
085  
086  (defn auth-headers
087    "Given a config and request map of {:body ... :headers ...}, returns the
088     original set of headers with Signature and Digest attributes appended."
089    [config {:keys [body headers]}]
090    (let [digest (http/digest body)
091          h (-> headers
092                (assoc "Digest" digest)
093                (assoc "(request-target)" "post /inbox"))]
094      (assoc headers
095             "Signature" (gen-signature-header config h)
096             "Digest" digest)))
097  
098  (defmulti obj
099    "Produces a map representing an ActivityPub object which can be serialized
100     directly to JSON in the form expected by the ActivityStreams 2.0 spec.
101     See https://www.w3.org/TR/activitystreams-vocabulary/ for reference."
102    (fn [_config object-data] (:type object-data)))
103  
104  (defmethod obj :note
105    [{:keys [user-id]}
106     {:keys [id published inReplyTo content to]
107      :or {published (http/date)
108           inReplyTo ""
109           to "https://www.w3.org/ns/activitystreams#Public"}}]
110    {"id" (str user-id "/notes/" id)
111     "type" "Note"
112     "published" published
113     "attributedTo" user-id
114     "inReplyTo" inReplyTo
115     "content" content
116     "to" to})
117  
118  (defmulti activity
119    "Produces a map representing an ActivityPub activity which can be serialized
120     directly to JSON in the form expected by the ActivityStreams 2.0 spec.
121     See https://www.w3.org/TR/activitystreams-vocabulary/ for reference."
122    (fn [_config activity-type _data] activity-type))
123  
124  (defmethod activity :create [{:keys [user-id]} _ data]
125    {"@context" ["https://www.w3.org/ns/activitystreams"
126                 "https://w3id.org/security/v1"]
127     "type" "Create"
128     "actor" user-id
129     "object" data})
130  
131  (defmethod activity :delete [{:keys [user-id]} _ data]
132    {"@context" ["https://www.w3.org/ns/activitystreams"
133                 "https://w3id.org/security/v1"]
134     "type" "Delete"
135     "actor" user-id
136     "object" data})
137  
138  (defn with-config
139    "Returns curried forms of the #activity and #obj multimethods in the form
140     {:activity ... :obj ...}, with the initial parameter set to config."
141    [config]
142    (let [f (juxt
143             #(partial activity %)
144             #(partial obj %))
145          [activity-fn obj-fn] (f config)]
146      {:activity activity-fn
147       :obj obj-fn}))