From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Mon, 22 Mar 2021 10:52:49 +0000 (-0400)
Subject: Migrate from hashing to encoding URL in cache paths
X-Git-Tag: 0.13.0
X-Git-Url: https://git.xandkar.net/?a=commitdiff_plain;h=edadb8049dc8a67cd94afdef7628cef44125ebd8;p=tt.git

Migrate from hashing to encoding URL in cache paths
---

diff --git a/info.rkt b/info.rkt
index b735f85..1a5fe8b 100644
--- a/info.rkt
+++ b/info.rkt
@@ -6,7 +6,7 @@
 (define pkg-desc
   "twtxt client")
 (define version
-  "0.12.1")
+  "0.13.0")
 (define pkg-authors
   '("Siraaj Khandkar <siraaj@khandkar.net>"))
 (define deps
diff --git a/tt.rkt b/tt.rkt
index 1125a2d..b6b6bd5 100644
--- a/tt.rkt
+++ b/tt.rkt
@@ -4,6 +4,7 @@
 (require racket/date)
 (require
   net/http-client
+  net/uri-codec
   net/url-string
   net/url-structs)
 
@@ -36,6 +37,9 @@
          [uri  : Url])
         #:type-name Feed)
 
+(: tt-home-dir Path-String)
+(define tt-home-dir (build-path (expand-user-path "~") ".tt"))
+
 (: concurrent-filter-map (∀ (α β) (-> Natural (-> α β) (Listof α))))
 (define (concurrent-filter-map num-workers f xs)
   ; TODO preserve order of elements OR communicate that reorder is expected
@@ -225,24 +229,33 @@
 (define (str->msgs nick uri str)
   (filter-map (λ (line) (str->msg nick uri line)) (filter-comments (str->lines str))))
 
-(: hash-sha1 (-> String String))
-(define (hash-sha1 str)
-  (define in (open-input-string str))
-  (define digest (sha1 in))
-  (close-input-port in)
-  digest)
+(: cache-dir Path-String)
+(define cache-dir (build-path tt-home-dir "cache"))
+
+(: url->cache-file-path-v1 (-> Url Path-String))
+(define (url->cache-file-path-v1 uri)
+  (define (hash-sha1 str) : (-> String String)
+    (define in (open-input-string str))
+    (define digest (sha1 in))
+    (close-input-port in)
+    digest)
+  (build-path cache-dir (hash-sha1 (url->string uri))))
+
+(: url->cache-file-path-v2 (-> Url Path-String))
+(define (url->cache-file-path-v2 uri)
+  (build-path cache-dir (uri-encode (url->string uri))))
 
-(: url->cache-file-path (-> Url Path-String))
-(define (url->cache-file-path uri)
-  ; TODO Replace hashing with encoding
-  (expand-user-path (string-append "~/.tt/cache/" (hash-sha1 (url->string uri)))))
+(define url->cache-file-path url->cache-file-path-v2)
 
 ; TODO Return Option
 (: uri-read-cached (-> Url String))
 (define (uri-read-cached uri)
-  (define path (url->cache-file-path uri))
-  (if (file-exists? path)
-      (file->string path)
+  (define path-v1 (url->cache-file-path-v1 uri))
+  (define path-v2 (url->cache-file-path-v2 uri))
+  (when (file-exists? path-v1)
+    (rename-file-or-directory path-v1 path-v2 #t))
+  (if (file-exists? path-v2)
+      (file->string path-v2)
       (begin
         (log-warning "Cache file not found for URI: ~a" (url->string uri))
         "")))
@@ -312,10 +325,11 @@
      (log-debug "status: ~v" status)
      ; TODO Handle redirects
      (if (= 200 status)
-         (call-with-output-file cache-file-path
-                                (λ (cache-output)
-                                   (copy-port body-input cache-output))
-                                #:exists 'replace)
+         (begin
+           (make-parent-directory* cache-file-path)
+           (call-with-output-file cache-file-path
+                                  (curry copy-port body-input)
+                                  #:exists 'replace))
          (raise status))]
     [(_ _ _)
      (log-error "Invalid URI: ~v" u)]))
@@ -398,6 +412,7 @@
       "and <command> is one of"
       "r, read i   : Read the timeline."
       "d, download : Download the timeline."
+      ; TODO Add path dynamically
       "u, upload   : Upload your twtxt file (alias to execute ~/.tt/upload)."
       ""
       #:args (command . args)
@@ -406,7 +421,7 @@
       (match command
         [(or "d" "download")
          ; Initially, 15 was fastest out of the tried: 1, 5, 10, 20.  Then I
-         ; started notcing significant slowdowns. Reducing to 5 seems to help.
+         ; started noticing significant slowdowns. Reducing to 5 seems to help.
          (let ([num-workers 5])
            (command-line
              #:program
@@ -422,7 +437,7 @@
            #:program
            "tt upload"
            #:args ()
-           (if (system (path->string (expand-user-path "~/.tt/upload")))
+           (if (system (path->string (build-path tt-home-dir "upload")))
                (exit 0)
                (exit 1)))]
         [(or "r" "read")