Check for supported URL scheme and define Download-Result type
authorSiraaj Khandkar <siraaj@khandkar.net>
Thu, 2 Dec 2021 02:10:56 +0000 (21:10 -0500)
committerSiraaj Khandkar <siraaj@khandkar.net>
Thu, 2 Dec 2021 02:10:56 +0000 (21:10 -0500)
tt.rkt

diff --git a/tt.rkt b/tt.rkt
index 6e22728..1cd6fa6 100644 (file)
--- a/tt.rkt
+++ b/tt.rkt
   (∀ (α β) (U (cons 'ok α)
               (cons 'error β))))
 
+(define-type Download-Result
+  (Result (U 'skipped-cached 'downloaded-new)
+          (U 'timeout
+             (Pair 'unsupported-url-scheme String)
+             (Pair 'http-not-ok Positive-Integer)
+             (Pair 'net-error Any)
+             (Pair 'other Any))))
+
 (struct Hist
         ([freq : Nonnegative-Integer]
          [last : Nonnegative-Integer])
     [(list val) val]
     [_           #f]))
 
-(: uri-download-from-port
+(: uri-download-http-from-port
    (-> Url (Listof (U Bytes String)) Input-Port
        (U 'skipped-cached 'downloaded-new))) ; TODO 'ok|'error ?
-(define (uri-download-from-port u headers body-input)
+(define (uri-download-http-from-port u headers body-input)
    ; TODO Update message db from here? or where?
    ; - 1st try can just be an in-memory set that gets written-to
    ;   and read-from disk as a whole.
   (define u-str (url->string u))
-  (log-debug "uri-download-from-port ~v into ~v" u-str cached-object-path)
+  (log-debug "uri-download-http-from-port ~v into ~v" u-str cached-object-path)
   (define cached-object-path (url->cache-object-path u))
   (define cached-etag-path (url->cache-etag-path u))
   (define cached-lmod-path (url->cache-lmod-path u))
         'downloaded-new)
       'skipped-cached))
 
-(: uri-download
-   (-> Positive-Float Url
-       (Result (U 'skipped-cached 'downloaded-new)
-               Any))) ; TODO Maybe more-precise error type?
-(define (uri-download timeout u)
+(: uri-download-http (-> Positive-Float Url Download-Result))
+(define (uri-download-http timeout u)
   (define u-str (url->string u))
   (define timeout-chan (make-channel))
   (define result-chan (make-channel))
                            ; TODO Should a redirect update a peer URL?
                            (match status
                              [200
-                               `(ok . ,(uri-download-from-port u headers body-input))]
+                               `(ok . ,(uri-download-http-from-port u headers body-input))]
                              [_
                                `(error . (http-not-ok . ,status))])])
                      (close-input-port body-input)
   (kill-thread timeout-thread)
   result)
 
+(: uri-download (-> Positive-Float Url Download-Result))
+(define (uri-download timeout u)
+  (match (url-scheme u)
+    ; TODO Support Gopher.
+    [(or "http" "https")
+     (uri-download-http timeout u)]
+    [scheme
+      `(error . (unsupported-url-scheme . ,scheme))]))
+
 (: timeline-print (-> Out-Format (Listof Msg) Void))
 (define (timeline-print out-format timeline)
   (match timeline
This page took 0.032716 seconds and 4 git commands to generate.