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