Commits

Anonymous committed 0e2db23

Tools for generating wrappers to REST-like HTTP APIs

'define-method' generates scheme procedures that call the underlying HTTP
API with the parameters given.

The user can specify required arguments that are included in the path of
the URL as well as optional keyword arguments that are included in the
query string. The user can also specify procedures for writing the body of
the HTTP request, reading the body of the response and reading the headers
of the response.

The header response reader is currently unimplemented: it can be specified
but is never called.

EXAMPLE
=======

Here we bind to
https://api.dropbox.com/1/metadata/<root>/<path>?file_limit=<>&;...

The Dropbox API docs specify the response as JSON so we read it with
read-json from the medea egg. The request uses the GET method and has no
body so we substitute #f for the writer procedure.

(define-method (metadata root path #!key file_limit hash list include_deleted rev locale)
"https://api.dropbox.com/1/metadata/";
#f
read-json)

Signed-off-by: Andy Bennett <andyjpb@knodium.com>

Comments (0)

Files changed (3)

+(
+ ; Your egg's license:
+ (license "BSD")
+
+ ; Pick one from the list of categories (see below) for your egg and enter it
+ ; here.
+ (category web)
+
+ ; A list of eggs rest-bind depends on.  If none, you can omit this declaration
+ ; altogether. `depends' is an alias to `needs'.
+ ; Notice that you should NOT put Chicken units (e.g., srfi-1, srfi-13
+ ; and many others) in `needs' or in `depends'.
+ ;(needs nothing)
+
+ ; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+ ; Just like `needs' and `depends', `test-depends' should NOT contain
+ ; Chicken units.
+ (test-depends test)
+
+ (author "Andy Bennett <andyjpb@knodium.com>")
+ (synopsis "Generates wrappers to REST-like HTTP APIs."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; REST Procedure Call
+;;; Generates wrappers to REST-like HTTP APIs
+;;;
+;;;  Copyright (C) 2012, Andy Bennett
+;;;  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.
+;;;
+;;; Andy Bennett <andyjpb@knodium.com>, 2012/10/29
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module rest-bind
+ (define-method)
+
+(import chicken scheme)
+(import-for-syntax chicken srfi-1)
+(use data-structures)
+
+; (define-method (name args...) endpoint writer reader #!optional header)
+; -> if no writer is provided, generates a procedure (name #!optional args...)
+;    otherwise generates a procedure (name body #!optional args...)
+; endpoint is the URI provided for the API call
+; writer is a procedure of one argument.
+;   writer is called with body
+;   writer should return something suitable for passing to
+;   call-with-input-request
+;     i.e. a string containing the raw data to send, an alist or a pair of
+;     values: a procedure that accepts a port and writes the response data to
+;     it and an alist of extra headers. If you supply a pair of values then do
+;     not forget to include a content-length header in the accompanying alist.
+(define-syntax define-method
+  (ir-macro-transformer
+    (lambda (expr inject compare)
+      (assert (pair? expr))
+      (let* ((proc (car expr))
+	     (defn (cdr expr))
+	     (_ (assert (list? defn)))
+	     (_ (assert (or (= 4 (length defn)) (= 5 (length defn)))))
+	     (sig      (first defn))
+	     (name     (car sig))
+	     (args     (cdr sig))
+	     (pred     (lambda (x) (not (eqv? '#!key x))))
+	     (params   (drop-while pred args))
+	     (params   (if (null? params) params (cdr params)))
+	     (pos-args (take-while pred args))
+	     (uri/req  (second defn))
+	     (writer   (third defn))
+	     (reader   (fourth defn))
+	     (args     (if writer
+			 `(,@pos-args body)
+			 `(,@pos-args)))
+	     (args     (if (not (null? params))
+			 `(,@args #!key ,@params)
+			 `(,@args))))
+	;(list 'quote
+	      `(define ,name
+		 (let* ((writer  ,writer)
+			(uri/req ,uri/req)
+			(uri     (cond ((request? uri/req) (request-uri uri/req))
+				       ((uri? uri/req) uri/req)
+				       (else (uri-reference uri/req))))
+			(method  (cond ((request? uri/req) (request-method uri/req))
+				       (writer 'POST)
+				       (else 'GET))))
+		   (lambda ,args
+		     (let* (,@(if (not (null? pos-args))
+			      `((uri (update-uri uri path: (append (uri-path uri) (map ->string (list ,@pos-args)))))
+				      ;(_ (pp (uri-path uri)))
+			       )
+			      '())
+			   ,@(if (not (null? params))
+			       `((uri (update-uri uri query: (append (uri-query uri)
+								     (list ,@(map (lambda (param)
+										    ``(,',param . ,(if ,param
+												     (->string ,param)
+												     ,param)))
+										  params))))))
+				   '())
+			   (req (make-request uri: uri method: method)) ; poke the args into query string.
+			   )
+		       (call-with-input-request req ,(if writer '(writer body) #f) ,reader)))))
+	      ;)
+	))))
+
+)
+
+; These two instructions will produce statically and dynamically linkable
+; object files "rest-bind.o" and "rest-bind.so" respectively.
+(compile -s -O2 -d1 rest-bind.scm -j rest-bind)
+(compile -s rest-bind.import.scm -O2 -d0)
+(compile -c -O2 -d1 rest-bind.scm -unit rest-bind -j rest-bind)
+(install-extension
+  ; Name of your extension:
+  'rest-bind
+  ; Files to install for your extension:
+  '("rest-bind.o" "rest-bind.so" "rest-bind.import.so")
+  ; Assoc list with properties for your extension:
+  '((version "0.1") ;; version number should be a string
+    (static "rest-bind.o"))) ;; for static linking
+