1. Tim van der Linden
  2. json-rpc

Commits

Limburgse Natuurgidsen  committed 7e24b2b

Working dispatcher thread for private reponses and public messages sent by the server.

  • Participants
  • Parent commits c5a3371
  • Branches default

Comments (0)

Files changed (1)

File json-rpc-client.scm

View file
 	((boolean? x) "a boolean")
 	("something unknown")))
 
-; Setup the server and return a procedure to setup the method and optional params
+; Setup the server connection 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
+;; - full-data: disclose full data or only the SPEC compliant "result" part of the response
+;; - public-receiver: user defined procedure which will fire when receiving a broadcast message 
 ;;
 ;; When succesfully called, the lambda will return the CHICKEN data containing the server repsonse
 ;; unless we send the the request as a notification
-(define (json-rpc-server input output #!optional (version "2.0"))
+(define (json-rpc-server input output #!key (version "2.0") (full-data #f) (public-receiver #f))
   (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
-	 (thread-start! (listener-thread input (current-thread))) ; Start the looping listener thread
+	 (thread-start! (listener-thread input (current-thread) public-receiver)) ; Start the looping listener thread
 	 (lambda (method . params)
 	   (cond ((not (is-valid-method? method)) (server-setup-data-error "method" "can only be a string or a symbol."))
 		 ((not (are-valid-params? params)) (server-setup-data-error "params" "can only be a vector or an alist."))
 							'()
 							(cons 'id "1")))) ; ID is hardcoded - can't handle more then one request at a time...or can we?
 				output)
-		  (if (symbol? method) #f (thread-receive)))))))) ; Send back a repsonse if needed
+		  (if (symbol? method) 
+		      #f ; If it is a symbol, then we do not expect a reponse, so return #f
+		      (if full-data
+			  (thread-receive) ; Return the full repsonse data
+			  (let ((data (thread-receive)))
+				(cond ((alist-ref 'result data) (alist-ref 'result data)) ; Return only the "result" part of the reponse
+				      ((alist-ref 'error data) (alist-ref 'error data)))))))))))) ; Return only the "error" part of the repsonse
 
 ; Helper for building a vector or alist from the parameters if present
 (define (build-params params)
 
 ; Create the looping listener thread which will dispatch messages to various thread-mailboxes
 ;; Keep reading the JSON sent back from the server, if the reponse contains an ID then this is a 
-;; repsonse to the request sent so dispatch a message to the current threads mailbox. 
-;; Otherwise send the message to the public threads mailbox (?). 
-(define (listener-thread input current-thread) 
+;; repsonse to the request sent, so dispatch a message to the current threads mailbox. 
+;; Otherwise, when defined, fire the user defined public receiver procedure with the public data sent by the server. 
+(define (listener-thread input current-thread public-receiver) 
   (make-thread
    (lambda ()
      (let listen-loop
-         ; Note that we have to set Medea to not consume trailing whitespace for otherwise Medea will swallow
-         ; the first character of the *next* json string waiting in the port and thus render that string useless.
-	 ((data (read-json input consume-trailing-whitespace: #f)))
+       ; Note that we have to set Medea to not consume trailing whitespace for otherwise Medea will swallow
+       ; the first character of the *next* json string waiting in the port and thus render that string useless.
+       ((data (read-json input consume-trailing-whitespace: #f)))
        (if (alist-ref 'id data)
-	   (thread-send current-thread data))
+	   (thread-send current-thread data)
+	   (when public-receiver ; If we have a public-receiver procedure (not #f), call it with data
+		 (public-receiver data)))
        (listen-loop (read-json input consume-trailing-whitespace: #f))))
    'listener))