#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PLANET.plt - local planet proxy server
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; planet.ss - the main interface for translating planet client http calls into proxy calls
;; yc 1/18/2010 - first version

(require net/url
         (planet bzlib/shp/proxy)
         (planet bzlib/shp/request)
         (planet bzlib/http)
         "base.ss"
         "repository.ss"
         "http.ss"
         "depend.ss"
         )

(define (planet-arg->http-client-response repo arg) 
  (let-values (((full-path satisfies?) 
                (planet-arg->repository-path repo arg))) 
    (if full-path 
        (if satisfies? 
            (repository-path->http-client-response repo full-path)
            (let ((msg #"Server had no matching package: Planet has matching packages but none matches your criteria"))
              (duplicate-http-output
               (make-http-client-response "1.0" 
                                          404 
                                          "Not Found" 
                                          `(("Content-Type" . "text/plain; charset=utf-8")
                                            ("Content-Length" . ,(format "~a" (bytes-length msg)))
                                            )
                                          (open-input-bytes msg)))))
        (planet-arg->central-repository-response/serialized repo arg))))

(define (planet-arg->central-repository-response/serialized repo arg)
  (let ((response (planet-arg->central-repository-response arg)))
    (let ((path (http-client-response->repository-path repo arg response))) 
      (if path 
          (duplicate-http-client-response response path)
          (duplicate-http-output response)))))

(define (planet! (url ($uri)))
  (raise (http-client-response->response 
          (planet-arg->http-client-response (make-repository)
                                            (url->planet-arg url))
          identity)))

(provide/contract 
 (planet! (->* () 
               (url?) 
               any))
 )