(module problem02 ()

(import scheme)
(import (chicken base))
(import (chicken blob))
(import (chicken format))
(import (chicken io))
(import (chicken port))
(import (chicken process signal))
(import (chicken time))
(import (srfi 1))
(import (srfi 18))
(import (srfi 69))
(import bitstring)
(import socket)

(define stderr (current-error-port))
(set-buffering-mode! stderr #:line)

(define str string-append)

(define (elog fmt #!rest args)
  (apply fprintf stderr (str "[~s] " fmt) (current-process-milliseconds) args))

(define host "0.0.0.0")
(define port 10000)

(define backlog 10)
(socket-receive-timeout #f)

(define listener (socket af/inet sock/stream))
(set! (so-reuse-address? listener) #t)
(socket-bind listener (inet-address host port))
(socket-listen listener backlog)

(define (mutilate n)
  (inexact->exact (truncate n)))

(define message-length 9)

(bitpacket message
  (type 8)
  (arg 32 big signed)
  (arg2 32 big signed))

(bitpacket response
  (arg 32 big signed))

(define (parse-message string)
  (bitmatch string
    (((message bitpacket))
     `((type . ,(integer->char type))
       (arg . ,arg)
       (arg2 . ,arg2)))))

(print (parse-message "\x49\x00\x00\x30\x39\x00\x00\x00\x65"))
(print (parse-message "\x51\x00\x00\x03\xe8\x00\x01\x86\xa0"))

(define (serialize-response arg)
  (blob->string
   (bitstring->blob
    (bitconstruct
     (response bitpacket)))))

(elog "~s\n" (serialize-response 5107))

(define (handle-client conn-socket)
  (elog "Incoming connection (~s)\n" conn-socket)
  (receive (in out) (socket-i/o-ports conn-socket)
    (let ((kvstore (make-hash-table)))
      (let loop ()
        (let ((message (read-string message-length in)))
          (if (eof-object? message)
              (begin
                (close-input-port in)
                (close-output-port out))
              (let* ((request (parse-message message))
                     (type (alist-ref 'type request))
                     (arg (alist-ref 'arg request))
                     (arg2 (alist-ref 'arg2 request)))
                (case type
                  ((#\I)
                   (elog "Insertion request (~a, ~a)\n" arg arg2)
                   (hash-table-set! kvstore arg arg2))
                  ((#\Q)
                   (elog "Query request (~a, ~a)\n" arg arg2)
                   (let ((keys (hash-table-fold kvstore
                                                (lambda (key _value acc)
                                                  (if (and (>= key arg)
                                                           (<= key arg2))
                                                      (cons key acc)
                                                      acc))
                                                '())))
                     (cond
                      ((null? keys)
                       (elog "Query response: 0 (no entries)\n")
                       (display (serialize-response 0) out))
                      ((> arg arg2)
                       (elog "Query response: 0 (invalid range)\n")
                       (display (serialize-response 0) out))
                      (else
                       (let* ((values (map (lambda (key)
                                             (hash-table-ref kvstore key))
                                           keys))
                              (sum (fold + 0 values))
                              (n (length values))
                              (mean (mutilate (/ sum n))))
                         (elog "Query response: ~a (~a, ~a)\n" mean sum n)
                         (display (serialize-response mean) out))))))
                  (else
                   ;; (elog "Unknown type ~a (~a)\n" type (char->integer type))
                   (display "\xde\xad\xbe\xef" out)))
                (loop))))))))

(let loop ()
  (let ((conn-socket (socket-accept listener)))
    (thread-start!
     (make-thread
      (lambda ()
        (handle-client conn-socket))))
    (loop)))

(set-signal-handler! signal/int (lambda (_) (socket-close listener) (exit 0)))

)