;;;; remote-mailbox-common.scm
;;;; Kon Lovett, Sep '09

(module remote-mailbox-common

  (;export
    ;;
    mailbox-name?
    tcp-port?
    hostname?
    error-mailbox-name
    error-tcp-port
    error-hostname
    check-mailbox-name
    check-tcp-port
    check-hostname
    ;;
    make-remote-mailbox-packet
    remote-mailbox-packet?
    remote-mailbox-packet-key
    remote-mailbox-packet-value
    ;;
    default-remote-mailbox-tcp-port
    default-remote-mailbox-hostname)

  (import scheme
          chicken
          (only srfi-13 string-null?)
          (only miscmacros define-parameter)
          (only type-checks define-check+error-type))

  (require-library srfi-13 miscmacros type-checks)

;;;

(define mailbox-name? symbol?)

(define (tcp-port? obj) (and (fixnum? obj) (and (fx< 0 obj) (fx< obj 65536))))

(define (hostname? obj) (and (string? obj) (not (string-null? obj))))

;;;

(define-check+error-type mailbox-name)
(define-check+error-type hostname)
(define-check+error-type tcp-port)

;;; Remote Mailbox Packet

(define +remote-mailbox-tag+ 'rmbtag)

(define (make-remote-mailbox-packet key val) (vector +remote-mailbox-tag+ key val))

(define (remote-mailbox-packet? obj)
	(and (vector? obj)
			 (= 3 (vector-length obj))
			 (eq? +remote-mailbox-tag+ (vector-ref obj 0))) )

(define (remote-mailbox-packet-key rmp) (vector-ref rmp 1))

(define (remote-mailbox-packet-value rmp) (vector-ref rmp 2))

;;; Parameters

(define-parameter default-remote-mailbox-tcp-port 63001
	(lambda (x)
		(cond ((tcp-port? x) x)
          (else (default-remote-mailbox-tcp-port) ) ) ) )

(define-parameter default-remote-mailbox-hostname "localhost"
	(lambda (x)
		(cond ((hostname? x) x)
          (else (default-remote-mailbox-hostname) ) ) ) )

) ;module remote-mailbox-common