social-kit / src / ardegazu / social / envelope.cljs
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
;; ported-from: src/envelope.ts @ v1.2.0
;;
;; The social envelope: sign-then-wrap, one unit for every social message
;; (friend request/accept, invite, self-device sync) across every transport
;; (identity inbox, pair mailbox drop, live pair topic) — so dedup by envelope
;; id is uniform and no transport changes the trust story.
;;
;;   inner (canonical JSON, signed):
;;     { t, id, from: {pub, x, xs, name}, ts, exp, body, sig }
;;     sig = Ed25519(from.pub) over "social-env|v1|<ctx>|" + canon(inner minus sig)
;;   outer (what hits a mailbox / rides a topic):
;;     { v: 1, w: Wrap }   — wrapbox sealed to the recipient's SUITE X key
;;
;; The signature is INSIDE the wrap: non-recipients (and the mailbox node)
;; learn nothing, the recipient gets sender authenticity. `ctx` binds the wrap
;; to its destination so an envelope can never be replayed into a different
;; context.
;;
;; Wire-compat notes (pinned by the golden vectors): the wrapped PLAINTEXT is
;; JSON.stringify(inner) in INSERTION order (t,id,from{pub,x,xs,name},ts,exp,
;; body,sig) while only the SIGNATURE is over canon(); openEnvelope verifies
;; over the RAW from.name (?? "") and clamps only afterwards; the dedup key is
;; inner.id verbatim.
(ns ardegazu.social.envelope
  (:require [ardegazu.id.crypto :as id-crypto]
            [ardegazu.id.identity :as id-identity]
            [ardegazu.id.profile :as id-profile]
            [ardegazu.id.xkey :as id-xkey]
            [ardegazu.social.canon :as canon]
            [ardegazu.social.consts :as consts]
            [shadow.cljs.modern :refer (defclass)])
  (:require-macros [ardegazu.social.macros :refer [awaits obj oget]]))

(def ^:private td (js/TextDecoder.))

(defn- js-object?
  "`v` is a non-null JavaScript object. NOT cljs.core/object?, which is
  `(identical? (type x) js/Object)` and therefore answers false for anything
  with a prototype — the opposite of what a shape check wants."
  [v]
  (and (some? v) (identical? (js* "typeof ~{}" v) "object")))

(defn- parse-json
  "JSON.parse or nil. Every parse in this namespace is of hostile bytes, and
  the discipline is drop-silently, so there is exactly one shape for failure."
  [s]
  (try (js/JSON.parse s) (catch :default _ nil)))

(defn- sig-bytes [ctx unsigned]
  (id-crypto/utf8 (str "social-env|v1|" ctx "|" (canon/canon unsigned))))

(defn build-envelope
  "Build a sealed envelope addressed to (toIdPub, toXPub) in context `ctx`."
  [self ctx to-id-pub to-x-pub t body ttl-ms]
  (awaits [_ (js/Promise.resolve nil)]
    (let [ttl (if (identical? ttl-ms js/undefined) consts/ENV-DEFAULT-TTL-MS ttl-ms)
          ts (js/Date.now)
          identity (oget self "identity")
          ;; insertion order IS the wrapped plaintext's key order
          unsigned (obj "t" t
                        "id" (id-crypto/to-b64url (id-crypto/random-bytes 16))
                        "from" (obj "pub" (oget identity "publicKeyB64")
                                    "x" (oget self "x" "pubB64")
                                    "xs" (oget self "xCert")
                                    "name" (oget self "name"))
                        "ts" ts
                        "exp" (+ ts ttl)
                        "body" body)]
      (awaits [sig-raw (.signRaw ^js identity (sig-bytes ctx unsigned))]
        (let [inner (js/Object.assign (js-obj) unsigned)]
          ;; sig is appended, never part of what it signs
          (unchecked-set inner "sig" (id-crypto/to-b64url sig-raw))
          (awaits [w (id-xkey/wrap-to id-xkey/SUITE-SALT ctx to-id-pub to-x-pub
                                      (id-crypto/utf8 (js/JSON.stringify inner)))]
            (let [outer (obj "v" 1 "w" w)]
              (obj "bytes" (id-crypto/utf8 (js/JSON.stringify outer))
                   "id" (oget inner "id")
                   "outer" outer))))))))

(defn- signed-inner?
  "Is this a well-formed, unexpired signed record? A PREDICATE, not a decoder:
  the fields are read straight off the JS object afterwards.

  It would read better as `(when … {:t t :id id …})`, and that is what the rest
  of this rewrite does everywhere it can — but not in this dist. social-kit's
  shipped bundle contains no ClojureScript collection whatsoever, so :advanced
  has dead-code-eliminated the entire cljs.core seq/collection/keyword runtime.
  Measured: ONE seven-key map literal here puts it back and costs +19 KB
  gzipped, and shadow hoists it into the :shared module, so `./join` — the
  dependency-free chip nine apps load at first paint — pays all of it. The
  cliff is at the first use of any Clojure collection abstraction, not at the
  tenth: map/filter/reduce over a JS array costs the same +19 KB, and adding
  literals on top costs a further 240 bytes in total."
  [inner]
  (and (js-object? inner)
       (string? (oget inner "t"))
       (string? (oget inner "id"))
       (string? (oget inner "sig"))
       (some? (oget inner "from"))
       (string? (oget inner "from" "pub"))
       (string? (oget inner "from" "x"))
       (string? (oget inner "from" "xs"))
       (number? (oget inner "ts"))
       (number? (oget inner "exp"))
       (js-object? (oget inner "body"))
       (<= (js/Date.now) (oget inner "exp"))))

(defn open-envelope
  "Open + fully verify an envelope addressed to us in context `ctx`.
  null on ANY failure (not for us, tampered, forged cert/sig, expired,
  malformed) — callers drop silently, per the suite's crypto discipline."
  [my-x ctx bytes]
  (awaits [_ (js/Promise.resolve nil)]
    (let [outer (parse-json (.decode td bytes))
          w (when (some? outer) (oget outer "w"))]
      (if-not (and (some? outer) (identical? 1 (oget outer "v")) (js-object? w))
        nil
        (awaits [pt (id-xkey/unwrap id-xkey/SUITE-SALT ctx w my-x)]
          (let [inner (when (some? pt) (parse-json (.decode td pt)))]
            (if-not (signed-inner? inner)
              nil
              ;; cert first — it binds the X key to the Ed25519 identity, so a
              ;; forged cert is rejected before its key is ever trusted
              (let [from (oget inner "from")
                    t (oget inner "t")
                    env-id (oget inner "id")
                    ts (oget inner "ts")
                    exp (oget inner "exp")
                    body (oget inner "body")
                    sig (oget inner "sig")]
                (awaits [cert-ok (id-xkey/verify-x-cert id-xkey/SUITE-SALT
                                                       (oget from "pub")
                                                       (oget from "x")
                                                       (oget from "xs"))]
                  (if-not cert-ok
                    nil
                    ;; The signature covers a COPY of `from`, not a rebuild of
                    ;; it: any key a sender carries beyond pub/x/xs/name is
                    ;; inside canon() and therefore inside what was signed.
                    (let [raw-name (oget from "name")
                          clamped (oget (id-profile/clamp-profile (obj "name" raw-name)) "name")
                          signed-from (js/Object.assign (js-obj) from)
                          ;; verify over the RAW name with `?? ""` — nil? here
                          ;; is `== null`, which is exactly the ?? the sender
                          ;; applied when it built the record
                          _ (unchecked-set signed-from "name" (if (nil? raw-name) "" raw-name))
                          unsigned (obj "t" t "id" env-id "from" signed-from
                                        "ts" ts "exp" exp "body" body)]
                      (awaits [sig-ok (id-identity/verify-raw (oget from "pub") sig
                                                             (sig-bytes ctx unsigned))]
                        (if-not sig-ok
                          nil
                          ;; the clamp lands only here, on a second copy —
                          ;; never on anything the signature covered
                          (let [out-from (js/Object.assign (js-obj) signed-from)]
                            (unchecked-set out-from "name" clamped)
                            (obj "t" t "id" env-id "from" out-from
                                 "ts" ts "exp" exp "body" body
                                 "sig" sig)))))))))))))))

;; Persisted dedup ring for envelope ids (drop-oldest, try/catch storage).
;; Public surface for TS consumers: "cap" field, has(id), add(id).
(defclass SeenRing
  (constructor [this storage-key cap]
    (let [cap (if (identical? cap js/undefined) consts/SEEN-ENV-CAP cap)
          raw (try (js/JSON.parse (or (js/localStorage.getItem storage-key) "[]"))
                   (catch :default _ #js [])) ; fresh ring
          ids (if (js/Array.isArray raw)
                (-> ^js raw
                    (.filter (fn [x] (string? x)))
                    (.slice (- cap)))
                #js [])]
      (unchecked-set this "_key" storage-key)
      (unchecked-set this "_ids" ids)
      (unchecked-set this "_set" (js/Set. ids))
      (unchecked-set this "cap" cap))))

(let [proto (.-prototype SeenRing)]
  (unchecked-set proto "has"
                 (fn [env-id]
                   (this-as self (.has ^js (oget self "_set") env-id))))
  (unchecked-set proto "add"
                 (fn [env-id]
                   (this-as self
                     (let [ids ^js (oget self "_ids")
                           idset ^js (oget self "_set")
                           cap (oget self "cap")]
                       (when-not (.has idset env-id)
                         (.push ids env-id)
                         (.add idset env-id)
                         (while (> (.-length ids) cap)
                           (let [dropped (.shift ids)]
                             (when-not (identical? dropped js/undefined)
                               (.delete idset dropped))))
                         (try
                           (js/localStorage.setItem (oget self "_key")
                                                    (js/JSON.stringify ids))
                           (catch :default _ nil))) ; private mode: session-only dedup
                       js/undefined)))))

static mirror of HEAD · about · clone: git clone https://git.ardegazu.ro/social-kit.git