From: Siraaj Khandkar Date: Mon, 29 Nov 2021 04:24:22 +0000 (-0500) Subject: Define custom peers-union and simplify crawling X-Git-Tag: 0.27.1 X-Git-Url: https://git.xandkar.net/?p=tt.git;a=commitdiff_plain;h=50f0609d3fd9ea1ab8c37907c7d7ee7a80546e0a Define custom peers-union and simplify crawling --- diff --git a/info.rkt b/info.rkt index bc3947a..a31ac8e 100644 --- a/info.rkt +++ b/info.rkt @@ -6,7 +6,7 @@ (define pkg-desc "twtxt client") (define version - "0.27.0") + "0.27.1") (define pkg-authors '("Siraaj Khandkar ")) (define deps diff --git a/tt.rkt b/tt.rkt index 335fa6c..6ce0bd1 100644 --- a/tt.rkt +++ b/tt.rkt @@ -74,6 +74,43 @@ ; ; TODO Investigate why and make a minimal reproducible test case. +(define (peers-union . peer-sets) + (define groups + (foldl + (λ (p groups) + (hash-update groups (Peer-uri-str p) (λ (group) (cons p group)) '())) + (hash) + (append* (map set->list peer-sets)))) + (define (merge peers) + (match peers + ['() (raise 'impossible)] + [(list p) p] + [(list* p1 p2 ps) + (let* ([n1 (Peer-nick p1)] + [n2 (Peer-nick p2)] + [p (cond + [(and (not n1) (not n2)) p1] + [(and n1 n2 ) p1] + [(and n1 (not n2)) p1] + [(and (not n1) n2) p2] + [else + (raise 'impossible)])]) + (merge (cons p ps)))])) + (make-immutable-peers (map merge (hash-values groups)))) + +(module+ test + (let* ([u1 "http://foo/bar"] + [u2 "http://baz/quux"] + [p1 (Peer #f (string->url u1) u1 #f)] + [p2 (Peer "a" (string->url u1) u1 #f)] + [p3 (Peer "b" (string->url u2) u2 #f)] + [s1 (make-immutable-peers (list p1))] + [s2 (make-immutable-peers (list p2 p3))]) + (check-true (peers? (peers-union s1 s2))) + (check-true (peers? (peers-union s2 s1))) + (check-equal? (list p3 p2) (set->list (peers-union s1 s2))) + (check-equal? (list p3 p2) (set->list (peers-union s2 s1))))) + (: tt-home-dir Path-String) (define tt-home-dir (build-path (expand-user-path "~") ".tt")) @@ -224,7 +261,7 @@ [tzs (list* "" "Z" tzs)]) (for* ([n '("fake-nick")] [u '("http://fake-uri")] - [p (list (Peer n (string->url u) u ""))] + [p (list (Peer n (string->url u) u #f))] [s '("" ":10")] [f '("" ".1337")] [z tzs] @@ -245,7 +282,7 @@ [text "Lorem ipsum"] [nick "foo"] [uri "http://bar/"] - [peer (Peer nick (string->url uri) uri "")] + [peer (Peer nick (string->url uri) uri #f)] [actual (str->msg peer (string-append ts tab text))] [expected (Msg 1605756129 ts peer text '())]) (check-equal? @@ -650,7 +687,7 @@ (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"))) -(: peers->timeline (-> (Listof Peer) (Listof Msg))) +(: peers->timeline (-> (Setof Peer) (Listof Msg))) (define (peers->timeline peers) (append* (filter-map peer->msgs (set->list peers)))) @@ -674,38 +711,27 @@ [paths (log-debug "Peer ref file paths provided: ~v" paths) (map string->path paths)])] - [peers (apply set-union (map file->peers paths))]) + [peers (apply peers-union (map file->peers paths))]) (log-info "Read-in ~a peers." (set-count peers)) peers)) -(: mentioned-peers-in-cache (-> (Setof Peer))) -(define (mentioned-peers-in-cache) - ; TODO Expire cache - (define msgs - (append* (map (λ (filename) - (define path (build-path cache-object-dir filename)) - (define size (/ (file-size path) 1000000.0)) - (log-debug "BEGIN parsing ~a MB from file: ~v" - size - (path->string path)) - (define t0 (current-inexact-milliseconds)) - (define m (filter-map - (λ (line) - (define url-str (uri-decode (path->string filename))) - (define url (string->url url-str)) - (define from (Peer #f url url-str "")) - (str->msg from line)) - (filter-comments - (file->lines path)))) - (define t1 (current-inexact-milliseconds)) - (log-debug "END parsing ~a MB in ~a seconds from file: ~v." - size - (* 0.001 (- t1 t0)) - (path->string path)) - (when (empty? m) - (log-debug "No messages found in ~a" (path->string path))) - m) - (directory-list cache-object-dir)))) +(: cache-filename->peer (-> Path-String (Option Peer))) +(define (cache-filename->peer filename) + (define nick #f) ; TODO Look it up in the nick-db when it exists. + (define url-str (uri-decode (path->string filename))) ; TODO Can these crash? + (match (str->url url-str) + [#f #f] + [url (Peer nick url url-str #f)])) + +(: peers-cached (-> (Setof Peer))) +(define (peers-cached) + ; TODO Expire cache? + (make-immutable-peers + (filter-map cache-filename->peer + (directory-list cache-object-dir)))) + +(: peers-mentioned (-> (Listof Msg) (Setof Peer))) +(define (peers-mentioned msgs) (make-immutable-peers (append* (map Msg-mentions msgs)))) (: log-writer-stop (-> Thread Void)) @@ -740,24 +766,32 @@ (build-path tt-home-dir "peers-mentioned")] [peers-parsed-file (build-path tt-home-dir "peers-parsed")] + [peers-cached-file + (build-path tt-home-dir "peers-cached")] + [peers-cached + (peers-cached)] + [cached-timeline + (peers->timeline peers-cached)] [peers-mentioned-curr - (mentioned-peers-in-cache)] + (peers-mentioned cached-timeline)] [peers-mentioned-prev (file->peers peers-mentioned-file)] [peers-mentioned - (set-union peers-mentioned-prev - peers-mentioned-curr)] + (peers-union peers-mentioned-prev + peers-mentioned-curr)] [peers-all-prev (file->peers peers-all-file)] [peers-all - (set-union peers-mentioned - peers-all-prev)] + (peers-union peers-mentioned + peers-all-prev + peers-cached)] [peers-discovered (set-subtract peers-all peers-all-prev)] [peers-parsed (for/set ([p peers-all] #:when (> (length (peer->msgs p)) 0)) p)]) ; TODO Deeper de-duping + (log-info "Known peers cached ~a" (set-count peers-cached)) (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)) @@ -767,6 +801,8 @@ (match-lambda [(Peer n _ u c) (list n u c)]) (set->list peers-discovered)))) + (peers->file peers-cached + peers-cached-file) (peers->file peers-mentioned peers-mentioned-file) (peers->file peers-parsed