#lang scheme
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PLANET.plt - local planet proxy server
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; http.ss - helpers for http utilities
;; yc 1/18/2010 - first version

(require (planet bzlib/http)
         (planet bzlib/port)
         (planet bzlib/file)
         scheme/contract
         )
;; the return from planet is that when the package exists but does not match
;; the criteria - return
;; "There are packages matching the criteria, but none match your version of PLT Scheme"
;; this helps us to figure out what to do in this case!!!

(define (make-port-to-file in path)
  (make-input-filter-port in 
                          (lambda (in out) 
                            (mkdir* (parent-path path))
                            (call-with-output-atomic-file 
                             path 
                             (lambda (OUT) 
                               (copy-port in OUT out))))
                          #f)) 

(define (serialize-input-to-output in OUT) 
  (make-input-filter-port in 
                          (lambda (in out) 
                            (copy-port in OUT out))
                          #f))

(define (duplicate-http-output r) 
  (make-http-client-response (http-client-response-version r) 
                             (http-client-response-code r)
                             (http-client-response-reason r) 
                             (http-client-response-headers r)
                             (serialize-input-to-output (http-client-response-input r) 
                                                        (current-error-port))))

;; this thing right now works well but would suck once I have to serialize
(define (duplicate-http-client-response r path) 
  (make-http-client-response (http-client-response-version r) 
                             (http-client-response-code r)
                             (http-client-response-reason r) 
                             (http-client-response-headers r)
                             (make-port-to-file (http-client-response-input r) 
                                                path)))
(provide/contract 
 (duplicate-http-client-response (-> http-client-response? 
                                     path-string?
                                     http-client-response?))
 (duplicate-http-output (-> http-client-response? http-client-response?))
 )