#lang racket/base
(require "../common/check.rkt"
         "../host/thread.rkt"
         "../host/rktio.rkt"
         "../sandman/main.rkt"
         "../security/main.rkt"
         "port-number.rkt"
         "check.rkt"
         "address.rkt"
         "udp-socket.rkt"
         "error.rkt"
         "evt.rkt"
         "address-cache.rkt")

(provide udp-send
         udp-send*
         udp-send-to/enable-break
         
         udp-send-to
         udp-send-to*
         udp-send/enable-break
         
         udp-send-evt
         udp-send-to-evt
         udp-send-ready-evt)

(define/who (udp-send u bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send who u bstr start end)
  (do-udp-send-to who u #f #f bstr start end))

(define/who (udp-send* u bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send who u bstr start end)
  (do-udp-send-to who #:wait? #f u #f #f bstr start end))

(define/who (udp-send/enable-break u bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send who u bstr start end)
  (do-udp-send-to who #:enable-break? #t u #f #f bstr start end))

(define/who (udp-send-to u hostname port-no bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send-to who u hostname port-no bstr start end)
  (do-udp-send-to who u hostname port-no bstr start end))

(define/who (udp-send-to* u hostname port-no bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send-to who u hostname port-no bstr start end)
  (do-udp-send-to who #:wait? #f u hostname port-no bstr start end))

(define/who (udp-send-to/enable-break u hostname port-no bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send-to who u hostname port-no bstr start end)
  (do-udp-send-to who #:enable-break? #t u hostname port-no bstr start end))

(define/who (udp-send-evt u bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send who u bstr start end)
  (do-udp-send-to-evt who u #f #f bstr start end))

(define/who (udp-send-to-evt u hostname port-no bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
  (check-send-to who u hostname port-no bstr start end)
  (do-udp-send-to-evt who u hostname port-no bstr start end))

(define/who (udp-send-ready-evt u)
  (check who udp? u)
  (udp-sending-ready-evt
   (lambda ()
     (rktioly
      (or (not (udp-s u))
          (not (eqv? (rktio_poll_write_ready rktio (udp-s u))
                     RKTIO_POLL_NOT_READY)))))
   ;; in atomic and in rktio, must not start nested rktio
   (lambda (ps)
     (rktio_poll_add rktio (udp-s u) ps RKTIO_POLL_WRITE))))

;; ----------------------------------------

(define (check-send who u bstr start end)
  (check who udp? u)
  (check-bstr who bstr start end))

(define (check-send-to who u hostname port-no bstr start end)
  (check who udp? u)
  (check who string? hostname)
  (check who port-number? port-no)
  (check-bstr who bstr start end)
  (security-guard-check-network who hostname port-no 'client))

;; ----------------------------------------

(define (do-udp-send-to who u hostname port-no bstr start end
                        #:wait? [wait? #t]
                        #:enable-break? [enable-break? #f])
  (start-uninterruptible) ; because `call-with-resolved-address`
  (define result
    (cond
      [(address-bytes-cache-ref hostname port-no)
       => (lambda (addr-bstr)
            (do-udp-maybe-send-to-addr who u addr-bstr bstr start end
                                       #:wait? wait?
                                       #:enable-break? enable-break?))]
      [else
       (call-with-resolved-address
        #:who who
        hostname port-no
        #:tcp? #f
        ;; in uninterruptible mode:
        (lambda (addr)
          (do-udp-maybe-send-to-addr who u addr bstr start end
                                     #:wait? wait?
                                     #:enable-break? enable-break?)))]))
  (end-uninterruptible)
  result)

(define (do-udp-send-to-evt who u hostname port-no bstr start end)
  (poll-address-finalizations) ; not in uninterruptible mode
  (start-uninterruptible) ; because `call-with-resolved-address`
  (define evt
    (call-with-resolved-address
     #:who who
     hostname port-no
     #:tcp? #f
     #:retain-address? #t
     (lambda (addr)
       (udp-sending-evt
        u
        ;; in atomic mode:
        (lambda ()
          (when addr (register-address-finalizer addr))
          (do-udp-maybe-send-to-addr who u addr bstr start end
                                     #:wait? #f
                                     #:handle-error (lambda (thunk) thunk)))))))
  (end-uninterruptible)
  evt)

; in uninterruptible mode (maybe atomic), *not* rktio mode
;; if atomic, then `handle-error` returns its argument, and `wait?` is `#f`
(define (do-udp-maybe-send-to-addr who u addr bstr start end
                                   #:wait? [wait? #t]
                                   #:enable-break? [enable-break? #f]
                                   #:handle-error [handle-error handle-error-immediately*])
  (let loop ()
    (start-rktio)
    ;; re-check closed, connected, etc., on every iteration,
    ;; in case the state changes while we block
    (check-udp-closed
     who u
     #:handle-error handle-error
     #:continue
     (lambda ()
       (cond
         [(and addr (udp-is-connected? u))
          (handle-error
           (lambda ()
             (raise-network-arguments-error who "udp socket is connected"
                                            "socket" u)))]
         [(and (not addr) (not (udp-is-connected? u)))
          (handle-error
           (lambda ()
             (raise-network-arguments-error who "udp socket is not connected"
                                            "socket" u)))]
         [else
          ;; if the socket is not bound already, send[to] binds it
          (set-udp-is-bound?! u #t)
          (define r (if (bytes? addr)
                        (rktio_udp_sendto_addr_bytes rktio (udp-s u) addr (bytes-length addr) bstr start end)
                        (rktio_udp_sendto_in rktio (udp-s u) addr bstr start end)))
          (cond
            [(rktio-error? r)
             (handle-error
              (lambda ()
                (raise-network-error who r "send failed")))]
            [(eqv? r 0)
             (cond
               [(not wait?) #f]
               [else
                (end-rktio)
                (end-uninterruptible)
                ((if enable-break? sync/enable-break sync)
                 (rktio-evt (lambda ()
                              (or (not (udp-s u))
                                  (not (eqv? (rktio_poll_write_ready rktio (udp-s u))
                                             RKTIO_POLL_NOT_READY))))
                            ;; in atomic and in rktio-sleep-relevant (not rktio), must not start nested rktio
                            (lambda (ps)
                              (rktio_poll_add rktio (udp-s u) ps RKTIO_POLL_WRITE))))
                (start-uninterruptible)
                (loop)])]
            [(= r (- end start))
             (end-rktio)
             (if wait? (void) #t)]
            [else
             (handle-error
              (lambda ()
                (raise
                 (exn:fail:network
                  (string-append (symbol->string who) ": didn't send enough"
                                 "\n  requested bytes: " (number->string (- end start))
                                 "\n  sent bytes: " r)
                  (current-continuation-marks)))))])])))))

;; ----------------------------------------

(struct udp-sending-evt (u try)
  #:property
  prop:evt
  (poller
   ;; in atomic mode
   (lambda (self poll-ctx)
     (define try (udp-sending-evt-try self))
     (define r (try))
     (cond
       [(procedure? r)
        ;; `r` is a thunk that raises an exception
        (values #f (wrap-evt always-evt (lambda (v) (r))))]
       [r
        (values (list (void)) #f)]
       [else
        (sandman-poll-ctx-add-poll-set-adder!
         poll-ctx
         ;; in atomic and in rktio-sleep-relevant (not rktio), must not start nested rktio
         (lambda (ps)
           (rktio_poll_add rktio (udp-s (udp-sending-evt-u self)) ps RKTIO_POLL_READ)))
        (values #f self)])))
  #:reflection-name 'udp-send-evt
  #:authentic)

(struct udp-sending-ready-evt rktio-evt ()
  #:reflection-name 'udp-send-ready-evt
  #:authentic)
