Reworet all ->bytes to use state monad.

dns/types/header.scm

@@ -59,14 +59,13 @@
     (logand #xF u16)))                  ; rcode
 
 (define* (dns-header->bytes msg optional: (bv (make-bytevector 12)))
-  (define e (endianness big))
-  (bytevector-u16-set! bv 0  (or (id msg) 0) e)
-  (bytevector-u16-set! bv 2  (encode-dns-header-flags msg) e)
-  (bytevector-u16-set! bv 4  (or (qdcount msg) 0) e)
-  (bytevector-u16-set! bv 6  (or (ancount msg) 0) e)
-  (bytevector-u16-set! bv 8  (or (nscount msg) 0) e)
-  (bytevector-u16-set! bv 10 (or (arcount msg) 0) e)
-  bv)
+  (do
+      (u16! (or (id msg) 0))
+      (u16! (encode-dns-header-flags msg))
+    (u16! (or (qdcount msg) 0))
+    (u16! (or (ancount msg) 0))
+    (u16! (or (nscount msg) 0))
+    (u16! (or (arcount msg) 0))))
 
 (define (bytes->dns-header bv)
   (do

dns/types/message.scm

@@ -32,16 +32,11 @@
 
 
 (define (dns-message->bytes msg)
-  (define bvs
-    (cons (dns-header->bytes (header msg))
-          (map dns-question->bytes (questions msg))))
-  (define bv (make-bytevector (apply + (map bytevector-length bvs))))
-  (fold-left (lambda (off v)
-               (bytevector-copy! v 0 bv off (bytevector-length v))
-               (bytevector-length v))
-             0
-             bvs)
-  bv)
+  (do (dns-header->bytes (header msg))
+      (sequence (map dns-question->bytes (questions msg)))
+    (sequence (map rr-data->bytes (answers msg)))
+    (sequence (map rr-data->bytes (authorities msg)))
+    (sequence (map rr-data->bytes (additionals msg)))))
 
 (define (bytes->dns-message bv)
   (do

dns/types/question.scm

@@ -25,18 +25,9 @@
           (class default: 'IN type: (or u16? (assq (@ (dns enum) class-types))))))
 
 (define (dns-question->bytes q)
-  (define bv-base (-> q
-                      name
-                      (string-split #\.)
-                      string-list->labels))
-  (define bv (make-bytevector (+ 4 (bytevector-length bv-base))))
-  (bytevector-copy! bv-base 0 bv 0 (bytevector-length bv-base))
-  (bytevector-u16-set! bv (+ 0 (bytevector-length bv-base))
-                       (rr->int (type q))
-                       (endianness big))
-  (bytevector-u16-set! bv (+ 2 (bytevector-length bv-base))
-                       (class->int (class q)) (endianness big))
-  bv)
+  (do (bv-copy! (-> q name (string-split #\.) string-list->labels))
+      (u16! (rr->int (type q)))
+    (u16! (class->int (class q)))))
 
 (define (bytes->dns-question bv)
   (do