rip a ton of stuff out. clear my head a bit.

client.rkt

@@ -21,6 +21,26 @@
     (53 . "proxy request refused")
     (59 . "bad request")))
 
+(struct exn:status:input-required exn ()
+  #:extra-constructor-name make-exn:status:input-required
+  #:transparent)
+
+(struct exn:status:redirect exn ()
+  #:extra-constructor-name make-exn:status:redirect
+  #:transparent)
+
+(struct exn:status:temporary-failure exn (errno)
+  #:extra-constructor-name make-exn:status:temporary-failure
+  #:transparent)
+
+(struct exn:status:permanent-failure exn (errno)
+  #:extra-constructor-name make-exn:status:permanent-failure
+  #:transparent)
+
+(struct exn:status:certificate-required exn ()
+  #:extra-constructor-name make-exn:status:certificate-required
+  #:transparent)
+
 (define client%
   (class object%
     (define document-object '())
@@ -29,144 +49,37 @@
 
     (super-new)
 
-    (define/public (up-cmd)
-      (if (null? current-url)
-
-          (displayln "you need to 'go' somewhere first!")
-
-          (if (string=?  (path->string
-                          (simplify-path
-                           (url->path current-url)))
-                         "/")
-
-              (displayln "already at root!")
-
-              (let ([parent
-                     (simplify-path
-                      (build-path (url->path current-url) 'up)
-                      #f)])
-                (get (struct-copy url current-url
-                                  [path (url-path (path->url parent))]))))))
-
-    (define/public (go-cmd url-string)
-      (if (non-empty-string? url-string)
-          (let ()
-            (when (not (string-contains? url-string "://"))
-              (set! url-string (string-append "gemini://" url-string)))
-
-            (get (string->url url-string)))
-
-          (displayln "go where?")))
-
-    (define/public (next-cmd)
-      (define (iter depth)
-        (when (and (> depth 0)
-                   (> (pipe-content-length document-buffer) 0))
-          (let ()
-            (displayln (read-line document-buffer))
-            (iter (sub1 depth)))))
-
-      (if (null? document-buffer)
-          (displayln "you need to 'go' somewhere first!")
-          (let ()
-            (iter 10)
-            (newline)
-            (let ([remaining (pipe-content-length document-buffer)])
-              (printf "~a bytes remaining\n" remaining)))))
-
-    (define/public (visit-cmd line)
-      (if (null? document-object)
-          (displayln "you need to 'go' somewhere first!")
-          (let ([url (gmi:match-link document-object line)])
-            (get (combine-url/relative current-url (url->string url))))))
-
-    (define/public (url-cmd (link-id #f))
-      (if (null? document-object)
-          (displayln "you need to 'go' somewhere first!")
-          (if link-id
-              (let ([link (gmi:match-link document-object link-id)])
-                (if link
-                    (displayln (url->string link))
-                    (displayln "no link with that id")))
-              (displayln (url->string current-url)))))
-
-    (define/private (handle-gmi url c-in)
-      (let-values ([(doc) (gmi:parse (port->lines c-in))]
-                   [(db-in db-out) (make-pipe #f)])
-
-        (set! document-object doc)
-
-        (set! document-buffer db-in)
-        (parameterize ([current-output-port db-out])
-          (gmi:render doc))
-
-        (set! current-url url)
-
-        (let ([remaining (pipe-content-length db-in)])
-          (printf "document retrieved. ~a bytes\n" remaining))
-
-        (next-cmd)))
-
-    (define/private (get url)
-      (define (iter url depth)
+    (define/private (get-document url)
       (with-handlers
-          ([exn:fail:network?
-            (λ (exn)
-              (displayln (exn-message exn)))]
-             [net:exn:fail:response?
-              (λ (exn)
-                (displayln (exn-message exn)))])
+        ;; exceptions which may be raised by net:request
+        ([exn:fail:network? (λ (exn) (displayln (exn-message exn)))]
+         [net:exn:fail:response? (λ (exn) (displayln (exn-message exn)))])
 
-            (let-values ([(status meta c-in) (net:request url)])
-              ;; TODO there are bunch of other status codes to deal with for
-              ;; compliance
+        (let-values ([(status meta body-port) (net:request url)])
           (cond
             ;; clients MUST reject status codes outside of the 10-69 range
-                [(or (< status 10)
-                     (> status 69))
-                 (displayln "WARNING: server returned invalid status code")]
+            [(or (< status 10) (> status 69))
+             (void)]
 
             ;; 10-19 INPUT REQUIRED
-                [(and (>= status 10)
-                      (<= status 19))
-                 (display "input requested > ")
-                 (get (string-append url "?" (read-line)))]
+            [(and (>= status 10) (<= status 19))
+             (void)]
 
             ;; 20-29 SUCCESS
-                [(and (>= status 20)
-                      (<= status 29))
-
-                 (let ([mime (car (string-split meta ";"))])
-                   (cond
-                     [(string=? mime "text/gemini")
-                      (handle-gmi url c-in)]
-                     [else
-                      (printf "unsupported mime type: ~a~n" mime)]))]
+            [(and (>= status 20) (<= status 29))
+             (void)]
 
             ;; 30-39 REDIRECT
-                [(and (>= status 30)
-                      (<= status 39))
-                 (if (> depth 5)
-                     (displayln "WARNING: maximum redirection depth exceeded")
-                     (iter (string->url meta) (sub1 depth)))]
+            [(and (>= status 30) (<= status 39))
+             (void)]
 
             ;; 40-49 TEMPORARY FAILURE
-                [(and (>= status 40)
-                      (<= status 49))
-                 (printf "status ~a: ~a\n" status
-                         (dict-ref temporary-failures status "temporary failure"))]
+            [(and (>= status 40) (<= status 49))
+             (void)]
 
             ;; 50-59 PERMANENT FAILURE
-                [(and (>= status 50)
-                      (<= status 59))
-                 (printf "status ~a: ~a\n" status
-                         (dict-ref permanent-failures status "permanent failure"))]
+            [(and (>= status 50) (<= status 59))
+             (void)]
 
             ;; 60-69 CERTIFICATE REQUIRED
-                [(and (>= status 60)
-                      (<= status 69))
-                 (displayln "certificate handling not yet implemented")]))))
-
-        (if (not (string=? (url-scheme url) "gemini"))
-            (printf "unsupported url: ~a~n" (url->string url))
-            (iter url 5)))))
+            [(and (>= status 60) (<= status 69))]))))