#lang racket/base

(provide sleep
         random-hex-string
         extend-url-string-query
         web-respond/status!
         web-request!)

(require racket/dict)
(require (only-in file/sha1 bytes->hex-string))
(require (only-in racket/random crypto-random-bytes))
(require net/url)
(require syndicate/actor)
(require syndicate/drivers/timer)
(require syndicate/drivers/web)

(module+ test (require rackunit))

(define (sleep sec)
  (define timer-id (gensym 'sleep))
  (until (message (timer-expired timer-id _))
         (on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))

(define (random-hex-string half-length)
  (bytes->hex-string (crypto-random-bytes half-length)))

(define (extend-url-string-query urlstr extension)
  (define u (string->url urlstr))
  (url->string (struct-copy url u [query (append (url-query u) extension)])))

(define (web-respond/status! id code message [body #""])
  (web-respond/bytes! id
                      #:header (web-response-header
                                #:code code
                                #:message message
                                #:headers '())
                      body))

(define (web-request! verb urlstr
                      #:body [request-body #""]
                      #:headers [headers '()]
                      #:redirect-budget [redirect-budget 0])
  (define req-id (gensym 'req))
  (define u (string->url urlstr))
  (define res (url->resource u))
  (define-values (resp response-body)
    (react/suspend (k)
      (on-start
       (printf "~a --> ~a ~a ~v\n" req-id verb urlstr request-body)
       (send! (web-request req-id
                           'outbound
                           (web-request-header verb res headers (url-query u))
                           request-body)))
      (stop-when (message (web-response-complete req-id $resp $response-body))
                 (printf "~a <-- ~v ~v\n" req-id resp response-body)
                 (k resp response-body))))
  (define location (dict-ref (web-response-header-headers resp) 'location #f))
  (if (and (eq? (web-response-header-code-type resp) 'redirection)
           (positive? redirect-budget)
           location)
      (web-request! verb location
                    #:body request-body
                    #:headers headers
                    #:redirect-budget (- redirect-budget 1))
      (values resp response-body)))

(module+ test
  (check-equal? (extend-url-string-query "http://localhost/" '((a . "hi")))
                "http://localhost/?a=hi")
  (check-equal? (extend-url-string-query "http://localhost/" '())
                "http://localhost/")
  (check-equal? (extend-url-string-query "http://localhost?foo=bar" '())
                "http://localhost?foo=bar")
  (check-equal? (extend-url-string-query "http://localhost/?foo=bar" '())
                "http://localhost/?foo=bar")
  (check-equal? (extend-url-string-query "http://localhost?foo=bar" '((a . "hi")))
                "http://localhost?foo=bar&a=hi")
  (check-equal? (extend-url-string-query "http://localhost/?foo=bar" '((a . "hi")))
                "http://localhost/?foo=bar&a=hi"))