The Protobufs library defines a set of model classes that describes a
protobufs "schema". There is a class that describes one .proto file
(i.e., one "schema"), options, enums and enum values, messages and
-fields, and services and RPCs.
+fields, and services and methods.
The library provides the means to convert several kinds of inputs into
the Protobufs models, including:
proto:protobuf-service [Class]
The class that represents a Protobufs service.
-It has slots for the name, options and RPCs.
+It has slots for the name, options and methods.
::
- proto:protobuf-rpc [Class]
+ proto:protobuf-method [Class]
-The class that represents one RPC descriptions in a Protobufs service.
+The class that represents one method description in a Protobufs service.
It has slots for the name, input type, output type and options.
proto:define-service (type (&key name [Macro]
options documentation)
- &body rpc-specs)
+ &body method-specs)
Defines a Protobufs service named *type* and corresponding Lisp
-defgenerics for all its RPCs. If *name* is not supplied, the Protobufs
+defgenerics for all its methods. If *name* is not supplied, the Protobufs
name of the enum is the camel-cased rendition of *type*; otherwise the
Protobufs name is the string *name*.
*documentation* is a documentation string that is preserved as a comment
in the .proto file.
-The body is a set of RPC specs of the form
+The body is a set of method specs of the form
``(name (input-type output-type) &key options documentation)``.
-*name* is a symbol naming the RPC function. *input-type* and
+*name* is a symbol naming the RPC method. *input-type* and
*output-type* may either be symbols or a list of the form ``(type &key name)``.
()))
;; Define a service named 'type' with generic functions declared for
-;; each of the RPCs within the service
+;; each of the methods within the service
(defmacro define-service (type (&key name options documentation)
- &body rpc-specs)
- "Define a service named 'type' and Lisp 'defgeneric' for all its RPCs.
+ &body method-specs)
+ "Define a service named 'type' and Lisp 'defgeneric' for all its methods.
'name' can be used to override the defaultly generated Protobufs service name.
'options' is a set of keyword/value pairs, both of which are strings.
- The body is a set of RPC specs of the form (name (input-type output-type) &key options).
+ The body is a set of method specs of the form (name (input-type output-type) &key options).
'input-type' and 'output-type' may also be of the form (type &key name)."
- (with-collectors ((rpcs collect-rpc)
+ (with-collectors ((methods collect-method)
(forms collect-form))
- (dolist (rpc rpc-specs)
- (destructuring-bind (function (input-type output-type) &key name options documentation) rpc
+ (dolist (method method-specs)
+ (destructuring-bind (function (input-type output-type) &key name options documentation) method
(let* ((input-name (and (listp input-type)
(getf (cdr input-type) :name)))
(input-type (if (listp input-type) (car input-type) input-type))
collect `(make-instance 'protobuf-option
:name ,key
:value ,val))))
- (collect-rpc `(make-instance 'protobuf-rpc
- :class ',function
- :name ',(or name (class-name->proto function))
- :input-type ',input-type
- :input-name ',(or input-name (class-name->proto input-type))
- :output-type ',output-type
- :output-name ',(or output-name (class-name->proto output-type))
- :options (list ,@options)
- :documentation ,documentation))
+ (collect-method `(make-instance 'protobuf-method
+ :class ',function
+ :name ',(or name (class-name->proto function))
+ :input-type ',input-type
+ :input-name ',(or input-name (class-name->proto input-type))
+ :output-type ',output-type
+ :output-name ',(or output-name (class-name->proto output-type))
+ :options (list ,@options)
+ :documentation ,documentation))
;; The following are the hooks to CL-Stubby
(let ((client-fn function)
(server-fn (intern (format nil "~A-~A" 'do function) (symbol-package function)))
(vchannel (intern (symbol-name 'channel) (symbol-package function)))
(vcallback (intern (symbol-name 'callback) (symbol-package function))))
- ;; The client side stub, e.g., 'read-air-reservation'
+ ;; The client side stub, e.g., 'read-air-reservation'.
;; The expectation is that CL-Stubby will provide macrology to make it
;; easy to implement a method for this on each kind of channel (HTTP, TCP socket,
;; IPC, etc). Unlike C++/Java/Python, we don't need a client-side subclass,
;; because we can just use multi-methods.
- ;; The method (de)serializes the objects, does error checking, etc
- (collect-form `(defgeneric ,client-fn (,vchannel ,input-type)
+ ;; The CL-Stubby macros take care of serializing the input, transmitting the
+ ;; request over the wire, waiting for input (or not if it's asynchronous),
+ ;; filling in the output, and calling the callback (if it's synchronous).
+ ;; It's not very Lispy to side-effect an output object, but it makes
+ ;; asynchronous calls simpler.
+ (collect-form `(defgeneric ,client-fn (,vchannel ,input-type ,output-type &key ,vcallback)
,@(and documentation `((:documentation ,documentation)))
(declare (values ,output-type))))
- ;; The server side stub, e.g., 'do-read-air-reservation'
+ ;; The server side stub, e.g., 'do-read-air-reservation'.
;; The expectation is that the server-side program will implement
;; a method with the business logic for this on each kind of channel
;; (HTTP, TCP socket, IPC, etc), possibly on a server-side subclass
;; of the input class
;; The business logic is expected to perform the correct operations on
;; the input object, which arrived via Protobufs, and produce an output
- ;; of the given type, which will be serialized as a result
+ ;; of the given type, which will be serialized as a result.
;; The channel objects hold client identity information, deadline info,
;; etc, and can be side-effected to indicate success or failure
;; CL-Stubby provides the channel classes and does (de)serialization, etc
- (collect-form `(defgeneric ,server-fn (,vchannel ,input-type &optional ,vcallback)
+ (collect-form `(defgeneric ,server-fn (,vchannel ,input-type ,output-type &key ,vcallback)
,@(and documentation `((:documentation ,documentation)))
(declare (values ,output-type))))))))
(let ((name (or name (class-name->proto type)))
:class ',type
:name ',name
:options (list ,@options)
- :rpcs (list ,@rpcs)
+ :methods (list ,@methods)
:documentation ,documentation)
,forms))))
(ensure-type trace message field (proto-class field)))
(defmethod ensure-service (trace (service protobuf-service))
- (map () (curry #'ensure-rpc trace service) (proto-rpcs service)))
+ (map () (curry #'ensure-method trace service) (proto-methods service)))
-(defmethod ensure-rpc (trace service (rpc protobuf-rpc))
- (ensure-type trace service rpc (proto-input-type rpc))
- (ensure-type trace service rpc (proto-output-type rpc)))
+(defmethod ensure-method (trace service (method protobuf-method))
+ (ensure-type trace service method (proto-input-type method))
+ (ensure-type trace service method (proto-output-type method)))
-;; 'message' and 'field' can be a message and a field or a service and an RPC
+;; 'message' and 'field' can be a message and a field or a service and a method
(defun ensure-type (trace message field type)
(unless (keywordp type)
(let ((msg (loop for p in trace
'(proto:protobuf proto:protobuf-option
proto:protobuf-enum proto:protobuf-enum-value
proto:protobuf-message proto:protobuf-field proto:protobuf-extension
- proto:protobuf-service proto:protobuf-rpc)))
+ proto:protobuf-service proto:protobuf-method)))
(proto:write-protobuf pschema)
(proto:write-protobuf pschema :type :lisp)
proto:protobuf-field
proto:protobuf-extension
proto:protobuf-service
- proto:protobuf-rpc))
+ proto:protobuf-method))
(let ((message (proto-impl:find-message pschema class)))
(eval (proto-impl:generate-object-size message))
(eval (proto-impl:generate-serializer message))
:required :optional
:index 2
:default "LOW")))))
- (rpcs (list (make-instance 'proto:protobuf-rpc
- :name "GetColor"
- :input-name "string"
- :output-name "Color")
- (make-instance 'proto:protobuf-rpc
- :name "SetColor"
- :input-name "Color"
- :output-name "Color"
- :options (list (make-instance 'proto:protobuf-option
- :name "deadline" :value "1.0")))))
+ (methods (list (make-instance 'proto:protobuf-method
+ :name "GetColor"
+ :input-name "string"
+ :output-name "Color")
+ (make-instance 'proto:protobuf-method
+ :name "SetColor"
+ :input-name "Color"
+ :output-name "Color"
+ :options (list (make-instance 'proto:protobuf-option
+ :name "deadline" :value "1.0")))))
(svcs (list (make-instance 'proto:protobuf-service
:name "ColorWheel"
- :rpcs rpcs)))
+ :methods methods)))
(proto (make-instance 'proto:protobuf
:package "ita.color"
:imports '("descriptor.proto")
:SERVICES (LIST (MAKE-INSTANCE 'PROTOBUF-SERVICE
:NAME "ColorWheel"
:CLASS 'COLOR-WHEEL
- :RPCS (LIST (MAKE-INSTANCE 'PROTOBUF-RPC
- :NAME "GetColor"
- :CLASS 'GET-COLOR
- :INPUT-NAME "string"
- :OUTPUT-NAME "Color"
- :OPTIONS (LIST))
- (MAKE-INSTANCE 'PROTOBUF-RPC
- :NAME "SetColor"
- :CLASS 'SET-COLOR
- :INPUT-NAME "Color"
- :OUTPUT-NAME "Color"
- :OPTIONS (LIST (MAKE-INSTANCE 'PROTOBUF-OPTION
- :NAME "deadline" :VALUE "1.0")))))))))
+ :METHODS (LIST (MAKE-INSTANCE 'PROTOBUF-METHOD
+ :NAME "GetColor"
+ :CLASS 'GET-COLOR
+ :INPUT-NAME "string"
+ :OUTPUT-NAME "Color"
+ :OPTIONS (LIST))
+ (MAKE-INSTANCE 'PROTOBUF-METHOD
+ :NAME "SetColor"
+ :CLASS 'SET-COLOR
+ :INPUT-NAME "Color"
+ :OUTPUT-NAME "Color"
+ :OPTIONS (LIST (MAKE-INSTANCE 'PROTOBUF-OPTION
+ :NAME "deadline" :VALUE "1.0")))))))))
;; The output should be example the same as the output of 'write-protobuf' above
(proto:write-protobuf *color-wheel*)
;; A protobuf service
(defclass protobuf-service (base-protobuf)
- ((rpcs :type (list-of protobuf-rpc) ;the RPCs in the service
- :accessor proto-rpcs
- :initarg :rpcs
- :initform ()))
+ ((methods :type (list-of protobuf-method) ;the methods in the service
+ :accessor proto-methods
+ :initarg :methods
+ :initform ()))
(:documentation
"The model class that represents a Protobufs service."))
(proto-name s))))
-;; A protobuf RPC within a service
-(defclass protobuf-rpc (base-protobuf)
+;; A protobuf method within a service
+(defclass protobuf-method (base-protobuf)
((itype :type (or null symbol) ;the Lisp type name of the input
:accessor proto-input-type
:initarg :input-type
:initarg :output-name
:initform nil))
(:documentation
- "The model class that represents one RPC with a Protobufs service."))
+ "The model class that represents one method with a Protobufs service."))
-(defmethod print-object ((r protobuf-rpc) stream)
+(defmethod print-object ((r protobuf-method) stream)
(print-unreadable-object (r stream :type t :identity t)
(format stream "~S (~S) => (~S)"
(proto-function r) (proto-input-type r) (proto-output-type r))))
;; The 'class' slot really holds the name of the function,
;; so let's give it a better name
-(defmethod proto-function ((rpc protobuf-rpc))
- (proto-class rpc))
+(defmethod proto-function ((method protobuf-method))
+ (proto-class method))
-(defmethod (setf proto-function) (function (rpc protobuf-rpc))
- (setf (proto-function rpc) function))
+(defmethod (setf proto-function) (function (method protobuf-method))
+ (setf (proto-function method) function))
;; Better type checking for these guys
(quux:declare-list-of protobuf-extension)
(quux:declare-list-of protobuf-field)
(quux:declare-list-of protobuf-service)
-(quux:declare-list-of protobuf-rpc)
+(quux:declare-list-of protobuf-method)
) ;#+quux
(defun parse-proto-option (stream protobuf &optional (terminator #\;))
"Parse a Protobufs option from 'stream'.
- Updates the 'protobuf' (or message, service, RPC) to have the option."
+ Updates the 'protobuf' (or message, service, method) to have the option."
(let* ((key (prog1 (parse-token stream)
(expect-char stream #\= "option")))
(val (prog1 (if (eql (peek-char nil stream nil) #\")
(cond ((string= token "option")
(parse-proto-option stream service #\;))
((string= token "rpc")
- (parse-proto-rpc stream service token))
+ (parse-proto-method stream service token))
(t
(error "Unrecognized token ~A at position ~D"
token (file-position stream))))))))
-(defun parse-proto-rpc (stream service rpc)
+(defun parse-proto-method (stream service method)
"Parse a Protobufs enum vvalue from 'stream'.
Updates the 'protobuf-enum' object to have the enum value."
- (declare (ignore rpc))
+ (declare (ignore method))
(let* ((name (parse-token stream))
(in (prog2 (expect-char stream #\( "service")
(parse-token stream)
(out (prog2 (expect-char stream #\( "service")
(parse-token stream)
(expect-char stream #\) "service")))
- (opts (let ((opts (parse-proto-rpc-options stream)))
+ (opts (let ((opts (parse-proto-method-options stream)))
(when (or (null opts) (eql (peek-char nil stream nil) #\;))
(expect-char stream #\; "service"))
(maybe-skip-comments stream)
opts))
- (rpc (make-instance 'protobuf-rpc
- :class (proto->class-name name *protobuf-package*)
- :name name
- :input-type (proto->class-name in *protobuf-package*)
- :input-name in
- :output-type (proto->class-name out *protobuf-package*)
- :output-name out
- :options opts)))
- (let ((name (find-option rpc "lisp_name")))
+ (method (make-instance 'protobuf-method
+ :class (proto->class-name name *protobuf-package*)
+ :name name
+ :input-type (proto->class-name in *protobuf-package*)
+ :input-name in
+ :output-type (proto->class-name out *protobuf-package*)
+ :output-name out
+ :options opts)))
+ (let ((name (find-option method "lisp_name")))
(when name
- (setf (proto-function rpc) (make-lisp-symbol name))))
+ (setf (proto-function method) (make-lisp-symbol name))))
(assert (string= ret "returns") ()
"Syntax error in 'message' at position ~D" (file-position stream))
- (setf (proto-rpcs service) (nconc (proto-rpcs service) (list rpc)))))
+ (setf (proto-methods service) (nconc (proto-methods service) (list method)))))
-(defun parse-proto-rpc-options (stream)
- "Parse any options in a Protobufs RPC from 'stream'.
+(defun parse-proto-method-options (stream)
+ "Parse any options in a Protobufs method from 'stream'.
Returns a list of 'protobuf-option' objects."
(when (eql (peek-char nil stream nil) #\{)
(expect-char stream #\{ "service")
(write-protobuf-documentation type documentation stream :indentation indentation))
(format stream "~&~@[~VT~]service ~A {~%"
(and (not (zerop indentation)) indentation) name)
- (dolist (rpc (proto-rpcs service))
- (write-protobuf-as type rpc stream :indentation (+ indentation 2)))
+ (dolist (method (proto-methods service))
+ (write-protobuf-as type method stream :indentation (+ indentation 2)))
(format stream "~&~@[~VT~]}~%"
(and (not (zerop indentation)) indentation))))
-(defmethod write-protobuf-as ((type (eql :proto)) (rpc protobuf-rpc) stream
+(defmethod write-protobuf-as ((type (eql :proto)) (method protobuf-method) stream
&key (indentation 0))
- (with-prefixed-accessors (name documentation input-name output-name options) (proto- rpc)
+ (with-prefixed-accessors (name documentation input-name output-name options) (proto- method)
(when documentation
(write-protobuf-documentation type documentation stream :indentation indentation))
(format stream "~&~@[~VT~]rpc ~A (~@[~A~])~@[ returns (~A)~]"
(defmethod write-protobuf-as ((type (eql :lisp)) (protobuf protobuf) stream
&key (indentation 0))
(with-prefixed-accessors (name class documentation package lisp-package imports optimize options) (proto- protobuf)
- (when package
- (format stream "~&(in-package \"~A\")~%~%" (or lisp-package package)))
- (when documentation
- (write-protobuf-documentation type documentation stream :indentation indentation))
- (format stream "~&(proto:define-proto ~(~A~)" (or class name))
- (if (or package lisp-package imports optimize options documentation)
- (format stream "~% (")
- (format stream " ("))
- (let ((spaces ""))
- (when package
- (format stream "~A:package ~A" spaces package)
- (when (or lisp-package imports optimize options documentation)
- (terpri stream))
- (setq spaces " "))
- (when lisp-package
- (format stream "~A:lisp-package ~A" spaces lisp-package)
- (when (or imports optimize options documentation)
- (terpri stream))
- (setq spaces " "))
- (when imports
- (cond ((= (length imports) 1)
- (format stream "~A:import \"~A\"" spaces (car imports)))
- (t
- (format stream "~A:import (~{\"~A\"~^ ~})" spaces imports)))
- (when (or optimize options documentation)
- (terpri stream))
- (setq spaces " "))
- (when optimize
- (format stream "~A:optimize ~(~S~)" spaces optimize)
- (when (or options documentation)
- (terpri stream))
- (setq spaces " "))
- (when options
- (format stream "~A:options (~{~@/protobuf-option/~^ ~})" spaces options)
- (when documentation
- (terpri stream))
- (setq spaces " "))
+ (let ((lisp-pkg (and lisp-package
+ (or (null package) (not (string-equal lisp-package package))))))
+ (when (or lisp-pkg package)
+ (format stream "~&(in-package \"~A\")~%~%" (or lisp-pkg package)))
(when documentation
- (format stream "~A:documentation ~S" spaces documentation)))
- (format stream ")")
+ (write-protobuf-documentation type documentation stream :indentation indentation))
+ (format stream "~&(proto:define-proto ~(~A~)" (or class name))
+ (if (or package lisp-pkg imports optimize options documentation)
+ (format stream "~% (")
+ (format stream " ("))
+ (let ((spaces ""))
+ (when package
+ (format stream "~A:package ~A" spaces package)
+ (when (or lisp-pkg imports optimize options documentation)
+ (terpri stream))
+ (setq spaces " "))
+ (when lisp-pkg
+ (format stream "~A:lisp-package ~A" spaces lisp-pkg)
+ (when (or imports optimize options documentation)
+ (terpri stream))
+ (setq spaces " "))
+ (when imports
+ (cond ((= (length imports) 1)
+ (format stream "~A:import \"~A\"" spaces (car imports)))
+ (t
+ (format stream "~A:import (~{\"~A\"~^ ~})" spaces imports)))
+ (when (or optimize options documentation)
+ (terpri stream))
+ (setq spaces " "))
+ (when optimize
+ (format stream "~A:optimize ~(~S~)" spaces optimize)
+ (when (or options documentation)
+ (terpri stream))
+ (setq spaces " "))
+ (when options
+ (format stream "~A:options (~{~@/protobuf-option/~^ ~})" spaces options)
+ (when documentation
+ (terpri stream))
+ (setq spaces " "))
+ (when documentation
+ (format stream "~A:documentation ~S" spaces documentation)))
+ (format stream ")"))
(dolist (enum (proto-enums protobuf))
(write-protobuf-as type enum stream :indentation 2))
(dolist (msg (proto-messages protobuf))
(+ indentation 4) documentation))
(t
(format stream " ()")))
- (loop for (rpc . more) on (proto-rpcs service) doing
- (write-protobuf-as type rpc stream :indentation (+ indentation 2))
+ (loop for (method . more) on (proto-methods service) doing
+ (write-protobuf-as type method stream :indentation (+ indentation 2))
(when more
(terpri stream)))
(format stream ")")))
-(defmethod write-protobuf-as ((type (eql :lisp)) (rpc protobuf-rpc) stream
+(defmethod write-protobuf-as ((type (eql :lisp)) (method protobuf-method) stream
&key (indentation 0))
(with-prefixed-accessors
- (function documentation input-type output-type options) (proto- rpc)
+ (function documentation input-type output-type options) (proto- method)
(when documentation
(write-protobuf-documentation type documentation stream :indentation indentation))
(format stream "~&~@[~VT~](~(~S~) (~(~S~) ~(~S~))"
"PROTOBUF-FIELD"
"PROTOBUF-EXTENSION"
"PROTOBUF-SERVICE"
- "PROTOBUF-RPC"
+ "PROTOBUF-METHOD"
;; .proto parsing and printing
"PARSE-PROTOBUF-FROM-FILE"
"PROTO-INPUT-TYPE"
"PROTO-LISP-PACKAGE"
"PROTO-MESSAGES"
+ "PROTO-METHODS"
"PROTO-NAME"
"PROTO-OPTIMIZE"
"PROTO-OPTIONS"
"PROTO-PARENT"
"PROTO-READER"
"PROTO-REQUIRED"
- "PROTO-RPCS"
"PROTO-SERVICES"
"PROTO-SYNTAX"
"PROTO-TYPE"
(defmethod protobuf-upgradable ((old protobuf-service) (new protobuf-service) &optional what)
(declare (ignore what))
;; No need to check that the names are equal, our caller did that already
- ;; Is every RPC in 'old' upgradable to an RPC in 'new'?
- (loop for old-rpc in (proto-rpcs old)
- as new-rpc = (find (proto-name old-rpc) (proto-rpcs new)
- :key #'proto-name :test #'string=)
- always (and new-rpc (protobuf-upgradable old-rpc new-rpc old))))
+ ;; Is every method in 'old' upgradable to a method in 'new'?
+ (loop for old-method in (proto-methods old)
+ as new-method = (find (proto-name old-method) (proto-methods new)
+ :key #'proto-name :test #'string=)
+ always (and new-method (protobuf-upgradable old-method new-method old))))
-(defmethod protobuf-upgradable ((old protobuf-rpc) (new protobuf-rpc) &optional service)
+(defmethod protobuf-upgradable ((old protobuf-method) (new protobuf-method) &optional service)
;; No need to check that the names are equal, our caller did that already
(and
;; Are their inputs and outputs the same?
projects / cl-protobufs.git / commitdiff