#lang racket/base

;; Noddy representation of a zone, and various zone and RRSet utilities.

(require racket/set)
(require racket/match)
(require "api.rkt")
(require "codec.rkt")

(provide zone-ref
	 zone-includes-name?
	 incorporate-rr
	 incorporate-complete-answer
	 empty-zone-db
	 compile-zone-db
	 compiled-zone?
	 in-bailiwick?
	 set-filter
	 filter-by-type
	 filter-rrs
	 rr-set->list)

;; A CompiledZone is a Hash<DomainName,SetOf<RR>>, representing a
;; collection of DNS RRSets indexed by DomainName.

;; TODO: maybe store domain names big-end first? It'd make bailiwick
;; and subzone checks into prefix rather than suffix checks. It makes
;; domain names into paths through the DNS DB tree.

;; CompiledZone DomainName -> Maybe<Set<RR>>
(define (zone-ref db name)
  (hash-ref db name #f))

(define (zone-includes-name? db name)
  (hash-has-key? db name))

;; RR CompiledZone -> CompiledZone
(define (incorporate-rr rr db)
  (hash-set db (rr-name rr) (set-add (hash-ref db (rr-name rr) set) rr)))

;; Maybe<CompleteAnswer> CompiledZone -> CompiledZone
(define (incorporate-complete-answer ans db)
  (match ans
    [#f db]
    [(complete-answer ns us ds) (foldl incorporate-rr db (append (set->list ns)
								 (set->list us)
								 (set->list ds)))]))

;; empty-zone-db : -> CompiledZone
(define (empty-zone-db)
  (make-immutable-hash))

;; compile-zone-db : ListOf<RR> -> CompiledZone
;; Builds an immutable hash table from the given RRs, suitable for
;; quickly looking up answers to queries.
(define (compile-zone-db rrs)
  (foldl incorporate-rr (make-immutable-hash) rrs))

(define (compiled-zone? z)
  (hash? z)) ;; hm

;; in-bailiwick? : DomainName DomainName -> Boolean
;; Answers #t iff dn falls within the bailiwick of the zone with
;; origin o.
(define (in-bailiwick? dn o)
  (cond
   ((equal? dn o) #t)
   ((null? dn) #f)
   (else (in-bailiwick? (cdr dn) o))))

;; set-filter : (X -> Boolean) SetOf<X> -> SetOf<X>
;; Retains only those elements of its argument for which the predicate
;; answers #t.
(define (set-filter predicate in)
  (for/set ([x (in-set in)]
	    #:when (predicate x))
	   x))

;; filter-by-type : SetOf<RR> RRType -> SetOf<RR>
;; Selects only those members of rrset having rr-type type.
(define (filter-by-type rrset type)
  (set-filter (lambda (rr) (eqv? (rr-type rr) type)) rrset))

;; filter-rrs : SetOf<RR> QueryType QueryClass
;; Returns a set like its argument with RRs not matching the given
;; type and class removed.
(define (filter-rrs rrs qtype qclass)
  (define filtered-by-type
    (case qtype
      ((*) rrs)
      (else (filter-by-type rrs qtype))))
  (define filtered-by-type-and-class
    (case qclass
      ((*) filtered-by-type)
      (else (set-filter (lambda (rr) (eqv? (rr-class rr) qclass)) filtered-by-type))))
  filtered-by-type-and-class)

;; rr-set->list : SetOf<RR> -> ListOf<RR>
;; Like set->list, but places all CNAME records first.
;; This is apparently to work around bugs in old versions of BIND?
(define (rr-set->list rrs)
  (append (set->list (filter-by-type rrs 'cname))
	  (set->list (set-filter (lambda (rr) (not (eqv? (rr-type rr) 'cname))) rrs))))