From: Siraaj Khandkar Date: Sun, 28 Nov 2021 18:03:09 +0000 (-0500) Subject: Dedup peers by URI X-Git-Tag: 0.27.1~2 X-Git-Url: https://git.xandkar.net/?p=tt.git;a=commitdiff_plain;h=e2840743f64574b3976276d735a1a4b83de17fba Dedup peers by URI --- diff --git a/info.rkt b/info.rkt index a975edd..bc3947a 100644 --- a/info.rkt +++ b/info.rkt @@ -6,7 +6,7 @@ (define pkg-desc "twtxt client") (define version - "0.26.1") + "0.27.0") (define pkg-authors '("Siraaj Khandkar ")) (define deps diff --git a/tt.rkt b/tt.rkt index 9df149c..d90c0f4 100644 --- a/tt.rkt +++ b/tt.rkt @@ -38,6 +38,7 @@ (struct Peer ([nick : (Option String)] [uri : Url] + [uri-str : String] [comment : (Option String)]) #:transparent) @@ -47,6 +48,27 @@ [body-input : Input-Port]) #:transparent) +(define-custom-set-types peers + #:elem? Peer? + (λ (p1 p2) + (equal? (Peer-uri-str p1) + (Peer-uri-str p2))) + (λ (p) + (equal-hash-code (Peer-uri-str p)))) +; XXX Without supplying above explicit hash procedure, we INTERMITTENTLY get +; the following contract violations: +; +; custom-elem-contents: contract violation +; expected: custom-elem? +; given: #f +; context...: +; /usr/share/racket/collects/racket/private/set-types.rkt:104:0: custom-set->list +; /home/siraaj/proj/pub/tt/tt.rkt:716:0: crawl +; /usr/share/racket/collects/racket/cmdline.rkt:191:51 +; body of (submod "/home/siraaj/proj/pub/tt/tt.rkt" main) +; +; TODO Investigate why and make a minimal reproducible test case. + (: tt-home-dir Path-String) (define tt-home-dir (build-path (expand-user-path "~") ".tt")) @@ -317,7 +339,8 @@ [#f (log-error "Invalid URI in peer string: ~v" str) #f] - [url (Peer nick url comment)])] + [url + (Peer nick url (url->string url) comment)])] [_ (log-debug "Invalid peer string: ~v" str) #f])) @@ -325,28 +348,28 @@ (module+ test (check-equal? (str->peer "foo http://bar/file.txt # some rando") - (Peer "foo" (str->url "http://bar/file.txt") "some rando")) + (Peer "foo" (str->url "http://bar/file.txt") "http://bar/file.txt" "some rando")) (check-equal? (str->peer "http://bar/file.txt # some rando") - (Peer #f (str->url "http://bar/file.txt") "some rando")) + (Peer #f (str->url "http://bar/file.txt") "http://bar/file.txt" "some rando")) (check-equal? (str->peer "http://bar/file.txt #") - (Peer #f (str->url "http://bar/file.txt") "")) + (Peer #f (str->url "http://bar/file.txt") "http://bar/file.txt" "")) (check-equal? (str->peer "http://bar/file.txt#") ; XXX URLs can have #s - (Peer #f (str->url "http://bar/file.txt#") #f)) + (Peer #f (str->url "http://bar/file.txt#") "http://bar/file.txt#" #f)) (check-equal? (str->peer "http://bar/file.txt") - (Peer #f (str->url "http://bar/file.txt") #f)) + (Peer #f (str->url "http://bar/file.txt") "http://bar/file.txt" #f)) (check-equal? (str->peer "foo http://bar/file.txt") - (Peer "foo" (str->url "http://bar/file.txt") #f)) + (Peer "foo" (str->url "http://bar/file.txt") "http://bar/file.txt" #f)) (check-equal? (str->peer "foo bar # baz") #f) (check-equal? (str->peer "foo bar://baz # quux") - (Peer "foo" (str->url "bar://baz") "quux")) + (Peer "foo" (str->url "bar://baz") "bar://baz" "quux")) (check-equal? (str->peer "foo bar//baz # quux") #f)) @@ -355,30 +378,34 @@ (define (filter-comments lines) (filter-not (λ (line) (string-prefix? line "#")) lines)) -(: str->peers (-> String (Listof Peer))) +(: str->peers (-> String (Setof Peer))) (define (str->peers str) - (filter-map str->peer (filter-comments (str->lines str)))) + (make-immutable-peers (filter-map str->peer (filter-comments (str->lines str))))) -(: peers->file (-> (Listof Peers) Path-String Void)) +(: peers->file (-> (Setof Peers) Path-String Void)) (define (peers->file peers path) (display-lines-to-file (map (match-lambda - [(Peer n u c) + [(Peer n _ u c) (format "~a~a~a" (if n (format "~a " n) "") - (url->string u) + u (if c (format " # ~a" c) ""))]) - peers) + (sort (set->list peers) + (match-lambda** + [((Peer n1 _ _ _) (Peer n2 _ _ _)) + (stringpeers (-> Path-String (Listof Peer))) +(: file->peers (-> Path-String (Setof Peer))) (define (file->peers file-path) (if (file-exists? file-path) (str->peers (file->string file-path)) (begin (log-warning "File does not exist: ~v" (path->string file-path)) - '()))) + (make-immutable-peers)))) (define re-rfc2822 #px"^(Mon|Tue|Wed|Thu|Fri|Sat|Sun), ([0-9]{2}) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) ([0-9]{4}) ([0-2][0-9]):([0-6][0-9]):([0-6][0-9]) GMT") @@ -426,9 +453,9 @@ [user-peer-file (build-path tt-home-dir "me")] [user (if (file-exists? user-peer-file) - (match (first (file->peers user-peer-file)) - [(Peer #f u _) (format "+~a" (url->string u) )] - [(Peer n u _) (format "+~a; @~a" (url->string u) n)]) + (match (set-first (file->peers user-peer-file)) + [(Peer #f _ u _) (format "+~a" u )] + [(Peer n _ u _) (format "+~a; @~a" u n)]) (format "+~a" prog-uri))]) (format "~a/~a (~a)" prog-name prog-version user))) @@ -563,8 +590,8 @@ (: peer->msgs (-> Peer (Listof Msg))) (define (peer->msgs peer) - (match-define (Peer nick uri _) peer) - (log-debug "Reading peer nick:~v uri:~v" nick (url->string uri)) + (match-define (Peer nick uri uri-str _) peer) + (log-debug "Reading peer nick:~v uri:~v" nick uri-str) (define msgs-data (uri-read-cached uri)) ; TODO Expire cache (if msgs-data @@ -576,8 +603,7 @@ (Result (U 'skipped-cached 'downloaded-new) Any))) (define (peer-download timeout peer) - (match-define (Peer nick uri _) peer) - (define u (url->string uri)) + (match-define (Peer nick uri u _) peer) (log-info "Download BEGIN URL:~a" u) (define-values (results _tm-cpu-ms tm-real-ms _tm-gc-ms) (time-apply uri-download (list timeout uri))) @@ -588,12 +614,12 @@ result) result) -(: timeline-download (-> Integer Positive-Float (Listof Peer) Void)) +(: timeline-download (-> Integer Positive-Float (Setof Peer) Void)) (define (timeline-download num-workers timeout peers) (define results (concurrent-filter-map num-workers (λ (p) (cons p (peer-download timeout p))) - peers)) + (set->list peers))) (define peers-ok (filter-map (match-lambda [(cons p (cons 'ok _)) p] @@ -609,15 +635,11 @@ (peers->file peers-ok (build-path tt-home-dir "peers-last-downloaded-ok")) (peers->file peers-err (build-path tt-home-dir "peers-last-downloaded-err"))) -(: uniq (∀ (α) (-> (Listof α) (Listof α)))) -(define (uniq xs) - (set->list (list->set xs))) - -(: peers->timeline (-> (listof Peer) (listof Msg))) +(: peers->timeline (-> (Listof Peer) (Listof Msg))) (define (peers->timeline peers) - (append* (filter-map peer->msgs peers))) + (append* (filter-map peer->msgs (set->list peers)))) -(: timeline-sort (-> (listof Msg) timeline-order (Listof Msgs))) +(: timeline-sort (-> (Listof Msg) timeline-order (Listof Msgs))) (define (timeline-sort msgs order) (define cmp (match order ['old->new <] @@ -625,7 +647,7 @@ (sort msgs (λ (a b) (cmp (Msg-ts-epoch a) (Msg-ts-epoch b))))) -(: paths->peers (-> (Listof String) (Listof Peer))) +(: paths->peers (-> (Listof String) (Setof Peer))) (define (paths->peers paths) (let* ([paths (match paths ['() @@ -637,11 +659,11 @@ [paths (log-debug "Peer ref file paths provided: ~v" paths) (map string->path paths)])] - [peers (append* (map file->peers paths))]) - (log-info "Read-in ~a peers." (length peers)) - (uniq peers))) + [peers (apply set-union (map file->peers paths))]) + (log-info "Read-in ~a peers." (set-count peers)) + peers)) -(: mentioned-peers-in-cache (-> (Listof Peer))) +(: mentioned-peers-in-cache (-> (Setof Peer))) (define (mentioned-peers-in-cache) ; TODO Expire cache (define msgs @@ -666,7 +688,7 @@ (log-debug "No messages found in ~a" (path->string path))) m) (directory-list cache-object-dir)))) - (uniq (append* (map Msg-mentions msgs)))) + (make-immutable-peers (append* (map Msg-mentions msgs)))) (: log-writer-stop (-> Thread Void)) (define (log-writer-stop log-writer) @@ -694,12 +716,7 @@ (: crawl (-> Void)) (define (crawl) - (let* ([peers-sort - (λ (peers) (sort peers (match-lambda** - [((Peer n1 _ _) (Peer n2 _ _)) - (stringpeers peers-mentioned-file)] [peers-mentioned - (peers-sort (uniq (append peers-mentioned-prev - peers-mentioned-curr)))] + (set-union peers-mentioned-prev + peers-mentioned-curr)] [peers-all-prev (file->peers peers-all-file)] [peers-all - (list->set (append peers-mentioned - peers-all-prev))] + (set-union peers-mentioned + peers-all-prev)] [peers-discovered - (set-subtract peers-all (list->set peers-all-prev))] - [peers-all - (peers-sort (set->list peers-all))] + (set-subtract peers-all + peers-all-prev)] [peers-parsed - (filter - (λ (p) (< 0 (length (peer->msgs p)))) - peers-all)]) + (for/set ([p peers-all] #:when (> (length (peer->msgs p)) 0)) p)]) ; TODO Deeper de-duping - (log-info "Known peers mentioned: ~a" (length peers-mentioned)) - (log-info "Known peers parsed ~a" (length peers-parsed)) - (log-info "Known peers total: ~a" (length peers-all)) + (log-info "Known peers mentioned: ~a" (set-count peers-mentioned)) + (log-info "Known peers parsed ~a" (set-count peers-parsed)) + (log-info "Known peers total: ~a" (set-count peers-all)) (log-info "Discovered ~a new peers:~n~a" (set-count peers-discovered) (pretty-format (map - (λ (p) (cons (Peer-nick p) - (url->string (Peer-uri p)))) + (match-lambda + [(Peer n _ u c) (list n u c)]) (set->list peers-discovered)))) (peers->file peers-mentioned peers-mentioned-file) @@ -767,7 +781,7 @@ (define-values (_res _cpu real-ms _gc) (time-apply timeline-download (list num-workers timeout peers))) (log-info "Downloaded timelines from ~a peers in ~a seconds." - (length peers) + (set-count peers) (/ real-ms 1000.0)))) (: dispatch (-> String Void))