Validate crawled peers

[tt.git] / tt.rkt

diff --git a/tt.rkt b/tt.rkt
index ec46623..a375c69 100644 (file)
--- a/tt.rkt
+++ b/tt.rkt
@@ -282,8 +282,7 @@
 (define (url->cache-lmod-path uri)
   (build-path cache-dir "lmods" (uri-encode (url->string uri))))
 
-; TODO Return Option
-(: uri-read-cached (-> Url String))
+(: uri-read-cached (-> Url (Option String)))
 (define (uri-read-cached uri)
   (define path-v1 (url->cache-file-path-v1 uri))
   (define path-v2 (url->cache-file-path-v2 uri))
@@ -293,7 +292,7 @@
       (file->string path-v2)
       (begin
         (log-warning "Cache file not found for URI: ~a" (url->string uri))
-        "")))
+        #f)))
 
 (: str->url (-> String (Option String)))
 (define (str->url s)
@@ -566,7 +565,10 @@
 (define (peer->msgs peer)
   (match-define (Peer nick uri _) peer)
   (log-info "Reading peer nick:~v uri:~v" nick (url->string uri))
-  (str->msgs nick uri (uri-read-cached uri)))
+  (define msgs-data (uri-read-cached uri))
+  (if msgs-data
+      (str->msgs nick uri msgs-data)
+      '()))
 
 (: peer-download
    (-> Positive-Float Peer
@@ -591,15 +593,19 @@
     (concurrent-filter-map num-workers
                            (λ (p) (cons p (peer-download timeout p)))
                            peers))
-  (define ok? (match-lambda
-                [(cons _ (cons 'ok _)) #t]
-                [(cons _ (cons 'error _)) #f]))
-  (define (err? r) (not (ok? r)))
-  (define peers-ok (map car (filter ok? results)))
-  (define peers-err (map car (filter err? results)))
+  (define peers-ok
+    (filter-map (match-lambda
+                  [(cons p (cons 'ok _)) p]
+                  [(cons _ (cons 'error e)) #f])
+                results))
+  (define peers-err
+    (filter-map (match-lambda
+                  [(cons _ (cons 'ok _))
+                   #f]
+                  [(cons p (cons 'error e))
+                   (struct-copy Peer p [comment (format "~s" e)])])
+                results))
   (peers->file peers-ok (build-path tt-home-dir "peers-last-downloaded-ok"))
-  ; TODO Append error as a comment: <nick> <uri> # <error>
-  ; TODO Support inline/trailing comments in peer files
   (peers->file peers-err (build-path tt-home-dir "peers-last-downloaded-err")))
 
 (: uniq (∀ (α) (-> (Listof α) (Listof α))))
@@ -789,6 +795,8 @@
                     (build-path tt-home-dir "peers-all")]
                   [peers-mentioned-file
                     (build-path tt-home-dir "peers-mentioned")]
+                  [peers-parsed-file
+                    (build-path tt-home-dir "peers-parsed")]
                   [peers-mentioned-curr
                     (mentioned-peers-in-cache)]
                   [peers-mentioned-prev
@@ -804,8 +812,13 @@
                   [peers-discovered
                     (set-subtract peers-all (list->set peers-all-prev))]
                   [peers-all
-                    (peers-sort (set->list peers-all))])
+                    (peers-sort (set->list peers-all))]
+                  [peers-parsed
+                    (filter
+                      (λ (p) (< 0 (length (peer->msgs p))))
+                      peers-all)])
              (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 "Discovered ~a new peers:~n~a"
                        (set-count peers-discovered)
@@ -815,6 +828,8 @@
                                         (set->list peers-discovered))))
              (peers->file peers-mentioned
                           peers-mentioned-file)
+             (peers->file peers-parsed
+                          peers-parsed-file)
              (peers->file peers-all
                           peers-all-file)))]
         [command