; Author: Yasir M. Arsanukaev <yarsanukaev AT gmail DOT com>
; License: The 2-clause BSD license. See LICENSE for details.

#lang racket

(require "errors.ss")

(require racket/tcp)
(require racket/serialize)
(require net/url)
(require rnrs/bytevectors-6)
(require rnrs/io/ports-6)

; Create a (TCP) transport from the given host and port.
(define (from-host-port host port)
    (cons 'tcp (hash 
                'host host
                'port port)))

; Create a transport from the given URI.
(define (from-uri s)
  (let* ((uri (string->url s))
         (scheme (url-scheme uri))
         (host (url-host uri))
         (port (url-port uri)))    
    (cond
      ((equal? scheme "bert")
       (from-host-port host port))
      (else 
       (error "from-uri" "URI schemes other than 'bert' not implemented.")))))

; Send a term via a TCP socket.
(define (sendt-tcp transport berp-header bert-request)
  (let ((host (hash-ref (cdr transport) 'host))
        (port (hash-ref (cdr transport) 'port)))
    (with-handlers ([exn:fail:network? (lambda(_) 
                                         (connection-error host port))])
                   (let-values (((in-port out-port) (tcp-connect host port)))
                               ;; perform write to the socket
                               (put-bytevector out-port berp-header)  ;header
                               (put-bytevector out-port bert-request) ;payload
                               (flush-output-port out-port)
                               (cons (car transport)  ;; 'tcp
                                     (hash 'host        host
                                           'port        port
                                           'in-port     in-port
                                           'out-port    out-port))))))

(define (recvt-tcp transport)
  (let* ((read-n (lambda (n)
                   (get-bytevector-n 
                    (hash-ref (cdr transport) 'in-port) n)))
         (len-raw (read-n 4))
         (bert-response-len (bytevector-u32-ref len-raw 0 (endianness big)))
         (bert-response (read-n bert-response-len)))
    ; DEBUG
    ; (display bert-response-len) (display " many bytes read from port") (newline)
    
    ; according to spec we should close an output port
    ; after reading a reply back
    (close-output-port (hash-ref (cdr transport) 'out-port))
    bert-response))

; Send a term using specified transport.
(define (sendt transport bert-request)
  (let* ((berp-header (make-bytevector 4))
         (bert-req-len (bytevector-length bert-request)))
    (bytevector-u32-set! berp-header 0 bert-req-len (endianness big))
    (cond
      ((equal? (car transport) 'tcp)
       (sendt-tcp transport berp-header bert-request))
      (else (error "sendt" "Other transports not implemented.")))))

; Receive a term using transport returned by sendt.
(define (recvt transport)
  (cond
    ((equal? (car transport) 'tcp)
     (recvt-tcp transport))
    (else (error "recvt" "Other transports not implemented."))))

(provide from-uri sendt recvt)