#lang racket/base
;; For legal info, see file "info.rkt".

(require net/url
         net/head
         planet/config)

(define (natural? x)
  (and (integer? x)
       (>= x 0)))

(define (get-planet-package-minor-from-server owner
                                              name-with-dotplt
                                              major
                                              #:minor-lo (minor-lo 0)
                                              #:minor-hi (minor-hi #f))
  ;; Note: Code from Racket 5.2.0.7-20111223 was used as a model for this procedure.
  (let* ([url         (struct-copy url
                                   (string->url (HTTP-DOWNLOAD-SERVLET-URL))
                                   (query `((lang   . ,(format "~S" (DEFAULT-PACKAGE-LANGUAGE)))
                                            (name   . ,(format "~S" name-with-dotplt))
                                            (maj    . ,(format "~S" major))
                                            (min-lo . ,(format "~S" minor-lo))
                                            (min-hi . ,(format "~S" minor-hi))
                                            (path   . ,(format "~S" (list owner))))))]
         [in          (get-impure-port url)]
         [head        (purify-port in)]
         [http-status (cond ((regexp-match #rx"^HTTP/[^ ]* +([^ ]*)" head)
                             => cadr)
                            (error 'get-planet-package-minor-from-server
                                   "PLaneT server did not send recognized HTTP header"))])
    (close-input-port in)
    (cond ((equal? http-status "200")
           (let ([response-major (extract-field "Package-Major-Version" head)]
                 [response-minor (extract-field "Package-Minor-Version" head)])
             (cond ((not (and response-major
                              response-minor
                              (natural? (string->number response-major))
                              (natural? (string->number response-minor))))
                    (error 'get-planet-package-minor-from-server
                           "PLaneT server did not return valid package version headers"))
                   ((not (= (string->number response-major) major))
                    (error 'get-planet-package-minor-from-server
                           "PLaneT server returned major version ~A when we requested ~A"
                           response-major
                           major))
                   (else (string->number response-minor)))))
          ((equal? http-status "404")
           #f)
          (else (error 'get-planet-package-minor-from-server
                       "PLaneT server response had HTTP status ~S"
                       http-status)))))

(define (planet-package-version-is-on-server? owner
                                              name-with-dotplt
                                              major
                                              minor)
  (cond ((get-planet-package-minor-from-server owner
                                               name-with-dotplt
                                               major
                                               #:minor-lo minor
                                               #:minor-hi #f)
         => (lambda (response-minor)
              (if (>= response-minor minor)
                  #t
                  (error 'planet-package-version-is-on-server?
                         "PLaneT server returned invalid minor version ~A when we requested >=~A"
                         response-minor
                         minor))))
        (else #f)))

(provide get-planet-package-minor-from-server
         planet-package-version-is-on-server?)