#lang racket/base

(require rackunit
         racket/file
         racket/port
         racket/tcp
         "../main.rkt")

(define (available-port)
  (let ([listener (tcp-listen 0 4 #t "127.0.0.1")])
    (let-values ([(_local-host port _remote-host _remote-port)
                  (tcp-addresses listener #t)])
      (tcp-close listener)
      port)))

(define (http-request port method #:range [range #f])
  (let-values ([(in out) (tcp-connect "127.0.0.1" port)])
    (fprintf out "~a /media/track.flac HTTP/1.1\r\n" method)
    (fprintf out "Host: 127.0.0.1:~a\r\n" port)
    (when range
      (fprintf out "Range: ~a\r\n" range))
    (fprintf out "Connection: close\r\n\r\n")
    (flush-output out)
    (close-output-port out)
    (let ([response (port->bytes in)])
      (close-input-port in)
      response)))

(define (response-body response)
  (let ([match (regexp-match-positions #rx#"\r\n\r\n" response)])
    (if match
        (subbytes response (cdar match))
        #"")))

(define port (available-port))
(define file (make-temporary-file "racket-upnp-range-~a.flac"))
(define server #f)

(dynamic-wind
  (lambda ()
    (call-with-output-file
     file
     #:exists 'truncate
     (lambda (out)
       (write-bytes #"0123456789" out)))
    (set! server
          (start-media-file-server
           (format "http://127.0.0.1:~a/media/" port)
           #:listen-ip "127.0.0.1"))
    (media-file-server-publish! server file "track.flac"))
  (lambda ()
    (let ([head (http-request port "HEAD")]
          [range (http-request port "GET" #:range "bytes=2-5")])
      (check-regexp-match #rx#"HTTP/1[.]1 200" head)
      (check-regexp-match #rx#"(?i:Accept-Ranges): bytes" head)
      (check-regexp-match
       #rx#"(?i:contentFeatures[.]dlna[.]org): DLNA[.]ORG_OP=01;DLNA[.]ORG_CI=0"
       head)
      (check-equal? (response-body head) #"")
      (check-regexp-match #rx#"HTTP/1[.]1 206" range)
      (check-regexp-match #rx#"(?i:Content-Range): bytes 2-5/10" range)
      (check-equal? (response-body range) #"2345")))
  (lambda ()
    (when server
      (media-file-server-stop! server))
    (when (file-exists? file)
      (delete-file file))))