home
/
code
/
tt.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
5fef985
)
Check for supported URL scheme and define Download-Result type
author
Siraaj Khandkar
<siraaj@khandkar.net>
Thu, 2 Dec 2021 02:10:56 +0000
(21:10 -0500)
committer
Siraaj Khandkar
<siraaj@khandkar.net>
Thu, 2 Dec 2021 02:10:56 +0000
(21:10 -0500)
tt.rkt
patch
|
blob
|
blame
|
history
diff --git
a/tt.rkt
b/tt.rkt
index
6e22728
..
1cd6fa6
100644
(file)
--- a/
tt.rkt
+++ b/
tt.rkt
@@
-27,6
+27,14
@@
(∀ (α β) (U (cons 'ok α)
(cons 'error β))))
(∀ (α β) (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])
(struct Hist
([freq : Nonnegative-Integer]
[last : Nonnegative-Integer])
@@
-588,15
+596,15
@@
[(list val) val]
[_ #f]))
[(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 ?
(-> 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))
; 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))
(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))
@@
-638,11
+646,8
@@
'downloaded-new)
'skipped-cached))
'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))
(define u-str (url->string u))
(define timeout-chan (make-channel))
(define result-chan (make-channel))
@@
-675,7
+680,7
@@
; TODO Should a redirect update a peer URL?
(match status
[200
; 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)
[_
`(error . (http-not-ok . ,status))])])
(close-input-port body-input)
@@
-686,6
+691,15
@@
(kill-thread timeout-thread)
result)
(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
(: timeline-print (-> Out-Format (Listof Msg) Void))
(define (timeline-print out-format timeline)
(match timeline
This page took
0.032319 seconds
and
4
git commands to generate.