;;;; json-rpc-client.scm
;
;; An implementation of the JSON-RPC protocol
;;
;; This file contains a client implementation.
;
; Copyright (c) 2013, Tim van der Linden
; All rights reserved.

; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are met:

; Redistributions of source code must retain the above copyright notice, this
; list of conditions and the following disclaimer. 
; Redistributions in binary form must reproduce the above copyright notice,
; this list of conditions and the following disclaimer in the documentation
; and/or other materials provided with the distribution. 
; Neither the name of the author nor the names of its contributors may be
; used to endorse or promote products derived from this software without
; specific prior written permission. 

; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.

(module json-rpc-client
  (json-rpc-server)

(import chicken scheme)
(use medea extras)

; Setup the custom error handlers
(define (server-setup-arguments-error type expected given)
  (signal
   (make-property-condition
    'exn 'message
     (sprintf "Cannot setup connection, the ~S is invalid. Excepted ~A type but got ~A."
	      type expected given))))

(define (server-setup-data-error type message)
  (signal
   (make-property-condition
    'exn 'message
     (sprintf "Cannot setup connection, the given ~S data is invalid. The ~S ~A"
	      type type message))))

; Helper for checking which type we have, did not want to use another dependency for that :)
(define get-type
  (lambda (x)
    (cond ((input-port? x) "an input port")
	  ((output-port? x) "an output port")
	  ((number? x) "a mumber")
          ((pair? x) "a pair")
          ((string? x) "a string")
          ((list? x) "a list")
	  ((vector? x) "a vector")
	  ((boolean? x) "a boolean")
	  ("something unknown"))))

; Setup the server and return a procedure to setup the method and optional params
; Do some basic checking if the input, output and version are as expected
;; - input: input port of the JSON-RPC server
;; - ouptput: ouput port of the JSON-RPC server
;; - version: the JSON-RPC version in which we want to communicate
(define json-rpc-server
  (lambda (input output version)
    (cond ((not (input-port? input)) (server-setup-arguments-error "input port" "input-port" (get-type input)))
	  ((not (output-port? output)) (server-setup-arguments-error "output port" "ouput-port" (get-type output)))
	  ((not (is-valid-version? version)) (server-setup-arguments-error "version" "2.0" version))
	  (else
	   (lambda (method . params)
	     (cond ((not (is-valid-method? method)) (server-setup-data-error "method" "can only be a string."))
		   ((not (are-valid-params? params)) (server-setup-data-error "params" "can only be a vector or an alist."))
		   (else
		    (send-request (append (list (cons 'jsonrpc version))
					  (list (cons 'method method))
					  (if (null? params) '()
					      (list (cons 'params (build-params params))))
					  (list (cons 'id "1"))) ;ID is hardcoded, overkill to generate random ID, you can't handle more then one request/response at a time...or can you?
				  input 
				  output))))))))

; Helper for building a vector or alist from the parameters if present
(define build-params
  (lambda (params)    
    (if (keyword? (car params)) 
	(build-alist params)
	(list->vector (build-vector params)))))

; Helper for building an alist
(define build-alist
  (lambda (params)
    (if (null? params) 
	(append '())
	(cons (cons (car params) (car (cdr params))) (build-alist (cdr (cdr params)))))))

; Helper for building a vector
(define build-vector
  (lambda (params)
    (if (null? params)
	'()
	(cons (symbol->string(car params)) (build-vector (cdr params))))))

; Check if the method is a string as defined in the spec
(define is-valid-method?
  (lambda (method)
    (string? method)))

; Check if the params are a list (alist or vector) as defined in the spec
(define are-valid-params?
  (lambda (params)
    (list? params))) ;Assumptions? Don't know if this check is enough (check for null (is also a list) or list)

; Check if the version is correctly formatted as defined in the spec
(define is-valid-version?
  (lambda (version)
    (string=? version "2.0")))

; Send the actual request using Medea
(define send-request
  (lambda (request input output)
    (write-json request output)))

)