;;;; 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
  hostname? check-hostname error-hostname
  ;;
  default-remote-mailbox-tcp-port-no
  default-remote-mailbox-hostname
  ;DEPRECATED
  default-remote-mailbox-tcp-port
  tcp-port? check-tcp-port error-tcp-port)

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

;;;

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

(define *environment-variable-tcp-port-no* (get-environment-variable "REMOTE-MAILBOX-TCP-PORT"))
(define *environment-variable-hostname* (get-environment-variable "REMOTE-MAILBOX-HOSTNAME"))

(define *tcp-port-no* (or *environment-variable-tcp-port-no* DEFAULT-TCP-PORT-NO))
(define *hostname* (or *environment-variable-hostname* DEFAULT-HOSTNAME))

;;;

(define-type mailbox-name symbol)
(define-type tcp-port-no fixnum)
(define-type hostname string)

(: mailbox-name? (* -> boolean : mailbox-name))
;
(define mailbox-name? symbol?)

(: tcp-port-no? (* -> boolean : tcp-port-no))
;
(define (tcp-port-no? obj)
  (and
    (fixnum? obj)
    (and (fx< 0 obj) (fx<= obj 65535))) )

(: hostname? (* -> boolean : hostname))
;
(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 hostname)

;;; Parameters

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

(: default-remote-mailbox-tcp-port-no (#!optional (or boolean fixnum) -> fixnum))
;
(define-warning-parameter default-remote-mailbox-tcp-port-no *tcp-port-no* remote-mailbox-tcp-port-no
  ;ugh, automagic identifier injection
  (unless obj (set! obj *tcp-port-no*)) )

(define (remote-mailbox-hostname? x)
  (or (not x) (hostname? x)) )

(: default-remote-mailbox-hostname (#!optional (or boolean string) -> string))
;
(define-warning-parameter default-remote-mailbox-hostname *hostname* remote-mailbox-hostname
  ;ugh, automagic identifier injection
  (unless obj (set! obj *hostname*)) )

;;DEPRECATED

(: default-remote-mailbox-tcp-port (deprecated default-remote-mailbox-tcp-port-no))
(define default-remote-mailbox-tcp-port default-remote-mailbox-tcp-port-no)

(: tcp-port? (deprecated tcp-port-no?))
(define tcp-port? tcp-port-no?)

(: check-tcp-port (deprecated check-tcp-port-no))
(: error-tcp-port (deprecated error-tcp-port-no))
#|
Warning: in toplevel procedure `remote-mailbox-common#check-tcp-port':
  use of deprecated `remote-mailbox-common#tcp-port?' - consider `tcp-port-no?'

Warning: in toplevel procedure `remote-mailbox-common#check-tcp-port':
  use of deprecated `remote-mailbox-common#error-tcp-port' - consider `error-tcp-port-no'
|#
(define-check+error-type tcp-port)

) ;module remote-mailbox-common