#lang scheme
(require
 (lib "md5.ss" "file"))

(define (md5-bytes in)
  (let* ([chars (bytes->string/utf-8 (md5 in))]
         [count (/ (string-length chars) 2)]
         [bytes (make-bytes count)])
    (for ([i (in-range 0 count)])
      (let ([j (* i 2)])
        (bytes-set! bytes i (string->number (substring chars j (+ j 2)) 16))))
    bytes))
    
(define growl%
  (class object%
    (init-field
     name
     notifications)
    
    (init
     [hostname "localhost"]
     [port-no 9887])
    
    (super-new)
    
    (define socket
      (udp-open-socket hostname port-no))
    
    (udp-connect! socket hostname port-no)
    (let ([message (open-output-bytes 'message)]
          [name (string->bytes/utf-8 name)]
          [defaults (for/fold ([defaults '()]) ([i (in-naturals)] [n notifications])
                      (if (or (null? (cddr n)) (caddr n))
                          (cons i defaults)
                          defaults))])
      (write-byte 1 message) ; protocol version 1
      (write-byte 0 message) ; registration, MD5 auth
      
      (write-bytes (integer->integer-bytes (bytes-length name) 2 #f #t) message)
      (write-byte (length notifications) message)
      (write-byte (length defaults) message)
      
      (write-bytes name message)
      (for ([n notifications])
        (let ([type (string->bytes/utf-8 (cadr n))])
          (write-bytes (integer->integer-bytes (bytes-length type) 2 #f #t) message)
          (write-bytes type message)))
      (for ([d defaults])
        (write-byte d message))
      
      (write-bytes (md5-bytes (get-output-bytes message)) message)
      
      (udp-send socket (get-output-bytes message)))
    
    (define/public (notify id
                           #:title [title name] #:description description
                           #:priority [priority 0] #:sticky [sticky? #f])
      (let ([n (assoc id notifications)])
        (let ([message (open-output-bytes 'message)]
              [name (string->bytes/utf-8 name)]
              [type (string->bytes/utf-8 (cadr n))]
              [title (string->bytes/utf-8 title)]
              [description (string->bytes/utf-8 description)])
          (write-byte 1 message) ; protocol version 1
          (write-byte 1 message) ; notification, MD5 auth
          
          (write-bytes
           (integer->integer-bytes
            (bitwise-ior
             (case (min (max -2 priority) 2)
               [(-2) 10]
               [(-1) 12]
               [( 0) 0]
               [(+1) 2]
               [(+2) 4])
             (if sticky? 1 0))
            2 #f #t)
           message)
          
          (write-bytes (integer->integer-bytes (bytes-length type) 2 #f #t) message)
          (write-bytes (integer->integer-bytes (bytes-length title) 2 #f #t) message)
          (write-bytes (integer->integer-bytes (bytes-length description) 2 #f #t) message)
          (write-bytes (integer->integer-bytes (bytes-length name) 2 #f #t) message)
          
          (write-bytes type message)
          (write-bytes title message)
          (write-bytes description message)
          (write-bytes name message)
          
          (write-bytes (md5-bytes (get-output-bytes message)) message)
      
          (udp-send socket (get-output-bytes message)))))
    
    (define/public (close)
      (udp-close socket))))

(provide/contract
 [growl% class?])