upgradable.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Confidential and proprietary information of ITA Software, Inc.   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 ITA Software, Inc.  All rights reserved.      ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-IMPL")
  12
  13
  14 ;;; Can a version of a protobuf be upgraded to a new version
  15
  16 (defgeneric protobuf-upgradable (new old)
  17   (:documentation
  18    "Returns true if and only if the old protobuf schema (enum, message, etc)
  19     can be upgraded to the new schema."))
  20
  21 (defmethod protobuf-upgradable ((old protobuf) (new protobuf))
  22   (and
  23    ;; Are they named the same?
  24    (string= (proto-name old) (proto-name new))
  25    (string= (proto-package old) (proto-package new))
  26    ;; Is every enum in 'old' upgradable to an enum in 'new'?
  27    (loop for old-enum in (proto-enums old)
  28          as new-enum = (find (proto-name old-enum) (proto-enums new)
  29                              :key #'proto-name :test #'string=)
  30          always (and new-enum (protobuf-upgradable old-enum new-enum)))
  31    ;; Is every message in 'old' upgradable to a message in 'new'?
  32    (loop for old-msg in (proto-messages old)
  33          as new-msg = (find (proto-name old-msg) (proto-messages new)
  34                             :key #'proto-name :test #'string=)
  35          always (and new-msg (protobuf-upgradable old-msg new-msg)))
  36    ;; Is every service in 'old' upgradable to a service in 'new'?
  37    (loop for old-svc in (proto-services old)
  38          as new-svc = (find (proto-name old-svc) (proto-services new)
  39                             :key #'proto-name :test #'string=)
  40          always (and new-svc (protobuf-upgradable old-svc new-svc)))))
  41
  42
  43 (defmethod protobuf-upgradable ((old protobuf-enum) (new protobuf-enum))
  44   (and
  45    ;; Are they named the same?
  46    (string= (proto-name old) (proto-name new))
  47    ;; Is every value in 'old' upgradable to a value in 'new'?
  48    (loop for old-val in (proto-values old)
  49          as new-val = (find (proto-name old-val) (proto-values new)
  50                             :key #'proto-name :test #'string=)
  51          always (and new-val (protobuf-upgradable old-val new-val)))))
  52
  53 (defmethod protobuf-upgradable ((old protobuf-enum-value) (new protobuf-enum-value))
  54   (and
  55    ;; Are they named the same?
  56    (string= (proto-name old) (proto-name new))
  57    ;; Do they have the same index?
  58    (= (proto-index old) (proto-index new))))
  59
  60
  61 (defmethod protobuf-upgradable ((old protobuf-message) (new protobuf-message))
  62   (and
  63    ;; Are they named the same?
  64    (string= (proto-name old) (proto-name new))
  65    ;; Is every enum in 'old' upgradable to an enum in 'new'?
  66    (loop for old-enum in (proto-enums old)
  67          as new-enum = (find (proto-name old-enum) (proto-enums new)
  68                              :key #'proto-name :test #'string=)
  69          always (and new-enum (protobuf-upgradable old-enum new-enum)))
  70    ;; Is every message in 'old' upgradable to a message in 'new'?
  71    (loop for old-msg in (proto-messages old)
  72          as new-msg = (find (proto-name old-msg) (proto-messages new)
  73                             :key #'proto-name :test #'string=)
  74          always (and new-msg (protobuf-upgradable old-msg new-msg)))
  75    ;; Is every required field in 'old' upgradable to a field in 'new'?
  76    ;; (Optional fields are safe to remove)
  77    (loop for old-fld in (proto-fields old)
  78          as new-fld = (find (proto-name old-fld) (proto-fields new)
  79                             :key #'proto-name :test #'string=)
  80          always (if new-fld
  81                   (protobuf-upgradable old-fld new-fld)
  82                   (not (eq (proto-required old) :required))))))
  83
  84 (defmethod protobuf-upgradable ((old protobuf-field) (new protobuf-field))
  85   (flet ((arity-upgradable (old new)
  86            ;;--- We need to handle conversions between non-required fields and extensions
  87            (or (eq old new)
  88                (not (eq new :required))))
  89          (type-upgradable (old new)
  90            ;;--- We need to handle conversions between embedded messages and bytes
  91            (or
  92             (string= old new)
  93             ;; These varint types are all compatible
  94             (and (member old '("int32" "uint32" "int64" "uint64" "bool") :test #'string=)
  95                  (member new '("int32" "uint32" "int64" "uint64" "bool") :test #'string=))
  96             ;; The two signed integer types are compatible
  97             (and (member old '("sint32" "sint64") :test #'string=)
  98                  (member new '("sint32" "sint64") :test #'string=))
  99             ;; Fixed integers are compatible with each other
 100             (and (member old '("fixed32" "sfixed32") :test #'string=)
 101                  (member new '("fixed32" "sfixed32") :test #'string=))
 102             (and (member old '("fixed64" "sfixed64") :test #'string=)
 103                  (member new '("fixed64" "sfixed64") :test #'string=))
 104             ;; Strings and bytes are compatible, assuming UTF-8 encoding
 105             (and (member old '("string" "bytes") :test #'string=)
 106                  (member new '("string" "bytes") :test #'string=))))
 107          (default-upgradable (old new)
 108            (declare (ignore old new))
 109            t))
 110     (and
 111      ;; Are they named the same?
 112      (string= (proto-name old) (proto-name new))
 113      ;; Do they have the same index?
 114      (= (proto-index old) (proto-index new))
 115      ;; Is the type and arity upgradable
 116      (arity-upgradable (proto-required old) (proto-required new))
 117      (type-upgradable (proto-type old) (proto-type new))
 118      (arity-upgradable (proto-required old) (proto-required new)))))
 119
 120
 121 (defmethod protobuf-upgradable ((old protobuf-service) (new protobuf-service))
 122   (and
 123    ;; Are they named the same?
 124    (string= (proto-name old) (proto-name new))
 125    ;; Is every RPC in 'old' upgradable to an RPC in 'new'?
 126    (loop for old-rpc in (proto-rpcs old)
 127          as new-rpc = (find (proto-name old-rpc) (proto-rpcs new)
 128                             :key #'proto-name :test #'string=)
 129          always (and new-rpc (protobuf-upgradable old-rpc new-rpc)))))
 130
 131 (defmethod protobuf-upgradable ((old protobuf-rpc) (new protobuf-rpc))
 132     (and
 133      ;; Are they named the same?
 134      (string= (proto-name old) (proto-name new))
 135      ;; Are their inputs and outputs the same
 136      (string= (proto-input-type old) (proto-input-type new))
 137      (string= (proto-output-type old) (proto-output-type new))))