#lang racket/base

;; DNS drivers using os-big-bang.rkt and os-udp.rkt.

(require racket/match)
(require "codec.rkt")
(require "../racket-matrix/os-big-bang.rkt")
(require "../racket-matrix/os-udp.rkt")

(provide (struct-out bad-dns-packet)
	 (struct-out dns-request)
	 (struct-out dns-reply)
	 dns-read-driver
	 dns-write-driver
	 dns-spy)

(struct bad-dns-packet (detail source sink reason) #:prefab)
(struct dns-request (message source sink) #:prefab)
(struct dns-reply (message source sink) #:prefab)

(define (dns-read-driver s)
  (os-big-bang 'no-state
    (subscribe 'packet-reader
      (meta-message-handlers w
	[(udp-packet source (== s) #"")
	 (display "Debug dump packet received\n")
	 (transition w
	   (send-message `(debug-dump)))]
	[(udp-packet source (== s) body)
	 (transition w
	   (send-message
	    (with-handlers ((exn:fail? (lambda (e) (bad-dns-packet body source s 'unparseable))))
	      (define message (packet->dns-message body))
	      (case (dns-message-direction message)
		((request) (dns-request message source s))
		((response) (dns-reply message source s))))))]))))

(define (dns-write-driver s)
  (define (translate message sink)
    (with-handlers ((exn:fail? (lambda (e)
				 (send-message (bad-dns-packet message s sink 'unencodable)))))
      (send-meta-message (udp-packet s sink (dns-message->packet message)))))
  (os-big-bang 'no-state
    (subscribe 'packet-writer
      (message-handlers w
	[(dns-request message (== s) sink) (transition w (translate message sink))]
	[(dns-reply   message (== s) sink) (transition w (translate message sink))]))))

(require racket/pretty)
(define dns-spy
  (os-big-bang 'none
    (subscribe 'spy
      (message-handlers w
	[(dns-request message source sink)
	 (pretty-display `(DNS (,source asks ,sink ,(dns-message-id message))
			       ,@(dns-message-questions message)))]
	[(dns-reply message source sink)
	 (pretty-display `(DNS (,source answers ,sink) ,message))]
	[x
	 (write `(DNS ,x))
	 (newline)]))))