random-org.ss
;Copyright © 2009 Tyler Curtis
;
;Permission is hereby granted, free of charge, to any person
;obtaining a copy of this software and associated documentation
;files (the "Software"), to deal in the Software without
;restriction, including without limitation the rights to use,
;copy, modify, merge, publish, distribute, sublicense, and/or sell
;copies of the Software, and to permit persons to whom the
;Software is furnished to do so, subject to the following
;conditions:
;
;The above copyright notice and this permission notice shall be
;included in all copies or substantial portions of the Software.
;
;THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;OTHER DEALINGS IN THE SOFTWARE.

(module random-org scheme
  (require net/url)
  
  
  (provide/contract [rename check-quota random-org:check-quota (->* ()
                                                                    (#:ip string?)
                                                                    integer?)]
                    [rename generate-integers random-org:generate-integers (->* ()
                                                                                (#:num 
                                                                                 (integer-in 1 (expt 10 4))
                                                                                 #:min 
                                                                                 (integer-in (expt -10 9)
                                                                                             (expt 10 9))
                                                                                 #:max 
                                                                                 (integer-in (expt -10 9)
                                                                                             (expt 10 9)))
                                                                                (listof integer?))]
                    [rename generate-sequence random-org:generate-sequence (->* () 
                                                                                (#:min 
                                                                                 (integer-in (expt -10 9)
                                                                                             (expt 10 9))
                                                                                 #:max 
                                                                                 (integer-in (expt -10 9)
                                                                                             (expt 10 9)))
                                                                                (listof integer?))]
                    [rename generate-strings random-org:generate-strings (->* () 
                                                                              (#:num 
                                                                               (integer-in 1 (expt 10 4))
                                                                               #:len 
                                                                               (integer-in 1 20)
                                                                               #:digits boolean?
                                                                               #:upper boolean?
                                                                               #:lower boolean?
                                                                               #:unique boolean?)
                                                                              (listof string?))]
                    [rename generate-password random-org:generate-password (-> (integer-in 1 (expt 10 4))
                                                                               string?)])
  (provide (prefix-out random-org: *default-number-integers*)
           (prefix-out random-org: *default-min-integer*)
           (prefix-out random-org: *default-max-integer*)
           (prefix-out random-org: *default-number-strings*)
           (prefix-out random-org: *default-length-strings*))
  
  
  
  
  (define *integer-url-string* "http://random.org/integers/?format=plain")
  (define *sequence-url-string* "http://random.org/sequences/?format=plain")
  (define *string-url-string* "http://random.org/strings/?format=plain")
  (define *quota-url-string* "http://random.org/quota/?format=plain")
  
  (define (check-quota #:ip [ip #f])
    (if ip
        (read (get-pure-port (string->url (string-append *quota-url-string* "&ip=" ip))))
        (read (get-pure-port (string->url *quota-url-string*)))))
  
  (define *default-number-integers* 1)
  (define *default-min-integer* 0)
  (define *default-max-integer* 1000)
  (define *default-columns-integers* 1)
  
  (define (generate-integers #:num [num *default-number-integers*] 
                             #:min [min *default-min-integer*] 
                             #:max [max *default-max-integer*])
    (let [(port (get-pure-port (string->url 
                                (string-append 
                                 *integer-url-string*
                                 (string-append "&num=" (number->string num))
                                 (string-append "&min=" (number->string min))
                                 (string-append "&max=" (number->string max))
                                 (string-append "&col=" (number->string *default-columns-integers*))
                                 "&base=10"))))]
      (define (read-numbers)
        (let ([n (read port)])
          (cond [(eq? eof n) null]
                [else (cons n (read-numbers))])))
      (read-numbers)))
  
  (define (generate-sequence #:min [min *default-min-integer*] 
                             #:max [max *default-max-integer*])
    (let [(port (get-pure-port (string->url 
                                (string-append 
                                 *sequence-url-string*
                                 (string-append "&min=" (number->string min))
                                 (string-append "&max=" (number->string max))
                                 (string-append "&col=" (number->string *default-columns-integers*))))))]
      (define (read-numbers)
        (let ([n (read port)])
          (cond [(eq? eof n) null]
                [else (cons n (read-numbers))])))
      (read-numbers)))
  
  (define *default-number-strings* 1)
  (define *default-length-strings* 5)
  (define (generate-strings #:num (num *default-number-strings*) #:len (len *default-length-strings*) 
                            #:digits (digits #t) #:upper (upper #t)
                            #:lower (lower #t) #:unique (unique #t))
    (for/list ((s (in-lines
                   (get-pure-port
                    (string->url (string-append *string-url-string*
                                                "&num=" (number->string num)
                                                "&len=" (number->string len)
                                                "&digits=" (if digits "on" "off")
                                                "&upperalpha=" (if upper "on" "off")
                                                "&loweralpha=" (if lower "on" "off")
                                                "&unique=" (if unique "on" "off")))))))
      s))

  (define (generate-password len)
    (list->string (map integer->char (generate-integers #:min 32 #:max 127 #:num len))))
  
  )