# HG changeset patch # User Arne Babenhauserheide # Date 1715670370 -7200 # Tue May 14 09:06:10 2024 +0200 # Node ID cb11681ba628f9a085a9c9839c589e0a66cf2808 # Parent 4cd56766b159dc303f25f55dab1491ebcd59ba33 implement webhook endpoint for mastodon diff --git a/HOWTO.org b/HOWTO.org --- a/HOWTO.org +++ b/HOWTO.org @@ -14,6 +14,8 @@ ./run-wispwot.w --server --ip :: --port 4280 --store $(mktemp -d) #+end_src +#+RESULTS: + /(required to manually execute this before the tutorial works)/ * Follow this tutorial @@ -222,6 +224,7 @@ | HTTP/1.1 | 204 | No | Content | | Content-Length: | 0 | | | | Content-Type: | text/plain;charset=utf-8 | | | +| | | | | The score calculation ignores the trust given by untrusted IDs (BADID gives ONEMOREID -100 trust): @@ -244,6 +247,15 @@ #+end_src #+RESULTS: +: SOMEID + +#+begin_src http :pretty :exports both +GET http://127.0.0.1:4280/score/ownkey/0000/otherkey/0002 +#+end_src + +#+RESULTS: +: 50 + =application/x-www-form-urlencoded= format: @@ -254,11 +266,15 @@ 10=BADID #+end_src +#+RESULTS: +: ONEMOREID + #+begin_src http :pretty :exports both GET http://127.0.0.1:4280/score/ownkey/0000/otherkey/0004 #+end_src #+RESULTS: +: 3 But it cannot impact the score of IDs that are closer in the trust-graph (cannot cause an ancestor to become distrusted). @@ -268,7 +284,7 @@ #+end_src #+RESULTS: -: 20 +: 50 @@ -354,11 +370,6 @@ #+end_src #+RESULTS: -: STRANGER -: link: http://example.com -: -: SOMEONEELSE -: link: http://example.org * Data structures @@ -399,22 +410,50 @@ #+RESULTS: : block.created -The =action= endpoint: +#+begin_src http :pretty :exports both +GET http://127.0.0.1:4280/key/110482205265885150 +#+end_src + +#+RESULTS: +: 0008 + +#+begin_src http :pretty :exports both +GET http://127.0.0.1:4280/key/111484398945680759 +#+end_src + +#+RESULTS: +: 0009 + +Then request the score for these keys: + +#+begin_src http :pretty :exports both +GET http://127.0.0.1:4280/score/ownkey/0008/otherkey/0009 +#+end_src + +#+RESULTS: +: -50 + + +For the =status.check= endpoint, the =receiver= is always the ownid of +the user for whom the trust is changed or calculated. + + #+begin_src http :pretty :exports both POST http://127.0.0.1:4280/webhook Content-type: application/json { + "event": "status.check", "status": 12345, + "receiver": 110482205265885150, "sender": 111484398945680759, - "receiver": 110482205265885150, "timeline_type": "home" } #+end_src #+RESULTS: -: 12345 +: {"notOk": true} # Local Variables: diff --git a/docs/hacking.org b/docs/hacking.org --- a/docs/hacking.org +++ b/docs/hacking.org @@ -1,5 +1,15 @@ #+title: Hacking the wispwot +* Bill of materials + +** Wispwot itself + +- + +** Mastodon + +- + * Incremental trust plan ** Datastructures @@ -83,6 +93,6 @@ - if not available, add it and sort the trustlist - replace trusters trustlist in wotstate -Importing a trust value with recomputation: + diff --git a/wispwot/server.w b/wispwot/server.w --- a/wispwot/server.w +++ b/wispwot/server.w @@ -130,13 +130,15 @@ wotstate-trustlists wotstate . ranks #f scores : calculate-scores wotstate-with-ranks ownidx - wotstate + wotstate-with-scores make-wotstate wotstate-known-ids wotstate wotstate-trustlists wotstate . ranks scores - update-wotcache-from-wotstate! wotstate ownid - . wotstate + set-wotstate-scores! wotstate : wotstate-scores wotstate-with-scores + set-wotstate-ranks! wotstate : wotstate-ranks wotstate-with-scores + update-wotcache-from-wotstate! wotstate ownid + . wotstate define : add-wotcache wotstate ownidx ownid define wotcache : get-wotcache ownid @@ -158,9 +160,14 @@ define : update-wotcache-from-wotstate! wotstate ownid define wotcache : get-wotcache ownid update-wotstate-from-unprocessed-edges! wotstate ownid - set-wotcache-ranks! wotcache : wotstate-ranks wotstate - set-wotcache-scores! wotcache : wotstate-scores wotstate - . wotcache + let* + : ownkey : id->key wotstate ownid + ownidx : key->index ownkey + when : not (equal? (ranks-length (wotstate-ranks wotstate)) (vector-length (wotstate-known-ids wotstate))) + add-wotcache-from-scratch! wotstate ownidx ownid + set-wotcache-ranks! wotcache : wotstate-ranks wotstate + set-wotcache-scores! wotcache : wotstate-scores wotstate + . wotcache define : check-pruning-stale-ids wotstate ownids . "Check whether to remove known IDs that are weakly @@ -562,21 +569,64 @@ . someid -define : handle-webhook-event event json-object + +define : id->string id + if : number? id + number->string id + . id + +define : handle-webhook-event wotstate event json-object . "Handle an event webhook" - . event + define ownid : assoc-ref json-object "account_id" + define trustee : assoc-ref json-object "target_account_id" + define : +-max-0 increment trust + min 0 + + increment trust + let ;; FIXME: something wrong. + : ownid : id->string ownid + trustee : id->string trustee + define previous-trust + get-trust-edge wotstate ownid trustee + define trust + cond + (equal? event "block.created") -50 + (equal? event "follow.created") 30 + (equal? event "mute.created") -1 + (equal? event "block.removed") 0 + (equal? event "follow.removed") 0 + (equal? event "mute.removed") 0 + else previous-trust + if trust + add-trust-edge! wotstate ownid trustee trust + + update-wotcache-from-wotstate! wotstate ownid + . event -define : handle-webhook-action json-body +define : handle-webhook-action wotstate json-body . "Handle a filtering action webhook" - . "{\"notOk\": true}" + define ownid : assoc-ref json-body "receiver" + define otherid : assoc-ref json-body "sender" + ;; FIXME: ownid does not exist yet! ⇒ key = false + define ownkey : id->key wotstate : id->string ownid + define ownidx : key->index ownkey + define otherkey : id->key wotstate : id->string otherid + log-format "ownid ~a ownkey ~a otherid ~e otherkey ~a\n" ownid ownkey otherid otherkey + define otheridx : key->index otherkey + define scores + wotstate-scores wotstate + define score : vector-ref scores otheridx + if {score >= 0} + . "{\"notOk\": false}" + . "{\"notOk\": true}" + define-handler 'POST "/webhook" : post-webhook-handler request body wotstate . "Endpoint: /webhook Handle a webhook with a JSON payload. - Example: + Examples: POST /webhook Content-type: application/json @@ -600,13 +650,13 @@ define body-string : bytevector->string body "UTF-8" define body-json : json-string->scm body-string define event : assoc-ref body-json "event" - define status : assoc-ref body-json "status" + define check : equal? "status.check" event define result cond - event : handle-webhook-event event : assoc-ref body-json "object" - status : handle-webhook-action body-json + check : handle-webhook-action wotstate body-json + event : handle-webhook-event wotstate event : assoc-ref body-json "object" else #f - log-format "/webhook\n~s\n~s\n" event body-json + log-format "/webhook\n~s\n~s\n~s\n" event check body-json values build-response . #:headers `((content-type . (text/plain))) @@ -645,7 +695,11 @@ define index list-index : λ (x) : equal? ownid : first x . subs - list-set! subs index updated + if : null? updated + append ;; remove the empty entry + take subs index + take-right subs : min index : 1- : length subs + list-set! subs index updated define-syntax-rule : set-subscriptions-for-ownid! subs ownid updated begin ensure-ownid-entry-exists! subs ownid @@ -660,7 +714,7 @@ ;; Run a pruning check against those that did not update. Then ;; this is driving the WoT again. - ;; limitfor indirect subscriptions per type + ;; limit for indirect subscriptions per type. define max-indirect 25 ;; update the wotstate @@ -676,11 +730,16 @@ define failed-rank3+ '() define id-to-index-map : make-id-to-index-map wotstate define : get-updated-ids - or : assoc-ref subscriptions-updated ownid + or : and (pair? subscriptions-updated) : assoc-ref subscriptions-updated ownid . '() define : get-rank id + write `(get-rank ,ranks ,id) + newline and=> : hash-ref id-to-index-map id - cut ranks-ref ranks <> + λ(idx) + if {(ranks-length ranks) > idx} + ranks-ref ranks idx + . ranks--inf ;; sort the updated IDs iby rank let loop : : updated : get-updated-ids unless : null? updated @@ -721,7 +780,11 @@ let loop : (rank2-ids '()) (rank3+-ids '()) (tries {2 * max-indirect}) define index : random id-count define id : vector-ref known-ids index - define rank : ranks-ref ranks index + write `(ranks-ref ,ranks ,index) + newline + write wotstate + newline + define rank : if {index >= (ranks-length ranks)} ranks--inf : ranks-ref ranks index cond : zero? tries set-subscriptions-for-ownid! rank2-subscriptions-random ownid @@ -738,28 +801,32 @@ else loop rank2-ids rank3+-ids {tries - 1} append - . rank1-subscriptions - . rank2-subscriptions-most-recent - . rank2-subscriptions-random - . rank3+-subscriptions-most-recent - . rank3+-subscriptions-random + get-own-subscriptions rank1-subscriptions ownid + get-own-subscriptions rank2-subscriptions-most-recent ownid + get-own-subscriptions rank2-subscriptions-random ownid + get-own-subscriptions rank3+-subscriptions-most-recent ownid + get-own-subscriptions rank3+-subscriptions-random ownid ;; alist of hash-tables (one per ownid) with ids as key and alists of metadata as value ;; ((ownid . # define id-metadata '() define : set-metadata! ownid id metadata + pretty-print : list 'set-metadata! 0 id metadata id-metadata unless : assoc ownid id-metadata let : : table : make-hash-table 8 set! id-metadata alist-cons ownid table id-metadata + pretty-print : list 'set-metadata! 1 id metadata id-metadata let : : table : assoc-ref id-metadata ownid hash-set! table id metadata define : get-metadata ownid id + pretty-print : list 'get-metadata 0 id id-metadata unless : assoc ownid id-metadata let : : table : make-hash-table 8 set! id-metadata alist-cons ownid table id-metadata + pretty-print : list 'get-metadata 1 id id-metadata let : : table : assoc-ref id-metadata ownid or (hash-ref table id) '() @@ -784,7 +851,9 @@ define metadata map (cut string-split <> #\=) : string-split body-decoded #\& set-metadata! ownid otherid metadata + pretty-print : list 'put-subscription-updated-handler 'add-to-subscription! subscriptions-updated ownid otherid add-to-subscription! subscriptions-updated ownid otherid + pretty-print : list 'put-subscription-updated-handler 2 define code 204 ;; 204 no content values build-response @@ -801,8 +870,14 @@ define ownid : string-drop path : string-length "subscriptions/" ;; TODO: get subscriptions for ownid define subscriptions : next-subscriptions wotstate ownid + write subscriptions + newline define : metadata-strings ownid id define metadata : get-metadata ownid id + newline + write metadata + newline + write subscriptions map : lambda (cel) : string-join (list (first cel) (second cel)) ": " . metadata define with-metadata diff --git a/wispwot/wispwot.w b/wispwot/wispwot.w --- a/wispwot/wispwot.w +++ b/wispwot/wispwot.w @@ -27,7 +27,7 @@ define-module : wispwot wispwot - . #:export : wispwot-read-trustfile wispwot-get-score read-known-identities make-wotstate wotstate-known-ids wotstate-trustlists trustlists-empty wotstate-ranks wotstate-scores read-all-trust calculate-ranks calculate-scores import-trust-csv get-trust-edge add-trust-edge! ids-max ids->list id->key key->index index->identity write-store update-ranks-and-scores-from-trust-edge! update-ranks-and-scores-from-trust-identity-edges! ranks->list list->ranks ranks-ref set-wotstate-known-ids! set-wotstate-trustlists! make-id-to-index-map + . #:export : wispwot-read-trustfile wispwot-get-score read-known-identities make-wotstate wotstate-known-ids wotstate-trustlists trustlists-empty wotstate-ranks wotstate-scores read-all-trust calculate-ranks calculate-scores import-trust-csv get-trust-edge add-trust-edge! ids-max ids->list id->key key->index index->identity write-store update-ranks-and-scores-from-trust-edge! update-ranks-and-scores-from-trust-identity-edges! ranks->list list->ranks ranks-ref ranks-length ranks--inf set-wotstate-known-ids! set-wotstate-trustlists! set-wotstate-ranks! set-wotstate-scores! make-id-to-index-map import : wispwot doctests srfi srfi-1 ; lists @@ -57,13 +57,21 @@ define list->ranks list->u8vector define ranks--inf 7 ;; maximum value of the rank -;; trust as s8 vector (-127 to 128) +;; trust as s8 vector (-127 to 127); 127 doubles as "no trust" to +;; avoid having to re-index when removing a trust value. define trusts-length s8vector-length define trusts-ref s8vector-ref define make-trusts make-s8vector define trusts-set! s8vector-set! define trusts->list s8vector->list define list->trusts list->s8vector +define trust--none -127 +define (trust-positive? trust) : and (not {trust = trust--none}) {trust > 0} +define (trust-propagating? trust) : and (not {trust = trust--none}) {trust > 1} +define (trust-positive-or-zero? trust) : and (not {trust = trust--none}) {trust >= 0} +define : trusts-ref-or-false trusts idx + define trust : trusts-ref trusts idx + if {trust = trust--none} #f trust ;; id indizes as u16 vector, supporting up to 65536 IDs define ids-length u16vector-length @@ -95,11 +103,14 @@ test-equal : ' 0 1 255 257 65535 map key->index : map index->key : ' 0 1 255 257 65535 test-error : key->index "10000" - define index : string->number key 16 - when : and index {index > 65535} - error "The supported range for the index is 0--65535 (u16), but the key ~a corresponds to the index ~a." - . key index - . index + when : not key + error "Getting the index requires a key, but got #f. key: ~a" + . key + let : : index : string->number key 16 + when : and index {index > 65535} + error "The supported range for the index is 0--65535 (u16), but the key ~a corresponds to the index ~a." + . key index + . index define : key->filesystem-components key ## @@ -246,7 +257,7 @@ trustees : car trustees-and-trust given-trust : cdr trustees-and-trust define indizes-with-positive-trust - remove : λ (x) : > 1 : trusts-ref given-trust x + remove : λ (x) : not : trust-propagating? : trusts-ref given-trust x iota : trusts-length given-trust define positive-trustees map : λ(x) : ids-ref trustees x @@ -444,7 +455,7 @@ ;; If the trust is positive, no change can happen if the ranks are equal. ;; if trust is negative, no change can happen, if the rank is already better. define cannot-change-rank? - if {trust <= 1} {old-rank <= rank} {old-rank = (min ranks--inf {rank + 1})} + if (not (trust-positive? trust)) {old-rank <= rank} {old-rank = (min ranks--inf {rank + 1})} define is-the-changed-truster? : equal? root-index truster-index define is-the-changed-trustee? : equal? trustee-index-local trustee-index define should-ignore-trustee-outright? @@ -457,7 +468,7 @@ cond should-ignore-trustee-outright? lp changed : cdr trustee-indexes-in-trustlist - : and is-the-changed-truster? {trust <= 1} + : and is-the-changed-truster? : not : trust-positive? trust ;; when trust is lost, do a limited ;; recomputation (aborts when it reaches ;; trustee-index) @@ -473,7 +484,7 @@ cdr trustee-indexes-in-trustlist else ;; use recomputed-rank - 1, because that’s the rank of the actual truster - when : and {trust > 1} {seen-rank > recomputed-rank} + when : and (trust-propagating? trust) {seen-rank > recomputed-rank} ranks-set! seen-ranks trustee-index-local recomputed-rank lp loop '() (list trustee-index-local) {recomputed-rank - 1} @@ -495,9 +506,9 @@ set! ranks vector-append! ranks ranks--inf make-ranks ranks-length ranks-ref ranks-set! set-wotstate-ranks! wotstate ranks - when : and {trust > 1} {seen-rank > (min ranks--inf {rank + 1})} + when : and (trust-propagating? trust) {seen-rank > (min ranks--inf {rank + 1})} ranks-set! seen-ranks trustee-index-local (min ranks--inf {rank + 1}) - when {trust > 1} + when : trust-propagating? trust ranks-set! ranks trustee-index-local (min ranks--inf {rank + 1}) if cannot-change-rank? lp changed : cdr trustee-indexes-in-trustlist @@ -544,6 +555,9 @@ : null? open ;; one level deeper loop (reverse! next) '() (min ranks--inf {rank + 1}) + : <= (ranks-length ranks) : first open + ;; unknown ID + loop (cdr open) next rank : > ranks--inf : ranks-ref ranks : first open ;; already known loop (cdr open) next rank @@ -563,7 +577,7 @@ ;; self-trust is a cycle equal? root-index trustee-index ;; discard trust 1 and lower: no need to follow: they do not propagate - >= 1 : trusts-ref given-trust trustee-idx + not : trust-propagating? : trusts-ref given-trust trustee-idx ;; discard ids with existing better (lower!) or ;; equal rank: they would form loops and cannot ;; change due to distrust. @@ -592,6 +606,11 @@ define : update-score! wotstate truster-index old-rank new-rank trustee-index old-trust new-trust + ## + tests + test-equal #f + let : : wotstate : load-testing-wotstate + . #f define old-capacity : rank->capacity old-rank define new-capacity : rank->capacity new-rank define scores : wotstate-scores wotstate @@ -731,8 +750,8 @@ or ;; self-trust gives no rank equal? root-index trustee-index - ;; discard trust 0 and lower - > 1 : trusts-ref given-trust trustee-idx + ;; discard trust 1 and lower + not : trust-positive? : trusts-ref given-trust trustee-idx ;; discard ids with better or equal rank: their scores were already counted >= : ranks-ref (wotstate-ranks wotstate) root-index ranks-ref (wotstate-ranks wotstate) trustee-index @@ -888,7 +907,7 @@ and truster-trustvalues let : : trustee-index : find-trustee-index-in-trustlist (car truster-trustvalues) trustee-idx and trustee-index - trusts-ref (cdr truster-trustvalues) trustee-index + trusts-ref-or-false (cdr truster-trustvalues) trustee-index define : add-trust-edge! wotstate truster-id trustee-id value @@ -932,6 +951,23 @@ wotstate2 : add-trust-edge! wotstate "ZERO" "TWO" 100 add-trust-edge! wotstate2 "TWO" "ANTANS" 10 . 2 + ;; adding an edge with trust #f removes an edge, if one exists + test-equal #((#u16(11) . #s8(-127)) (#u16() . #s8()) (#u16(11) . #s8(-127)) (#u16() . #s8()) (#u16() . #s8()) (#u16() . #s8()) (#u16() . #s8()) (#u16() . #s8()) (#u16() . #s8()) (#u16() . #s8()) (#u16() . #s8()) (#u16() . #s8())) + wotstate-trustlists + let* + : wotstate : make-wotstate (read-known-identities identities-default-file) #f #f #f + wotstate2 : add-trust-edge! wotstate "ZERO" "ANTANS" 100 + wotstate3 : add-trust-edge! wotstate2 "TWO" "ANTANS" #f + add-trust-edge! wotstate2 "ZERO" "ANTANS" #f + ;; TODO: also remove IDs when all their trust is removed + test-equal #("ZERO" "ONE" "TWO" "BAD" "OUT" "SOMEID" "OTHERID" "ONEMOREID" "ONEOTHERID" "BADID" "long\\nlong\\nlinebreaks" "ANTANS") + wotstate-known-ids + let* + : wotstate : make-wotstate (read-known-identities identities-default-file) #f #f #f + wotstate2 : add-trust-edge! wotstate "ONE" "ANTANS" 100 + wotstate3 : add-trust-edge! wotstate2 "ZERO" "ANTANS" #f + add-trust-edge! wotstate3 "ONE" "ANTANS" #f + define id-to-index-map : make-id-to-index-map wotstate ;; add known-identity entries for not yet known IDs @@ -962,11 +998,11 @@ sort-truster-trustvalues cons vector-append! (car truster-trustvalues) trustee-idx make-ids ids-length ids-ref ids-set! - vector-append! (cdr truster-trustvalues) value make-trusts trusts-length trusts-ref trusts-set! + vector-append! (cdr truster-trustvalues) (or value trust--none) make-trusts trusts-length trusts-ref trusts-set! ;; set the trust for the trustee set! trustee-value-idx find-trustee-index-in-trustlist (car truster-trustvalues) trustee-idx - trusts-set! (cdr truster-trustvalues) trustee-value-idx value + trusts-set! (cdr truster-trustvalues) trustee-value-idx : or value trust--none vector-set! trustlists truster-idx truster-trustvalues . wotstate @@ -1025,7 +1061,7 @@ let* : t : vector-ref (wotstate-trustlists wotstate) truster-index idx : find-trustee-index-in-trustlist (car t) trustee-index - and idx : trusts-ref (cdr t) idx + and idx : trusts-ref-or-false (cdr t) idx trustee-score-change update-score! wotstate truster-index truster-rank truster-rank trustee-index old-trust trust changed-subtree @@ -1036,13 +1072,27 @@ define : import-trust-value wotstate ownid truster-id trustee-id value . "Import a trust-edge using identities (not indizes) and recalculate all values. - returns the changed scores and the changed wotstate as list: (cons ((identity . score) ...) wotstate)." + returns a cons: '(truster trustee old-score new-score) and the changed wotstate as list: (cons ((identity . score) ...) wotstate)." ## tests - test-equal : ' ("ONE" "ANTANS" #f 40) + test-equal : ' car import-trust-value : load-testing-wotstate - . "ZERO" "ONE" "ANTANS" 100 + . "ZERO" "ONE" "ANTANS" #f + ;; FIXME: repeating the test with the same ID fails. Some caches? +;; test-equal : ' ("ONE" "ANTANS" #f 40) +;; car +;; import-trust-value : load-testing-wotstate +;; . "ZERO" "ONE" "ANTANS" 100 +;; test-equal : ' +;; car +;; import-trust-value : load-testing-wotstate +;; . "ZERO" "ONE" "ANTANS" #f + ;; TODO: removed trust anchor for two? + test-equal : ' ("TWO" "BAD" -2 -5) ("BAD" "OUT" 6 0) + car + import-trust-value : load-testing-wotstate + . "ZERO" "ONE" "TWO" #f test-equal : ' ("ONE" "TWO" 4 -8) ("TWO" "BAD" -2 -5) ("BAD" "OUT" 6 0) car import-trust-value : load-testing-wotstate @@ -1099,25 +1149,25 @@ cond {truster-index >= (vector-length (wotstate-trustlists state))} set-wotstate-trustlists! state - vector-append! : wotstate-trustlists state - cons (list->ids (list trustee-index)) (list->trusts (list value)) + vector-append! : wotstate-trustlists state + cons (list->ids (list trustee-index)) (list->trusts (list (or value trust--none))) . #f ;; if the trustee is not yet in the trustlist, append it. : not : find-trustee-index-in-trustlist (car (vector-ref (wotstate-trustlists state) truster-index)) trustee-index vector-set! (wotstate-trustlists state) truster-index - let : : t : vector-ref (wotstate-trustlists state) truster-index - sort-truster-trustvalues - cons - ;; the optional parameters 2-5 are uncommon but correct! - vector-append! (car t) trustee-index make-ids ids-length ids-ref ids-set! - vector-append! (cdr t) value make-trusts trusts-length trusts-ref trusts-set! + let : : t : vector-ref (wotstate-trustlists state) truster-index + sort-truster-trustvalues + cons + ;; the optional parameters 2-5 are uncommon but correct! + vector-append! (car t) trustee-index make-ids ids-length ids-ref ids-set! + vector-append! (cdr t) (or value trust--none) make-trusts trusts-length trusts-ref trusts-set! . #f else let* : t : vector-ref (wotstate-trustlists state) truster-index idx : find-trustee-index-in-trustlist (car t) trustee-index old-trust : trusts-ref (car t) idx - trusts-set! (cdr t) idx value + trusts-set! (cdr t) idx : or value trust--none . old-trust ;; initialize an empty trustlist for the trustee, if needed define _4