#lang scheme/base 
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTTP.plt
;;
;; abstraction and services of HTTP protocols
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ssl.ss
;; exposing similar API to net/url for HTTPS.
;; yc 8/18/2009 - first version
(require openssl
         scheme/tcp
         net/url
         mzlib/trace
         scheme/contract 
         )

;; https->impure-port
;; base function to handle the connection over https
(define (https->impure-port method url (headers '()) (data #f))
  (let-values (((s->c c->s) (ssl-connect (url-host url)
                                         (if (url-port url) (url-port url) 443)))
               ((path) (make-url #f #f #f #f
                                 (url-path-absolute? url)
                                 (url-path url)
                                 (url-query url)
                                 (url-fragment url))))
    (define (to-server fmt . args)
      (display (apply format (string-append fmt "\r\n") args) c->s))
    ;; (trace to-server)
    (to-server "~a ~a HTTP/1.0" method (url->string path))
    (to-server "Host: ~a:~a" (url-host url)
               (if (url-port url) (url-port url) 443))
    (when data
      (to-server "Content-Length: ~a" (bytes-length data)))
    (for-each (lambda (header)
                (to-server "~a" header)) headers)
    (to-server "")
    (when data
      (display data c->s))
    (flush-output c->s)
    (close-output-port c->s)
    s->c))

;; get-impure-port/https
;; a GET version of https call
(define (get-impure-port/https url (headers '()))
  (https->impure-port "GET" url headers))

;; post-impure-port/https
;; a POST version of https call
(define (post-impure-port/https url data (headers '()))
  (https->impure-port "POST" url headers data))

(provide/contract
 (get-impure-port/https (->* (url?)
                             ((listof string?))
                             input-port?))
 (post-impure-port/https (->* (url? bytes?)
                              ((listof string?))
                              input-port?))
 )