#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTTP.plt
;;
;; abstraction of common network behaviors and services
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; client.ss
;; basic http client: making http requests and parsing responses.
;; yc 8/18/2009 - first version
(require net/url
         scheme/tcp
         "ssl.ss"
         scheme/contract 
         mzlib/trace
         (planet bzlib/net/line)
         (planet bzlib/net/header)
         )

;; http-client-response holds all of the metadata (code, status, headers)
;; as well as the data stream
(define-struct http-client-response (version code reason headers input)
  #:property prop:input-port 4)

;; read-http-status
;; parse the http-status of the response.
(define (read-http-status in) 
  (define (helper match)
    (if match
        (list (cadr match) (caddr match) (cadddr match))
        match))
  (define (reader in)
    (read-folded-line in))
  (trace reader)
  (helper (regexp-match #px"^HTTP/(\\d\\.\\d)\\s+(\\d+)\\s+(.+)$" (reader in))))

;; a helper over the make-http-client-response
(define (*make-http-client-response in) 
  (define (helper version code reason)
    (make-http-client-response version (string->number code) reason (read-headers in) in))
  (let ((status (read-http-status in))) 
    (if (not status)
        (error 'make-http-client-response "invalid http response")
        (apply helper status)))) 
;; helper over url conversion
(define (url-helper url)
  (if (string? url) (string->url url)
      url)) 

;; converting headers over to headers that can be used by get/post-impure-port
(define (headers-helper headers)
  (map (lambda (kv) 
         (format "~a: ~a" (car kv) (cdr kv))) 
       headers))

;; http-get
;; abstraction over http GET
(define (http-get url (headers '())) 
  (define (helper url) 
    (*make-http-client-response 
     ((cond ((not (url-scheme url)) get-impure-port)
            ((string-ci=? (url-scheme url) "https")
             get-impure-port/https)
            (else get-impure-port)) 
      url (headers-helper headers))))
  (helper (url-helper url)))

;; http-post
;; abstarction over http POST
(define (http-post url data (headers '())) 
  (define (helper url)
    (*make-http-client-response 
     ((if (string-ci=? (url-scheme url) "https")
          post-impure-port/https
          post-impure-port)
      url data (headers-helper headers))))
  (helper (url-helper url)))

(provide/contract
 (http-get (->* ((or/c string? url?))
                ((listof (cons/c string? string?)))
                input-port?))
 (http-post (->* ((or/c string? url?) bytes?)
                 ((listof (cons/c string? string?)))
                 input-port?))
 (struct http-client-response ((version string?)
                               (code number?)
                               (reason string?)
                               (headers (listof (cons/c string? string?)))
                               (input input-port?)))
 )