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

(module remote-mailbox-common

(;export
  ;
  mailbox-name? check-mailbox-name error-mailbox-name
  tcp-port-no? check-tcp-port-no error-tcp-port-no
  expected-size? check-expected-size error-expected-size
  hostname? check-hostname error-hostname
  ;
  remote-mailbox-default-tcp-port-no
  remote-mailbox-default-expected-size
  remote-mailbox-default-hostname)

(import scheme
  (chicken base)
  (chicken type)
  (chicken fixnum)
  (chicken process-context)
  (only (srfi 13) string-null?)
  (only moremacros define-warning-parameter)
  (only type-errors warning-argument-type)
  (only type-checks define-check+error-type))

;;

(include-relative "remote-mailbox.types")

(: mailbox-name? (* -> boolean : mailbox-name))
(: tcp-port-no? (* -> boolean : tcp-port-no))
(: hostname? (* -> boolean : hostname))
(: remote-mailbox-default-tcp-port-no (#!optional (or boolean fixnum) -> fixnum))
(: remote-mailbox-default-expected-size (#!optional (or boolean fixnum) -> fixnum))
(: remote-mailbox-default-hostname (#!optional (or boolean string) -> string))

;;;

(define-constant DEFAULT-TCP-PORT-NO 63001)
(define-constant DEFAULT-HOSTNAME "localhost")

(define-constant DEFAULT-EXPECTED 8)

(define *environment-variable-tcp-port-no* (get-environment-variable "REMOTE_MAILBOX_TCP_PORT"))
(define *environment-variable-expected* (get-environment-variable "REMOTE_MAILBOX_EXPECTED"))
(define *environment-variable-hostname* (get-environment-variable "REMOTE_MAILBOX_HOSTNAME"))

(define *tcp-port-no*
  (if *environment-variable-tcp-port-no* (string->number *environment-variable-tcp-port-no*)
    DEFAULT-TCP-PORT-NO))
(define *expected-size*
  (if *environment-variable-expected* (string->number *environment-variable-expected*)
    DEFAULT-EXPECTED))
(define *hostname*
  (or *environment-variable-hostname* DEFAULT-HOSTNAME))

;;

(define mailbox-name? symbol?)

(define (tcp-port-no? obj)
  (and (fixnum? obj)
       (and (fx< 0 obj) (fx<= obj 65535))) )

(define (expected-size? obj)
  (and (fixnum? obj)
       (fx< 0 obj)) )

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

;;

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

(define (remote-mailbox-tcp-port-no? x) (or (not x) (tcp-port-no? x)))
(define (remote-mailbox-expected-size? x) (or (not x) (expected-size? x)))
(define (remote-mailbox-hostname? x) (or (not x) (hostname? x)))

;; Parameters

(define-warning-parameter remote-mailbox-default-tcp-port-no *tcp-port-no* remote-mailbox-tcp-port-no
  ;ugh, automagic identifier injection
  (unless obj (set! obj *tcp-port-no*)) )

(define-warning-parameter remote-mailbox-default-expected-size *expected-size* remote-mailbox-expected-size
  ;ugh, automagic identifier injection
  (unless obj (set! obj *expected-size*)) )

(define-warning-parameter remote-mailbox-default-hostname *hostname* remote-mailbox-hostname
  ;ugh, automagic identifier injection
  (unless obj (set! obj *hostname*)) )

) ;module remote-mailbox-common