├── .github └── workflows │ └── workflow.yml ├── .gitignore ├── .ocp-indent ├── Changelog.md ├── LICENSE.md ├── Makefile ├── README.md ├── bench ├── Makefile ├── bench.ml ├── bench.proto ├── dune ├── empty.proto ├── enum.proto ├── enum_list.proto ├── float.proto ├── float_list.proto ├── int64.proto ├── int64_list.proto ├── map.proto ├── perf.data ├── plugin │ └── dune ├── protoc │ └── dune ├── string.proto ├── string_list.proto ├── verify.proto └── verify_evaluation.ml ├── conf-protoc-dev.opam ├── conf-protoc.opam ├── dune ├── dune-project ├── dune-workspace ├── examples ├── echo │ ├── dune │ ├── echo.proto │ └── test.ml ├── echo_deriving │ ├── dune │ ├── echo.proto │ ├── google_types_deriving │ │ └── dune │ └── test.ml └── extensions │ ├── dune │ ├── extensions.proto │ └── test.ml ├── files ├── Makefile └── test.c ├── ocaml-protoc-plugin.opam ├── src ├── google_types │ └── dune ├── ocaml_protoc_plugin │ ├── deserialize.ml │ ├── deserialize.mli │ ├── deserialize_json.ml │ ├── deserialize_json.mli │ ├── dune │ ├── extensions.ml │ ├── extensions.mli │ ├── field.ml │ ├── infix.ml │ ├── json.ml │ ├── json_options.ml │ ├── merge.ml │ ├── ocaml_protoc_plugin.ml │ ├── reader.ml │ ├── reader.mli │ ├── result.ml │ ├── result.mli │ ├── serialize.ml │ ├── serialize.mli │ ├── serialize_json.ml │ ├── serialize_json.mli │ ├── service.ml │ ├── spec.ml │ ├── writer.ml │ └── writer.mli ├── plugin │ ├── code.ml │ ├── comment_db.ml │ ├── comment_db.mli │ ├── dune │ ├── emit.ml │ ├── emit.mli │ ├── names.ml │ ├── option.ml │ ├── parameters.ml │ ├── protoc_gen_ocaml.ml │ ├── scope.ml │ ├── scope.mli │ ├── type_db.ml │ ├── types.ml │ └── utils.ml └── spec │ ├── descriptor.ml │ ├── dune │ ├── options.ml │ ├── options.proto │ └── plugin.ml └── test ├── basic.proto ├── basic_test_module_name.ml ├── comments.proto ├── config ├── discover.ml └── dune ├── deprecated.proto ├── deprecated_test.ml ├── dune ├── empty.proto ├── empty_message.proto ├── empty_message_test.ml ├── enum.proto ├── enum_test.ml ├── extensions.proto ├── extensions_test.ml ├── google_types_pp └── dune ├── include.proto ├── include_test.ml ├── included.proto ├── included2.proto ├── included3-dash.proto ├── int_types.proto ├── int_types_native.proto ├── int_types_native_proto2.proto ├── int_types_native_test.ml ├── int_types_test.ml ├── json_encoding.proto ├── json_encoding_test.ml ├── large.proto ├── large_test.ml ├── mangle_names.proto ├── mangle_names_test.ml ├── map.proto ├── map_test.ml ├── merge.proto ├── merge_test.ml ├── message.proto ├── message_test.ml ├── name_clash.proto ├── name_clash2.proto ├── name_clash_mangle.proto ├── oneof.proto ├── oneof2.proto ├── oneof2_test.ml ├── oneof_test.ml ├── options.proto ├── package.proto ├── package_test.ml ├── packed.proto ├── packed_test.ml ├── primitive_types.proto ├── primitive_types_test.ml ├── proto2.proto ├── proto2_test.ml ├── proto3_optional.proto ├── proto3_optional_test_opt.ml ├── protobuf2json.cc ├── protocol.proto ├── protocol_test.ml ├── recursive.proto ├── recursive2.proto ├── recursive2_test.ml ├── recursive_test.ml ├── repeated.proto ├── repeated_test.ml ├── service.proto ├── service_empty_package.proto ├── service_empty_package_test.ml ├── service_rpc_clash.proto ├── service_test.ml ├── singleton_record.proto ├── singleton_record_test.ml ├── test_include_a └── message.proto ├── test_include_b └── message.proto ├── test_lib.ml ├── test_params ├── dune └── google_types_prefixed │ └── dune └── test_runtime.ml /.github/workflows/workflow.yml: -------------------------------------------------------------------------------- 1 | name: Main workflow 2 | 3 | on: 4 | - push 5 | - workflow_dispatch 6 | 7 | jobs: 8 | build: 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - ubuntu-latest 14 | ocaml-compiler: 15 | - 5 16 | - 4 17 | - 4.08.0 18 | 19 | runs-on: ${{ matrix.os }} 20 | 21 | steps: 22 | - name: Checkout code 23 | uses: actions/checkout@v4 24 | 25 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 26 | uses: ocaml/setup-ocaml@v3 27 | with: 28 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 29 | 30 | - run: opam pin . --no-action 31 | - run: opam depext conf-protoc --yes --with-doc --with-test 32 | - run: opam install . --deps-only --with-doc --with-test 33 | - run: opam exec -- dune build 34 | - run: opam exec -- dune runtest 35 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /_build/ 2 | /_opam/ 3 | /*.install 4 | _coverage 5 | _verify 6 | .merlin 7 | node_modules 8 | lib 9 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | JaneStreet 2 | with=0 3 | #match_clause=4 4 | # max_indent=2 5 | -------------------------------------------------------------------------------- /Changelog.md: -------------------------------------------------------------------------------- 1 | ## 6.2.0: Unreleased 2 | - Fix potential nameclash for messages defining extensions 3 | - Resolve compilation warning on deprecated fields enclosed in a oneof 4 | - Improve how comments are copied to generated code 5 | - Add flag 'singleton\_oneof\_as\_option' to map single field 6 | onofs to option type (default on). Set to 'false' to keep old 7 | behaviour. 8 | - Improve copying of comments from .proto files into ocaml code using 9 | omd to parse markdown 10 | 11 | 12 | ## 6.1.0: 2024-04-25 13 | - Fix name resolution leading to wrongly mapped names 14 | - Fix codegen bug causing the plugin to reject valid protobuf 15 | - Add preliminary support for melange though disabling eager 16 | evaluation of serialize and deserialize functions when not using 17 | native or bytecode backends 18 | - Fix missing cflags when compiling test c stub 19 | - Make Map tests compatible with older versions of protoc 20 | - Fix negative integer test failues due to a bug in older versions of protobuf (google) c lib 21 | 22 | ## 6.0.0: 2024-04-13 23 | 24 | ### New features 25 | - [x] Implement json serialization and deserialization (#5) 26 | - [x] Support special json mapping for google types (#9) 27 | - [x] Add deprecation annotations for deprecated fields, services etc (#8) 28 | - [x] Add option to prefix generated files with their package name 29 | - [x] Copy documentation from proto files into generated ocaml bindings 30 | 31 | ### Bug fixes 32 | - [x] Fix file output name if files contains a '-' 33 | - [x] Resolve bug for Request/Response module aliases leading to 34 | generating uncompilable code. (#21) 35 | - [x] Fix codegen bug for messages without fields and setting 36 | singleton_records = true (#20) 37 | - [x] In Services, the package field is now correctly set to None if 38 | the service if not defined in a package scope (#24) 39 | 40 | ### Misc changes 41 | - [x] Unify serialization and deserialization spec and optimize oneof 42 | handling 43 | - [x] Simplify types used in code generation to improve readaility 44 | - [x] *Replace `val name': unit -> string` with `val name: unit -> 45 | string` which will only return the full protobuf name 46 | - [x] Optimize merge functions by applying eager evaluation 47 | - [x] Change signature of `to_proto'` to return unit and not a writer 48 | 49 | (`*` indicates breaking change) 50 | 51 | ### Notes 52 | `Message.name': unit -> string` has been renamed to `Message.name: 53 | unit -> string`, and is now contains the fully qualified protobuf 54 | message name. Before the name was the ocaml module name of the 55 | message. 56 | 57 | `Service.Message` signature has been deprecated and replaced with 58 | `Spec.Message` signature. `Service.Message` is now an alias for 59 | `Spec.Message` and will be removed in future releases. 60 | 61 | ## 5.0.0: 2024-02-24 62 | - [x] Fix service signature to be backward compatible 63 | - [x] Create detatched fork for active development of 64 | ocaml-protoc-plugin. Thanks to @issuu for supporting initial 65 | development! 66 | - [x] Merge messages when receiving multiple messages for the same 67 | (single) field per protobuf spec. 68 | - [x] Add multiple buffer allocation strategies when serializing data 69 | - [x] Sort fields in output as recommended in protobuf spec and 70 | implement fast deserialization when all fields are sorted. 71 | - [x] Optimize serialization and deserialization resulting in ~5x 72 | speed improvments and is now on par with ocaml-protoc. 73 | - [x] Improve handling of extensions and remove unused extensions 74 | argument for messages that do not carry extensions (Breaking change) 75 | - [x] Add benchmarks based on bechamel for optimization and comparing 76 | performance against ocaml-protoc 77 | - [x] Fix upper case handling in name mangling and apply name mangling 78 | for serivce records (thanks @crackcomm) 79 | - [x] Fix bug in name resolution leading to uncompilable code 80 | 81 | ## 4.5.0: 2023-06-16 82 | - [x] Add more fields in generated service structs to make it easier 83 | to extract service endpoint names for gRPC (#50) 84 | - [x] Remove buckescript packaging support (#45) 85 | 86 | ## 4.4.0: 2023-03-13 87 | - [x] Emit modules for service endpoints with request/reply and gRPC 88 | endpoint name (thanks @Nymphium) 89 | - [x] Support importing from proto files with `-` in their name. 90 | 91 | ## 4.3.1: 2022-09-12 92 | - [x] Fix serialization/deserialization on big endian architectures 93 | - [x] Update tests for proto3 optional fields 94 | - [x] Remove dependency on dune-configurator 95 | 96 | 97 | ## 4.3.0: 2022-09-09 98 | - [x] Use pkg-config to locate google well known types (thanks @vprevosto) 99 | - [x] Support proto3 optional fields 100 | - [x] Map proto3 optional fields into option types 101 | 102 | ## 4.2.0: 2021-01-31 103 | - [x] Do not serialize field values when the same as the default 104 | attribute. 105 | - [x] Fix bug when uint32/64 where values are converted to negative 106 | integers if high bit is set. 107 | - [x] Fix bug which prevented specification of multiple opens (thanks @rauanmayemir) 108 | 109 | ## 4.1.0: 2020-10-31 110 | - [x] Fix bug with Proto2 default integer arguments for Int32 and 111 | Int64 types 112 | - [x] Add function to construct messages with default values 113 | - [x] Add missing includes for google well known types 114 | 115 | ## 4.0.0: 2020-05-10 116 | - [x] Move userdefined opens to beginning of autogenerated files, to 117 | allow using new google types 118 | - [*] Wrap google types (protofiles using googles well known types 119 | will need to add `open=Google_types` to the list of compilation options 120 | - [x] Disable warning 33 (unused opens) for user provided opens 121 | 122 | ## 3.0.0: 2020-01-06 123 | - [x] Add custom option to mangle names (modules, fields and enums) to 124 | more Ocaml idiomatic names (snake_cased) 125 | - [x] Change type of deserialize error type to be an lower bound polymorphic variant 126 | - [x] Rewrite type mapping to ensure that no name clashes can exist. 127 | - [x] Fix bug in nested cursive types referencing wrong types 128 | - [x] Add custom options, so options to ocaml\_protoc\_plugin can be 129 | embedded in .proto files 130 | - [x] Support extensions 131 | - [x] Allow use of message name Ocaml\_protoc\_plugin 132 | - [x] `*`Do not treat oneof fields as required, adding a `not_set variant 133 | to all oneofs. 134 | - [x] Avoid name clash with imported .proto files 135 | - [x] Avoid eager evaluation of members of recursivbe modules to fix 136 | bug triggered in bucklescript - @wokalski 137 | 138 | ## 2.0.0: 2019-10-20 139 | - [x] Add examples 140 | - [x] *Oneofs with only one element should not be a variant type 141 | - [x] Add test when including proto files which defines the same package 142 | - [x] Add google well know types (library `ocaml-protoc-plugin.google_types`). 143 | - [x] *Move module to ocaml-protoc-plugin 144 | - [x] Optimize deserialization of large nested structures 145 | - [x] Provide pretty_printers aka deriving_show for `Result.error` and `Field.t` 146 | - [x] Fix stack overflow when deserializing big nested structures 147 | - [x] *Add option to not wrap single field type in records 148 | - [x] Refactor type emitter to closely follow spec 149 | 150 | ## 1.0.0: 2019-10-12 151 | - [x] Support enum aliasing 152 | - [x] Avoid name clash with on 'name' 153 | - [x] Fix code generation when argument contains a path 154 | - [x] Refactor internal types to make serialization and 155 | deserialization type spec symmetrical. 156 | - [x] Optimize deserialization for messages with max_id < 1024 157 | - [x] Dont depend on Base in runtime 158 | - [x] Slim runtime dependencies: Remove need for base, ocplib-endian 159 | and ppx_let 160 | - [x] Honour [packed=...] flag. 161 | - [x] Make fixed scalar types default to int32 and int64 162 | - [x] Support proto2 specification 163 | - [x] Add options to switch between int64|int32 and int 164 | - [x] Fix name clash problem with special enum names 165 | - [x] Refactor serializaton and deserialization to simplify emitted code 166 | - [x] Eagerly evaluate serialization (for speed). 167 | 168 | ## 0.9: 2019-09-25 169 | - [x] Initial Release 170 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | GOOGLE_INCLUDE=$(shell pkg-config protobuf --variable=includedir)/google/protobuf 2 | 3 | OCAMLRUNPARAM=b 4 | export OCAMLRUNPARAM 5 | 6 | .PHONY: build 7 | build: ## Build 8 | @dune build @install 9 | 10 | .PHONY: clean 11 | clean: ## Clean 12 | @dune clean 13 | 14 | .PHONY: test 15 | test: ## Run tests 16 | @dune runtest 17 | 18 | .PHONY: bisect 19 | bisect: ## Run tests in bisect mode 20 | @rm -fr _coverage 21 | @find . -name '*.coverage' | xargs -r rm -f 22 | @dune runtest --instrument-with bisect_ppx --force 23 | bisect-ppx-report html 24 | open _coverage/index.html 25 | 26 | .PHONY: install 27 | install: build ## Install 28 | @dune install 29 | 30 | .PHONY: uninstall 31 | uninstall: build ## uninstall 32 | @dune uninstall 33 | 34 | %: %.proto 35 | protoc --experimental_allow_proto3_optional -I $(dir $<) $< -o/dev/stdout | protoc --experimental_allow_proto3_optional --decode google.protobuf.FileDescriptorSet $(GOOGLE_INCLUDE)/descriptor.proto 36 | 37 | PLUGIN = _build/default/src/plugin/protoc_gen_ocaml.exe 38 | $(PLUGIN): force 39 | dune build src/plugin/protoc_gen_ocaml.exe 40 | 41 | src/spec/descriptor.ml: $(PLUGIN) 42 | protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ 43 | -I /usr/include \ 44 | --ocaml_out=src/spec/. \ 45 | $(GOOGLE_INCLUDE)/descriptor.proto 46 | 47 | src/spec/plugin.ml: $(PLUGIN) 48 | protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ 49 | -I /usr/include \ 50 | --ocaml_out=src/spec/. \ 51 | $(GOOGLE_INCLUDE)/compiler/plugin.proto 52 | 53 | src/spec/options.ml: $(PLUGIN) 54 | protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ 55 | -I src/spec -I /usr/include \ 56 | --ocaml_out=src/spec/. \ 57 | src/spec/options.proto 58 | .PHONY: bootstrap 59 | bootstrap: src/spec/descriptor.ml src/spec/plugin.ml src/spec/options.ml ## Regenerate files used for generation 60 | 61 | %.ml: %.proto 62 | protoc -I $(shell pkg-config protobuf --variable=includedir) -I $(dir $<) --plugin=protoc-gen-ocaml=_build/default/src/plugin/protoc_gen_ocaml.exe \ 63 | --ocaml_out=$(dir $@). $< 64 | 65 | 66 | .PHONY: doc 67 | doc: ## Build documentation, including private libraries 68 | dune build @doc @doc-private 69 | 70 | gh-pages: 71 | dune clean 72 | dune build @doc -p ocaml-protoc-plugin 73 | git clone `git config --get remote.origin.url` .gh-pages --reference . 74 | git -C .gh-pages checkout --orphan gh-pages 75 | git -C .gh-pages reset 76 | git -C .gh-pages clean -dxf 77 | cp -r _build/default/_doc/_html/* .gh-pages 78 | git -C .gh-pages add . 79 | git -C .gh-pages config user.email 'docs@ocaml-protoc-plugin' 80 | git -C .gh-pages commit -m "Update documentation" 81 | git -C .gh-pages push origin gh-pages -f 82 | rm -rf .gh-pages 83 | 84 | .PHONY: bench 85 | bench: ## Run benchmark to compare with ocaml-protoc 86 | dune exec bench/bench.exe --profile=bench 87 | 88 | .PHONY: publish 89 | publish: ## Publish a new package. 90 | dune-release -p ocaml-protoc-plugin 91 | 92 | .PHONY: verify 93 | verify: # Verify partial evaluation though use of bisect 94 | @rm -fr _verify 95 | @mkdir _verify 96 | @cd _verify; dune exec --instrument-with bisect_ppx ../bench/verify_evaluation.exe 97 | @bisect-ppx-report html -o _verify --coverage-path=_verify/ 98 | open _verify/index.html 99 | 100 | 101 | .PHONY: force 102 | force: 103 | 104 | .PHONY: help 105 | help: ## Show this help 106 | @grep -h -E '^[.a-zA-Z_-]+:.*## .*$$' $(MAKEFILE_LIST) | awk 'BEGIN {FS = ":.*## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' 107 | -------------------------------------------------------------------------------- /bench/Makefile: -------------------------------------------------------------------------------- 1 | default: 2 | dune build bench.exe 3 | -------------------------------------------------------------------------------- /bench/bench.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | enum Enum { 4 | EA = 0; 5 | EB = 1; 6 | EC = 2; 7 | ED = 3; 8 | EE = 4; 9 | } 10 | 11 | message data { 12 | optional string s1 = 1; 13 | repeated int64 n1 = 2 [packed = true]; 14 | repeated int64 n2 = 3 [packed = true]; 15 | repeated double d1 = 4 [packed = true]; 16 | optional int64 n3 = 5; 17 | bool b1 = 6; 18 | //repeated Enum e = 7; 19 | } 20 | 21 | message M { 22 | repeated M children = 1; 23 | repeated data data = 2; 24 | } 25 | -------------------------------------------------------------------------------- /bench/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name bench) 3 | (modules :standard \ verify verify_evaluation) 4 | (libraries protoc plugin bechamel base stdio)) 5 | 6 | (rule 7 | (targets verify.ml) 8 | (deps 9 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 10 | (:proto verify.proto)) 11 | (action 12 | (run protoc "--plugin=protoc-gen-ocaml=%{plugin}" "--ocaml_out=." %{proto}))) 13 | 14 | (executable 15 | (name verify_evaluation) 16 | (modules verify verify_evaluation) 17 | (libraries ocaml_protoc_plugin) 18 | (instrumentation (backend bisect_ppx)) 19 | ) 20 | -------------------------------------------------------------------------------- /bench/empty.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | } 5 | -------------------------------------------------------------------------------- /bench/enum.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | enum Enum { 4 | EA = 0; 5 | EB = 1; 6 | EC = 2; 7 | ED = 3; 8 | EE = 4; 9 | } 10 | 11 | message M { 12 | Enum i = 1; 13 | } 14 | -------------------------------------------------------------------------------- /bench/enum_list.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | enum Enum { 4 | EA = 0; 5 | EB = 1; 6 | EC = 2; 7 | ED = 3; 8 | EE = 4; 9 | } 10 | 11 | message M { 12 | repeated Enum i = 1; 13 | } 14 | -------------------------------------------------------------------------------- /bench/float.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | double i = 1; 5 | } 6 | -------------------------------------------------------------------------------- /bench/float_list.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | repeated float i = 1; 5 | } 6 | -------------------------------------------------------------------------------- /bench/int64.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | int64 i = 1; 5 | } 6 | -------------------------------------------------------------------------------- /bench/int64_list.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | repeated int64 i = 1; 5 | } 6 | -------------------------------------------------------------------------------- /bench/map.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | map i = 1; 5 | } 6 | -------------------------------------------------------------------------------- /bench/perf.data: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andersfugmann/ocaml-protoc-plugin/27b7eda3c775dc5a140cec0f57bd7e1ba3410152/bench/perf.data -------------------------------------------------------------------------------- /bench/plugin/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets 3 | bench.ml empty.ml 4 | int64.ml string.ml float.ml enum.ml 5 | int64_list.ml string_list.ml float_list.ml enum_list.ml 6 | map.ml) 7 | (deps 8 | (:proto 9 | ../bench.proto ../empty.proto 10 | ../int64.proto ../string.proto ../float.proto ../enum.proto 11 | ../int64_list.proto ../string_list.proto ../float_list.proto ../enum_list.proto 12 | ../map.proto) 13 | (:plugin ../../src/plugin/protoc_gen_ocaml.exe) 14 | ) 15 | (action 16 | (bash "for p in %{proto}; do protoc -I .. --plugin=protoc-gen-ocaml=%{plugin} \"--ocaml_out=annot=[@@deriving show { with_path = false },eq]:.\" $p; done"))) 17 | 18 | (library 19 | (name plugin) 20 | (libraries ocaml_protoc_plugin) 21 | (preprocess 22 | (pps ppx_deriving.show ppx_deriving.eq ppx_deriving.ord)) 23 | ) 24 | -------------------------------------------------------------------------------- /bench/protoc/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets 3 | bench.ml bench.mli empty.ml empty.mli 4 | int64.ml string.ml float.ml enum.ml 5 | int64.mli string.mli float.mli enum.mli 6 | int64_list.ml string_list.ml float_list.ml enum_list.ml 7 | int64_list.mli string_list.mli float_list.mli enum_list.mli 8 | map.ml map.mli 9 | ) 10 | (deps 11 | (:proto 12 | ../bench.proto ../empty.proto 13 | ../int64.proto ../string.proto ../float.proto ../enum.proto 14 | ../int64_list.proto ../string_list.proto ../float_list.proto ../enum_list.proto 15 | ../map.proto)) 16 | (action 17 | (bash "for p in %{proto}; do ocaml-protoc -I .. --binary --int32_type int_t --int64_type int_t --ml_out . $p; done"))) 18 | 19 | (library 20 | (name protoc) 21 | (ocamlopt_flags :standard \ -unboxed-types) 22 | (libraries pbrt)) 23 | -------------------------------------------------------------------------------- /bench/string.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | string i = 1; 5 | } 6 | -------------------------------------------------------------------------------- /bench/string_list.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message M { 4 | repeated string i = 1; 5 | } 6 | -------------------------------------------------------------------------------- /bench/verify.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | // Verify partial evaluation 4 | package Verify; 5 | 6 | enum E { 7 | A = 0; 8 | B = 1; 9 | C = 2; 10 | } 11 | 12 | 13 | message M { 14 | 15 | string a = 10; 16 | int64 b = 20; 17 | repeated int64 rp = 30; 18 | repeated int64 r = 40 [packed = false]; 19 | 20 | map m = 50; 21 | N message = 60; 22 | E enum = 70; 23 | 24 | oneof oneof { 25 | int64 i = 100; 26 | string j = 200; 27 | } 28 | 29 | } 30 | 31 | message N { 32 | int64 i = 1; 33 | } 34 | 35 | message Empty { 36 | } 37 | -------------------------------------------------------------------------------- /bench/verify_evaluation.ml: -------------------------------------------------------------------------------- 1 | open Verify.Verify 2 | 3 | (* We want to construct a large structure and then call serialization and deserialization 1000 times to understand how many times the serialization function are being evaluation *) 4 | 5 | let m = 6 | M.make ~a:"Test" ~b:5 ~rp:[1;2;3] ~r:[1;2;3] 7 | ~m:[true, "true"; false, "false"] ~message:(N.make ~i:7 ()) 8 | ~enum:Verify.Verify.E.B 9 | ~oneof:(`J "hello") () 10 | 11 | let test_full () = 12 | let to_json = M.to_json Ocaml_protoc_plugin.Json_options.default in 13 | for _ = 1 to 2579-1 do 14 | M.to_proto m |> Sys.opaque_identity |> ignore; 15 | to_json m |> Sys.opaque_identity |> ignore; 16 | () 17 | done; 18 | let reader = 19 | M.to_proto m 20 | |> Ocaml_protoc_plugin.Writer.contents 21 | |> Ocaml_protoc_plugin.Reader.create 22 | in 23 | let json = to_json m in 24 | for _ = 1 to 4177 do 25 | M.from_proto_exn reader |> Sys.opaque_identity |> ignore; 26 | M.from_json_exn json |> Sys.opaque_identity |> ignore; 27 | () 28 | done; 29 | () 30 | 31 | let test_empty () = 32 | let writer = Ocaml_protoc_plugin.Writer.init () in 33 | for _ = 1 to 4177 do 34 | Empty.to_proto' writer () |> Sys.opaque_identity |> ignore 35 | done; 36 | () 37 | 38 | let _ = test_empty, test_full 39 | 40 | let () = test_full () 41 | -------------------------------------------------------------------------------- /conf-protoc-dev.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Anders Fugmann" 3 | authors: "Google" 4 | license: "BSD-3-Clause" 5 | homepage: "https://developers.google.com/protocol-buffers/" 6 | bug-reports: "https://github.com/protocolbuffers/protobuf/issues" 7 | dev-repo: "git+https://github.com/protocolbuffers/protobuf.git" 8 | 9 | depends: [ 10 | "conf-pkg-config" 11 | ] 12 | 13 | depexts: [ 14 | ["libprotoc-dev"] {os-family = "debian"} 15 | ["libprotoc-dev"] {os-family = "ubuntu"} 16 | ["lib64protobuf-devel"] {os-distribution = "mageia"} 17 | ["protobuf-devel"] {os-distribution = "centos"} 18 | ["protobuf-devel"] {os-distribution = "fedora"} 19 | ["protobuf-devel"] {os-distribution = "rhel"} 20 | ["protobuf-dev"] {os-family = "alpine"} 21 | ["protobuf"] {os-family = "arch"} 22 | ["protobuf-devel"] {os-family = "suse"} 23 | ["protobuf"] {os = "freebsd"} 24 | ["protobuf"] {os = "macos" & os-distribution = "homebrew"} 25 | ] 26 | 27 | x-ci-accept-failures: [ 28 | "oraclelinux-7" # Package not available by default 29 | "oraclelinux-8" # Package not available by default 30 | "oraclelinux-9" # Package not available by default 31 | ] 32 | 33 | available: (os-distribution != "ubuntu" | os-version >= "18.04") & (os-distribution != "centos" | os-version >= "8") 34 | synopsis: "Virtual package to install protobuf cpp headers" 35 | description: 36 | "This package will install c header files and libaries for google protocol buffers via `opam depext`" 37 | flags: conf 38 | -------------------------------------------------------------------------------- /conf-protoc.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Anders Fugmann" 3 | authors: "Google" 4 | license: "BSD-3-Clause" 5 | homepage: "https://developers.google.com/protocol-buffers/" 6 | bug-reports: "https://github.com/protocolbuffers/protobuf/issues" 7 | dev-repo: "git+https://github.com/protocolbuffers/protobuf.git" 8 | build: [ "protoc" "--version" ] 9 | 10 | depexts: [ 11 | ["libprotobuf-dev" "protobuf-compiler"] {os-family = "debian"} 12 | ["libprotobuf-dev" "protobuf-compiler"] {os-family = "ubuntu"} 13 | ["libprotobuf-devel" "protobuf-compiler"] {os-distribution = "mageia"} 14 | ["protobuf-devel" "protobuf-compiler"] {os-distribution = "centos"} 15 | ["protobuf-devel" "protobuf-compiler"] {os-distribution = "fedora"} 16 | ["protobuf-devel" "protobuf-compiler"] {os-distribution = "rhel"} 17 | ["protobuf" "protobuf-dev"] {os-family = "alpine"} 18 | ["protobuf"] {os-family = "arch"} 19 | ["protobuf-devel"] {os-family = "suse"} 20 | ["protobuf"] {os = "freebsd"} 21 | ["protobuf"] {os = "macos" & os-distribution = "homebrew"} 22 | ] 23 | 24 | x-ci-accept-failures: [ 25 | "oraclelinux-7" # Package not available by default 26 | "oraclelinux-8" # Package not available by default 27 | "oraclelinux-9" # Package not available by default 28 | ] 29 | 30 | available: (os-distribution != "ubuntu" | os-version >= "18.04") & (os-distribution != "centos" | os-version >= "8") 31 | synopsis: "Virtual package to install protoc compiler" 32 | description: 33 | "This package will install the protoc compiler if invoked via `opam depext`" 34 | flags: conf 35 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (alias 2 | (name default) 3 | (deps (alias_rec install)) 4 | ) 5 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.12) 2 | (name ocaml-protoc-plugin) 3 | -------------------------------------------------------------------------------- /dune-workspace: -------------------------------------------------------------------------------- 1 | (lang dune 3.2) 2 | (env (bench (ocamlopt_flags :standard -O3 -unbox-closures -unboxed-types -remove-unused-arguments -rounds 4 -inline 100.00 -inline-max-depth 5 -inline-max-unroll 5 -unsafe ))) 3 | ;(env (bench (ocamlopt_flags :standard -O3 -rounds 10 -unbox-closures -inline 100.00 -inline-max-depth 5 -remove-unused-arguments))) 4 | -------------------------------------------------------------------------------- /examples/echo/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (libraries ocaml-protoc-plugin ocaml-protoc-plugin.google_types unix) 4 | ) 5 | 6 | (rule 7 | (targets google_include) 8 | (action (with-stdout-to %{targets} 9 | (system "pkg-config protobuf --variable=includedir")))) 10 | 11 | (rule 12 | (targets echo.ml) 13 | (deps 14 | (:proto echo.proto) (package ocaml-protoc-plugin)) 15 | (action 16 | (run protoc -I %{read-lines:google_include} -I . "--ocaml_out=open=Google_types:." %{proto}))) 17 | (rule 18 | (deps test.exe) 19 | (action (ignore-stdout (run %{deps}))) 20 | (alias runtest) 21 | ) 22 | -------------------------------------------------------------------------------- /examples/echo/echo.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | import "google/protobuf/timestamp.proto"; 3 | 4 | package echo; 5 | message Request { 6 | enum who { 7 | Mum = 0; 8 | World = 1; 9 | } 10 | oneof ts { 11 | google.protobuf.Timestamp timestamp = 1; 12 | }; 13 | oneof what { 14 | who type = 10; 15 | string someone = 11; 16 | } 17 | } 18 | 19 | message Reply { 20 | string response = 1; 21 | } 22 | 23 | service Echo { 24 | rpc Call (Request) returns (Reply); 25 | } 26 | -------------------------------------------------------------------------------- /examples/echo/test.ml: -------------------------------------------------------------------------------- 1 | open Echo 2 | open Google_types 3 | 4 | let mk_timestamp () = 5 | let now = Unix.gettimeofday () in 6 | let seconds = int_of_float now in 7 | let nanos = ((now -. float seconds) *. 10. ** 12.) |> int_of_float in 8 | Timestamp.Google.Protobuf.Timestamp.{ seconds; nanos } 9 | 10 | 11 | let mk_request () = 12 | Echo.Request.{ timestamp = Some (mk_timestamp ()); what = `Type Echo.Request.Who.World } 13 | 14 | let mk_reply Echo.Request.{ timestamp; what } = 15 | let at = 16 | match timestamp with 17 | | Some {seconds; nanos = _} -> 18 | let minutes = seconds / 60 in 19 | let hours = minutes / 60 in 20 | Printf.sprintf "%d:%d:%d" (hours mod 24) (minutes mod 60) (seconds mod 60) 21 | | None -> 22 | "whenever" 23 | in 24 | 25 | match what with 26 | | `Someone person -> Printf.sprintf "%s Hello there, %s" at person 27 | | `Type Echo.Request.Who.Mum -> Printf.sprintf "%s Hi Mom" at 28 | | `Type Echo.Request.Who.World -> Printf.sprintf "%s Hello World" at 29 | | `not_set -> Printf.sprintf "Hello Unknown" 30 | 31 | let handle_request proto_request = 32 | let (decode, encode) = Ocaml_protoc_plugin.Service.make_service_functions Echo.Echo.call in 33 | let request = 34 | Ocaml_protoc_plugin.Reader.create proto_request 35 | |> decode 36 | |> function | Ok v -> v | Error e -> failwith (Printf.sprintf "Could not decode request: %s" (Ocaml_protoc_plugin.Result.show_error e)) 37 | in 38 | let reply = mk_reply request in 39 | encode reply 40 | |> Ocaml_protoc_plugin.Writer.contents 41 | 42 | let do_request ~handler request = 43 | let (encode, decode) = Ocaml_protoc_plugin.Service.make_client_functions Echo.Echo.call in 44 | let proto_request = encode request |> Ocaml_protoc_plugin.Writer.contents in 45 | let proto_reply = handler proto_request in 46 | Ocaml_protoc_plugin.Reader.create proto_reply 47 | |> decode 48 | |> function | Ok v -> v | Error e -> failwith (Printf.sprintf "Could not reply request: %s" (Ocaml_protoc_plugin.Result.show_error e)) 49 | 50 | let () = 51 | let request = mk_request () in 52 | let reply = do_request ~handler:handle_request request in 53 | Printf.printf "Reply: %s\n" reply 54 | -------------------------------------------------------------------------------- /examples/echo_deriving/dune: -------------------------------------------------------------------------------- 1 | ; This example shows how to use google wellknown type with derivers. 2 | (executable 3 | (name test) 4 | (libraries ocaml-protoc-plugin unix google_types_deriving) 5 | (preprocess 6 | (pps ppx_expect ppx_deriving.show ppx_deriving.eq ppx_deriving.ord)) 7 | ) 8 | 9 | (rule 10 | (targets google_include) 11 | (action (with-stdout-to %{targets} 12 | (system "pkg-config protobuf --variable=includedir")))) 13 | 14 | 15 | (rule 16 | (targets echo.ml) 17 | (deps 18 | (:proto echo.proto) (package ocaml-protoc-plugin)) 19 | (action 20 | (run protoc -I %{read-lines:google_include} -I . 21 | "--ocaml_out=open=Google_types_deriving;annot=[@@deriving show { with_path = false }, eq, ord]:." 22 | %{proto})) 23 | ) 24 | 25 | (rule 26 | (deps test.exe) 27 | (action (ignore-stdout (run %{deps}))) 28 | (alias runtest) 29 | ) 30 | -------------------------------------------------------------------------------- /examples/echo_deriving/echo.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | import "google/protobuf/timestamp.proto"; 3 | 4 | package echo; 5 | message Request { 6 | enum who { 7 | Mum = 0; 8 | World = 1; 9 | } 10 | google.protobuf.Timestamp timestamp = 1; 11 | 12 | oneof what { 13 | who type = 10; 14 | string someone = 11; 15 | } 16 | } 17 | 18 | message Reply { 19 | string response = 1; 20 | } 21 | 22 | service Echo { 23 | rpc Call (Request) returns (Reply); 24 | } 25 | -------------------------------------------------------------------------------- /examples/echo_deriving/google_types_deriving/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name google_types_deriving) 3 | (libraries ocaml-protoc-plugin) 4 | (synopsis "Google well known types - with deriving") 5 | (preprocess 6 | (pps ppx_expect ppx_deriving.show ppx_deriving.eq ppx_deriving.ord)) 7 | ) 8 | 9 | (rule 10 | (targets google_include) 11 | (action (with-stdout-to %{targets} 12 | (system "pkg-config protobuf --variable=includedir")))) 13 | 14 | (rule 15 | (deps (package ocaml-protoc-plugin)) 16 | (targets any.ml api.ml descriptor.ml duration.ml empty.ml field_mask.ml 17 | source_context.ml struct.ml timestamp.ml type.ml wrappers.ml) 18 | (action 19 | (run protoc -I %{read-lines:google_include} 20 | "--ocaml_out=annot=[@@deriving show { with_path = false }, eq, ord]:." 21 | %{read-lines:google_include}/google/protobuf/any.proto 22 | %{read-lines:google_include}/google/protobuf/api.proto 23 | %{read-lines:google_include}/google/protobuf/descriptor.proto 24 | %{read-lines:google_include}/google/protobuf/duration.proto 25 | %{read-lines:google_include}/google/protobuf/empty.proto 26 | %{read-lines:google_include}/google/protobuf/field_mask.proto 27 | %{read-lines:google_include}/google/protobuf/source_context.proto 28 | %{read-lines:google_include}/google/protobuf/struct.proto 29 | %{read-lines:google_include}/google/protobuf/timestamp.proto 30 | %{read-lines:google_include}/google/protobuf/type.proto 31 | %{read-lines:google_include}/google/protobuf/wrappers.proto 32 | ))) 33 | -------------------------------------------------------------------------------- /examples/echo_deriving/test.ml: -------------------------------------------------------------------------------- 1 | open Echo 2 | open Google_types_deriving 3 | 4 | let mk_timestamp () = 5 | let now = Unix.gettimeofday () in 6 | let seconds = int_of_float now in 7 | let nanos = ((now -. float seconds) *. 10. ** 12.) |> int_of_float in 8 | Timestamp.Google.Protobuf.Timestamp.{ seconds; nanos } 9 | 10 | 11 | let mk_request () = 12 | Echo.Request.{ timestamp = Some (mk_timestamp ()); what = `Type Echo.Request.Who.World } 13 | 14 | 15 | let mk_reply Echo.Request.{ timestamp; what } = 16 | 17 | let at = 18 | match timestamp with 19 | | Some {seconds; nanos = _} -> 20 | let minutes = seconds / 60 in 21 | let hours = minutes / 60 in 22 | Printf.sprintf "%d:%d:%d" (hours mod 24) (minutes mod 60) (seconds mod 60) 23 | | None -> 24 | "whenever" 25 | in 26 | 27 | match what with 28 | | `Someone person -> Printf.sprintf "%s Hello there, %s" at person 29 | | `Type Echo.Request.Who.Mum -> Printf.sprintf "%s Hi Mom" at 30 | | `Type Echo.Request.Who.World -> Printf.sprintf "%s Hello World" at 31 | | `not_set -> Printf.sprintf "Hello Unknown" 32 | 33 | let handle_request proto_request = 34 | let (decode, encode) = Ocaml_protoc_plugin.Service.make_service_functions Echo.Echo.call in 35 | let request = 36 | Ocaml_protoc_plugin.Reader.create proto_request 37 | |> decode 38 | |> function | Ok v -> v | Error e -> failwith (Printf.sprintf "Could not decode request: %s" (Ocaml_protoc_plugin.Result.show_error e)) 39 | in 40 | Printf.printf "Got request: %s\n" ([%show: Echo.Request.t] request); 41 | let reply = mk_reply request in 42 | encode reply 43 | |> Ocaml_protoc_plugin.Writer.contents 44 | 45 | let do_request ~handler request = 46 | let (encode, decode) = Ocaml_protoc_plugin.Service.make_client_functions Echo.Echo.call in 47 | let proto_request = encode request |> Ocaml_protoc_plugin.Writer.contents in 48 | let proto_reply = handler proto_request in 49 | Ocaml_protoc_plugin.Reader.create proto_reply 50 | |> decode 51 | |> function | Ok v -> v | Error e -> failwith (Printf.sprintf "Could not reply request: %s" (Ocaml_protoc_plugin.Result.show_error e)) 52 | 53 | let () = 54 | let request = mk_request () in 55 | let reply = do_request ~handler:handle_request request in 56 | Printf.printf "Reply: %s\n" ([%show: Echo.Reply.t] reply) 57 | -------------------------------------------------------------------------------- /examples/extensions/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (libraries ocaml-protoc-plugin ocaml-protoc-plugin.google_types unix) 4 | ) 5 | 6 | (rule 7 | (targets google_include) 8 | (action (with-stdout-to %{targets} 9 | (system "pkg-config protobuf --variable=includedir")))) 10 | 11 | (rule 12 | (targets extensions.ml) 13 | (deps 14 | (:proto extensions.proto) (package ocaml-protoc-plugin)) 15 | (action 16 | (run protoc -I %{read-lines:google_include} -I . "--ocaml_out=:." %{proto}))) 17 | 18 | (alias 19 | (name runtest) 20 | (deps test.exe) 21 | ) 22 | -------------------------------------------------------------------------------- /examples/extensions/extensions.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto2"; 2 | message Foo { 3 | required uint32 i = 1; 4 | extensions 100 to 200; 5 | 6 | } 7 | extend Foo { 8 | optional uint32 bar = 128; 9 | optional string baz = 129; 10 | } 11 | -------------------------------------------------------------------------------- /examples/extensions/test.ml: -------------------------------------------------------------------------------- 1 | open Extensions 2 | 3 | (* Set extensions *) 4 | let _ = 5 | let foo = Foo.{ i = 31; extensions' = Ocaml_protoc_plugin.Extensions.default } in 6 | let foo_with_bar = Bar.set foo (Some 42) in 7 | let foo_with_baz = Baz.set foo (Some "Test String") in 8 | let foo_with_bar_baz = Baz.set foo_with_bar (Some "Test String") in 9 | 10 | (* Get extensions *) 11 | let open Ocaml_protoc_plugin.Result in 12 | Bar.get foo_with_bar >>= fun bar -> 13 | Baz.get foo_with_baz >>= fun baz -> 14 | assert (bar = Some 42); 15 | assert (baz = Some "Test String"); 16 | Bar.get foo_with_bar_baz >>= fun bar' -> 17 | Baz.get foo_with_bar_baz >>= fun baz' -> 18 | assert (bar' = Some 42); 19 | assert (baz' = Some "Test String"); 20 | return () 21 | -------------------------------------------------------------------------------- /files/Makefile: -------------------------------------------------------------------------------- 1 | build: 2 | c++ `pkg-config protobuf --cflags` -c -o test.o test.c 3 | -------------------------------------------------------------------------------- /files/test.c: -------------------------------------------------------------------------------- 1 | #include 2 | -------------------------------------------------------------------------------- /ocaml-protoc-plugin.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Anders Fugmann" 3 | authors: "Anders Fugmann " 4 | license: "APACHE-2.0" 5 | homepage: "https://github.com/andersfugmann/ocaml-protoc-plugin" 6 | dev-repo: "git+https://github.com/andersfugmann/ocaml-protoc-plugin" 7 | bug-reports: "https://github.com/andersfugmann/ocaml-protoc-plugin/issues" 8 | doc: "https://andersfugmann.github.io/ocaml-protoc-plugin/" 9 | build: [ 10 | ["dune" "subst"] {dev} 11 | ["dune" "build" "-p" name "-j" jobs] 12 | ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "arm32" & arch != "x86_32"} 13 | ] 14 | 15 | depends: [ 16 | "conf-protoc" {>= "1.0.0"} 17 | "conf-protoc-dev" {with-test} 18 | "conf-c++" {with-test} 19 | "dune" {>= "3.12"} 20 | "ocaml" {>= "4.08.0"} 21 | "ppx_expect" 22 | "ppx_inline_test" 23 | "ppx_deriving" {with-test} 24 | "bisect_ppx" {with-test} 25 | "odoc" {with-doc} 26 | "omd" 27 | "conf-pkg-config" {build} 28 | "dune-configurator" {with-test} 29 | "yojson" {with-test} 30 | "base64" {>= "3.1.0"} 31 | "ptime" 32 | ] 33 | 34 | x-ci-accept-failures: [ 35 | "opensuse-15.5" # Error during linking (exit code 1) 36 | "macos-homebrew" # C++ versions less than C++14 are not supported. 37 | ] 38 | 39 | synopsis: "Plugin for protoc protobuf compiler to generate ocaml definitions from a .proto file" 40 | 41 | description: """ The plugin generates ocaml type definitions, 42 | serialization and deserialization functions from a protobuf file. 43 | The types generated aims to create ocaml idiomatic types; 44 | - messages are mapped into modules 45 | - oneof constructs are mapped to polymorphic variants 46 | - enums are mapped to adt's 47 | - map types are mapped to assoc lists 48 | - all integer types are mapped to int by default (exact mapping is also possible) 49 | - all floating point types are mapped to float. 50 | - packages are mapped to nested modules 51 | 52 | The package aims to be a 100% compliant protobuf implementation. 53 | It also includes serializing to and from json based on 54 | protobuf json specification 55 | """ 56 | -------------------------------------------------------------------------------- /src/google_types/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name google_types) 3 | (public_name ocaml-protoc-plugin.google_types) 4 | (libraries ocaml_protoc_plugin) 5 | (synopsis "Google well known types") 6 | ) 7 | 8 | (rule 9 | (targets google_include) 10 | (action (with-stdout-to %{targets} 11 | (run pkg-config protobuf --variable=includedir)))) 12 | 13 | (rule 14 | (targets any.ml api.ml descriptor.ml duration.ml empty.ml field_mask.ml 15 | source_context.ml struct.ml timestamp.ml type.ml wrappers.ml) 16 | (deps 17 | (:plugin ../plugin/protoc_gen_ocaml.exe)) 18 | (action 19 | (run protoc -I %{read-lines:google_include} 20 | "--plugin=protoc-gen-ocaml=%{plugin}" 21 | "--ocaml_out=." 22 | %{read-lines:google_include}/google/protobuf/any.proto 23 | %{read-lines:google_include}/google/protobuf/api.proto 24 | %{read-lines:google_include}/google/protobuf/descriptor.proto 25 | %{read-lines:google_include}/google/protobuf/duration.proto 26 | %{read-lines:google_include}/google/protobuf/empty.proto 27 | %{read-lines:google_include}/google/protobuf/field_mask.proto 28 | %{read-lines:google_include}/google/protobuf/source_context.proto 29 | %{read-lines:google_include}/google/protobuf/struct.proto 30 | %{read-lines:google_include}/google/protobuf/timestamp.proto 31 | %{read-lines:google_include}/google/protobuf/type.proto 32 | %{read-lines:google_include}/google/protobuf/wrappers.proto 33 | ))) 34 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/deserialize.mli: -------------------------------------------------------------------------------- 1 | val deserialize: 2 | ('constr, 'a) Spec.compound_list -> 3 | 'constr -> Reader.t -> 'a 4 | 5 | (** **) 6 | val deserialize_full: 7 | ('constr, 'a) Spec.compound_list -> 8 | 'constr -> Reader.t -> 'a 9 | 10 | val deserialize_fast: 11 | ('constr, 'a) Spec.compound_list -> 12 | 'constr -> Reader.t -> 'a 13 | (** **) 14 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/deserialize_json.mli: -------------------------------------------------------------------------------- 1 | val deserialize: message_name:string -> ('constr, 'a) Spec.compound_list -> 'constr -> Json.t -> 'a 2 | 3 | (**) 4 | val to_int64: Json.t -> int64 5 | val to_int32: Json.t -> int32 6 | val to_int: Json.t -> int 7 | val to_string: Json.t -> string 8 | val to_bytes: Json.t -> bytes 9 | val to_float: Json.t -> float 10 | val to_bool: Json.t -> bool 11 | val to_list: Json.t -> Json.t list 12 | (**) 13 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ocaml_protoc_plugin) 3 | (public_name ocaml-protoc-plugin) 4 | (synopsis "Serialization and deserialization of protobuf types") 5 | (inline_tests) 6 | (libraries base64 ptime) 7 | (preprocess (pps ppx_expect)) 8 | (instrumentation (backend bisect_ppx)) 9 | ) 10 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/extensions.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | type t = (int * Field.t) list 3 | let default = [] 4 | let pp_item fmt (index, field) = Format.fprintf fmt "(%d, %a)" index Field.pp field 5 | let pp : Format.formatter -> t -> unit = fun fmt -> Format.pp_print_list pp_item fmt 6 | let show : t -> string = Format.asprintf "%a" pp 7 | let equal _ _ = true 8 | let compare _ _ = 0 9 | 10 | 11 | let index_of_spec: type a b. (a, b) Spec.compound -> int = function 12 | | Basic ((index, _, _), _, _) -> index 13 | | Basic_opt ((index, _, _), _) -> index 14 | | Basic_req ((index, _, _), _) -> index 15 | | Repeated ((index, _, _), _, _) -> index 16 | | Map ((index, _, _), _) -> index 17 | | Oneof _ -> failwith "Oneof fields not allowed in extensions" 18 | 19 | let get: type a b. (a, b) Spec.compound -> t -> a = fun spec t -> 20 | let writer = Writer.of_list t in 21 | let reader = Writer.contents writer |> Reader.create in 22 | Deserialize.deserialize Spec.(Cons (spec, Nil)) (fun a -> a) reader 23 | 24 | let set: type a b. (a, b) Spec.compound -> t -> a -> t = fun spec t v -> 25 | let writer = Writer.init () in 26 | Serialize.serialize Spec.(Cons (spec, Nil)) writer v; 27 | let index = index_of_spec spec in 28 | let fields = 29 | Writer.contents writer 30 | |> Reader.create 31 | |> Reader.to_list 32 | in 33 | List.filter ~f:(fun (i, _) -> i != index) t @ fields 34 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/extensions.mli: -------------------------------------------------------------------------------- 1 | type t = (int * Field.t) list 2 | val default : t 3 | val pp : Format.formatter -> t -> unit 4 | val show : t -> string 5 | val equal : t -> t -> bool 6 | val compare : t -> t -> int 7 | 8 | val get: ('a, _) Spec.compound -> t -> 'a 9 | val set: ('a, _) Spec.compound -> t -> 'a -> t 10 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/field.ml: -------------------------------------------------------------------------------- 1 | type length_delimited = { 2 | offset : int; 3 | length : int; 4 | data : string; 5 | } 6 | 7 | type field_type = Varint | Fixed64 | Fixed32 | Length_delimited 8 | 9 | type t = 10 | | Varint of Int64.t (* int32, int64, uint32, uint64, sint32, sint64, bool, enum *) 11 | | Varint_unboxed of int 12 | | Fixed_64_bit of Int64.t (* fixed64, sfixed64, double *) 13 | | Length_delimited of length_delimited (* string, bytes, embedded messages, packed repeated fields *) 14 | | Fixed_32_bit of Int32.t (* fixed32, sfixed32, float *) 15 | 16 | let varint v = Varint v 17 | let varint_unboxed v = Varint_unboxed v 18 | let fixed_32_bit v = Fixed_32_bit v 19 | let fixed_64_bit v = Fixed_64_bit v 20 | let length_delimited ?(offset=0) ?length data = 21 | let length = Option.value ~default:(String.length data - offset) length in 22 | Length_delimited {offset; length; data} 23 | 24 | let string_of_field_type: field_type -> string = function 25 | | Varint -> "Varint" 26 | | Fixed64 -> "Fixed64" 27 | | Length_delimited -> "Length_delimited" 28 | | Fixed32 -> "Fixed32" 29 | 30 | let pp: Format.formatter -> t -> unit = fun fmt -> 31 | function 32 | | Varint_unboxed a0 -> 33 | (Format.fprintf fmt "(@[<2>Field.Varint_unboxed@ "; 34 | (Format.fprintf fmt "%d") a0; 35 | Format.fprintf fmt "@])") 36 | | Varint a0 -> 37 | (Format.fprintf fmt "(@[<2>Field.Varint@ "; 38 | (Format.fprintf fmt "%LdL") a0; 39 | Format.fprintf fmt "@])") 40 | | Fixed_64_bit a0 -> 41 | (Format.fprintf fmt 42 | "(@[<2>Field.Fixed_64_bit@ "; 43 | (Format.fprintf fmt "%LdL") a0; 44 | Format.fprintf fmt "@])") 45 | | Length_delimited 46 | { offset = aoffset; length = alength; data = adata } -> 47 | (Format.fprintf fmt 48 | "@[<2>Field.Length_delimited {@,"; 49 | (((Format.fprintf fmt "@[%s =@ " "offset"; 50 | (Format.fprintf fmt "%d") aoffset; 51 | Format.fprintf fmt "@]"); 52 | Format.fprintf fmt ";@ "; 53 | Format.fprintf fmt "@[%s =@ " "length"; 54 | (Format.fprintf fmt "%d") alength; 55 | Format.fprintf fmt "@]"); 56 | Format.fprintf fmt ";@ "; 57 | Format.fprintf fmt "@[%s =@ " "data"; 58 | (match alength < 20 with 59 | | true -> (Format.fprintf fmt "%S") (String.sub adata aoffset alength) 60 | | false -> (Format.fprintf fmt "%S...") (String.sub adata aoffset 17) 61 | ); 62 | Format.fprintf fmt "@]"); 63 | Format.fprintf fmt "@]}") 64 | | Fixed_32_bit a0 -> 65 | (Format.fprintf fmt 66 | "(@[<2>Field.Fixed_32_bit@ "; 67 | (Format.fprintf fmt "%ldl") a0; 68 | Format.fprintf fmt "@])") 69 | 70 | let show : t -> string = Format.asprintf "%a" pp 71 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/infix.ml: -------------------------------------------------------------------------------- 1 | module Int64 = struct 2 | open Int64 3 | let (land) = logand 4 | let (lsl) = shift_left 5 | let (lsr) = shift_right_logical 6 | let (lor) = logor 7 | let (lxor) = logxor 8 | let (+) = add 9 | let (/) = div 10 | let ( * ) = mul 11 | let (-) = sub 12 | end 13 | 14 | module Int = struct 15 | open Int 16 | let (land) = logand 17 | let (lsl) = shift_left 18 | let (lsr) = shift_right_logical 19 | let (lor) = logor 20 | let (lxor) = logxor 21 | let (+) = add 22 | let (/) = div 23 | let ( * ) = mul 24 | let (-) = sub 25 | end 26 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/json.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | 3 | (** Json type. This is identical to Yojson.Basic.t *) 4 | type t = [ 5 | | `Null 6 | | `Bool of bool 7 | | `Int of int 8 | | `Float of float 9 | | `String of string 10 | | `Assoc of (string * t) list 11 | | `List of t list 12 | ] 13 | 14 | let rec to_string: t -> string = function 15 | | `Null -> "null" 16 | | `Bool b -> string_of_bool b 17 | | `Int i -> string_of_int i 18 | | `Float f -> string_of_float f 19 | | `String s -> Printf.sprintf "\"%s\"" s 20 | | `Assoc l -> List.map ~f:(fun (key, value) -> Printf.sprintf "\"%s\": %s" key (to_string value)) l 21 | |> String.concat ~sep:", " 22 | |> Printf.sprintf "{ %s }" 23 | | `List l -> List.map ~f:to_string l 24 | |> String.concat ~sep:", " 25 | |> Printf.sprintf "[ %s ]" 26 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/json_options.ml: -------------------------------------------------------------------------------- 1 | type t = { enum_names:bool; json_names:bool; omit_default_values:bool } 2 | 3 | (** 4 | Create options for json serialization. 5 | 6 | If [enum_names] is true then enums are serialized as strings. If false the integer value is used when serializing. 7 | 8 | If [json_name] is true then serialization will use the json field names. If false, the fields names will be used from the protofile as-is. 9 | 10 | If [omit_default_values] is false then default scalar values will not be emitted to the json. The default is to omit default values. 11 | *) 12 | let make ?(enum_names=true) ?(json_names=true) ?(omit_default_values=true) () = 13 | { enum_names; json_names; omit_default_values } 14 | let default = make () 15 | 16 | (**/**) 17 | 18 | (** Perfect hash function *) 19 | let to_int { enum_names; json_names; omit_default_values } = 20 | let b n = function true -> n | false -> 0 in 21 | b 4 enum_names + b 2 json_names + b 1 omit_default_values 22 | 23 | let of_int n = 24 | let b v n = n land v = v in 25 | { enum_names = b 4 n; json_names = b 2 n; omit_default_values = b 1 n; } 26 | 27 | let max_int = to_int { enum_names=true; json_names=true; omit_default_values=true } 28 | 29 | let%test "perfect hash" = let i = 0 in to_int (of_int i) = i 30 | let%test "perfect hash" = let i = 1 in to_int (of_int i) = i 31 | let%test "perfect hash" = let i = 2 in to_int (of_int i) = i 32 | let%test "perfect hash" = let i = 3 in to_int (of_int i) = i 33 | let%test "perfect hash" = let i = 4 in to_int (of_int i) = i 34 | let%test "perfect hash" = let i = 5 in to_int (of_int i) = i 35 | let%test "perfect hash" = let i = 6 in to_int (of_int i) = i 36 | let%test "perfect hash" = let i = 7 in to_int (of_int i) = i 37 | 38 | (**/**) 39 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/merge.ml: -------------------------------------------------------------------------------- 1 | (** Merge a two values. Need to match on the spec to merge messages recursivly *) 2 | let merge: type t v. (t, v) Spec.compound -> t -> t -> t = function 3 | | Spec.Basic (_field, _spec, default) -> 4 | (fun t t' -> match t' = default with true -> t | false -> t') 5 | (* The spec states that proto2 required fields must be transmitted exactly once. 6 | So merging these fields is not possible. The essentially means that you cannot merge 7 | proto2 messages containing required fields. 8 | In this implementation, we choose to ignore this, and adopt 'keep last' 9 | *) 10 | | Spec.Basic_req (_field, Message (module Message)) -> 11 | Message.merge 12 | | Spec.Basic_req (_field, _spec) -> fun _ t' -> t' 13 | | Spec.Basic_opt (_field, Message (module Message)) -> 14 | begin 15 | fun t t' -> 16 | match t, t' with 17 | | None, None -> None 18 | | Some t, None -> Some t 19 | | None, Some t -> Some t 20 | | Some t, Some t' -> Some (Message.merge t t') 21 | end 22 | | Spec.Basic_opt (_field, _spec) -> begin 23 | fun t -> function 24 | | Some _ as t' -> t' 25 | | None -> t 26 | end 27 | | Spec.Repeated (_field, _, _) -> List.append 28 | | Spec.Map (_field, _) -> List.append 29 | (* | Spec.Oneof _ when t' = `not_set -> t *) 30 | | Spec.Oneof _ -> failwith "Implementation is part of generated code" 31 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/ocaml_protoc_plugin.ml: -------------------------------------------------------------------------------- 1 | module Json = Json 2 | module Reader = Reader 3 | module Writer = Writer 4 | module Service = Service 5 | module Result = Result 6 | module Extensions = Extensions 7 | module Json_options = Json_options 8 | 9 | (**/**) 10 | module Serialize = Serialize 11 | module Deserialize = Deserialize 12 | module Serialize_json = Serialize_json 13 | module Deserialize_json = Deserialize_json 14 | module Spec = Spec 15 | module Field = Field 16 | module Merge = Merge 17 | 18 | (** Apply lazy binding if the backed is neither Native or bytecode *) 19 | let[@inline] apply_lazy f = 20 | match Sys.backend_type with 21 | | Native | Bytecode -> 22 | f () 23 | | Other _ -> 24 | let f = Lazy.from_fun f in 25 | fun x -> (Lazy.force f) x 26 | (**/**) 27 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/reader.ml: -------------------------------------------------------------------------------- 1 | (** Some buffer to hold data, and to read and write data *) 2 | open StdLabels 3 | 4 | type t = { 5 | mutable offset : int; 6 | end_offset : int; 7 | data : String.t; 8 | } 9 | 10 | let create ?(offset = 0) ?length data = 11 | let end_offset = 12 | match length with 13 | | None -> String.length data 14 | | Some l -> offset + l 15 | in 16 | assert (end_offset >= offset); 17 | assert (String.length data >= end_offset); 18 | {offset; end_offset; data} 19 | 20 | let reset t offset = t.offset <- offset 21 | let offset { offset; _ } = offset 22 | 23 | let[@inline] validate_capacity t count = 24 | match t.offset + count <= t.end_offset with 25 | | true -> () 26 | | false -> 27 | Result.raise `Premature_end_of_input 28 | 29 | let[@inline] has_more t = t.offset < t.end_offset 30 | 31 | let[@inline] read_byte t = 32 | match t.offset < t.end_offset with 33 | | true -> 34 | let v = String.unsafe_get t.data t.offset |> Char.code in 35 | t.offset <- t.offset + 1; 36 | v 37 | | false -> Result.raise `Premature_end_of_input 38 | 39 | let read_varint t = 40 | let open Infix.Int64 in 41 | let rec inner acc bit = 42 | let v = read_byte t |> Int64.of_int in 43 | let acc = acc lor ((v land 0x7fL) lsl bit) in 44 | match v land 0x80L = 0x80L with 45 | | true -> 46 | inner acc (Int.add bit 7) 47 | | false -> acc 48 | in 49 | inner 0L 0 50 | 51 | let read_varint_unboxed t = read_varint t |> Int64.to_int 52 | 53 | let read_fixed32 t = 54 | let size = 4 in 55 | validate_capacity t size; 56 | let v = Bytes.get_int32_le (Bytes.unsafe_of_string t.data) t.offset in 57 | t.offset <- t.offset + size; 58 | v 59 | 60 | let read_fixed64 t = 61 | let size = 8 in 62 | validate_capacity t size; 63 | let v = Bytes.get_int64_le (Bytes.unsafe_of_string t.data) t.offset in 64 | t.offset <- t.offset + size; 65 | v 66 | 67 | let read_length_delimited t = 68 | let length = read_varint_unboxed t in 69 | validate_capacity t length; 70 | let v = Field.{ offset = t.offset; length = length; data = t.data } in 71 | t.offset <- t.offset + length; 72 | v 73 | 74 | let read_field_header: t -> Field.field_type * int = fun t -> 75 | let v = read_varint_unboxed t in 76 | let tpe : Field.field_type = match v land 0x7 with 77 | | 0 -> Varint 78 | | 1 -> Fixed64 79 | | 2 -> Length_delimited 80 | | 5 -> Fixed32 81 | | _ -> failwith (Printf.sprintf "Illegal field header: 0x%x" v) 82 | in 83 | let field_number = v / 8 in 84 | (tpe, field_number) 85 | 86 | let read_field_content: Field.field_type -> t -> Field.t = function 87 | | Varint -> fun r -> Field.Varint (read_varint r) 88 | | Fixed64 -> fun r -> Field.Fixed_64_bit (read_fixed64 r) 89 | | Length_delimited -> fun r -> Length_delimited (read_length_delimited r) 90 | | Fixed32 -> fun r -> Field.Fixed_32_bit (read_fixed32 r) 91 | 92 | let next_field_header reader = 93 | match has_more reader with 94 | | true -> Some (read_field_header reader) 95 | | false -> None 96 | 97 | let to_list: t -> (int * Field.t) list = 98 | let read_field t = 99 | let (tpe, index) = read_field_header t in 100 | let field = read_field_content tpe t in 101 | (index, field) 102 | in 103 | let rec next t () = match has_more t with 104 | | true -> Seq.Cons (read_field t, next t) 105 | | false -> Seq.Nil 106 | in 107 | fun t -> 108 | next t |> List.of_seq 109 | 110 | 111 | let%expect_test "varint boxed" = 112 | let values = [-2L; -1L; 0x7FFFFFFFFFFFFFFFL; 0x7FFFFFFFFFFFFFFEL; 0x3FFFFFFFFFFFFFFFL; 0x3FFFFFFFFFFFFFFEL; 0L; 1L] in 113 | List.iter ~f:(fun v -> 114 | let buffer = 115 | let writer = Writer.init () in 116 | Writer.write_varint_value v writer; 117 | Writer.contents writer 118 | in 119 | Printf.printf "0x%016LxL = 0x%016LxL\n" 120 | v 121 | (read_varint (create buffer)); 122 | () 123 | ) values; 124 | [%expect {| 125 | 0xfffffffffffffffeL = 0xfffffffffffffffeL 126 | 0xffffffffffffffffL = 0xffffffffffffffffL 127 | 0x7fffffffffffffffL = 0x7fffffffffffffffL 128 | 0x7ffffffffffffffeL = 0x7ffffffffffffffeL 129 | 0x3fffffffffffffffL = 0x3fffffffffffffffL 130 | 0x3ffffffffffffffeL = 0x3ffffffffffffffeL 131 | 0x0000000000000000L = 0x0000000000000000L 132 | 0x0000000000000001L = 0x0000000000000001L |}] 133 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/reader.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | (** Create a reader from a string, to be used when deserializing a protobuf type *) 4 | val create : ?offset:int -> ?length:int -> string -> t 5 | val offset : t -> int 6 | val reset : t -> int -> unit 7 | 8 | (**/**) 9 | val read_field_header: t -> Field.field_type * int 10 | val read_field_content : Field.field_type -> t -> Field.t 11 | val has_more : t -> bool 12 | val to_list : t -> (int * Field.t) list 13 | val read_length_delimited : t -> Field.length_delimited 14 | val read_fixed32 : t -> int32 15 | val read_fixed64 : t -> int64 16 | 17 | val read_varint : t -> int64 18 | val read_varint_unboxed : t -> int 19 | val next_field_header : t -> (Field.field_type * int) option 20 | (**/**) 21 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/result.ml: -------------------------------------------------------------------------------- 1 | type error = 2 | [ `Premature_end_of_input 3 | | `Unknown_field_type of int 4 | | `Wrong_field_type of string * string 5 | | `Illegal_value of string * Field.t 6 | | `Unknown_enum_value of int 7 | | `Unknown_enum_name of string 8 | | `Required_field_missing of int * string ] 9 | 10 | exception Error of error 11 | type 'a t = ('a, error) result 12 | 13 | let raise error = raise (Error error) 14 | let catch f = try Ok (f ()) with Error (#error as v) -> Error v 15 | 16 | let ( >>| ) : 'a t -> ('a -> 'b) -> 'b t = function Ok x -> fun f -> Ok (f x) | Error err -> fun _ -> Error err 17 | let ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t = function Ok x -> fun f -> f x | Error err -> fun _ -> Error err 18 | let return x = Ok x 19 | 20 | let fail : error -> 'a t = fun x -> Error x 21 | let get ~msg = function 22 | | Ok v -> v 23 | | Error _ -> failwith msg 24 | 25 | let pp_error : Format.formatter -> [> error] -> unit = fun fmt -> function 26 | | `Premature_end_of_input -> 27 | Format.pp_print_string fmt 28 | "`Premature_end_of_input" 29 | | `Unknown_field_type x -> 30 | (Format.fprintf fmt 31 | "`Unknown_field_type (@["; 32 | (Format.fprintf fmt "%d") x; 33 | Format.fprintf fmt "@])") 34 | | `Wrong_field_type x -> 35 | (Format.fprintf fmt 36 | "`Wrong_field_type (@["; 37 | ((fun (a0, a1) -> 38 | Format.fprintf fmt "(@["; 39 | ((Format.fprintf fmt "%S") a0; 40 | Format.fprintf fmt ",@ "; 41 | (Format.fprintf fmt "%S") a1); 42 | Format.fprintf fmt "@])")) x; 43 | Format.fprintf fmt "@])") 44 | | `Illegal_value x -> 45 | (Format.fprintf fmt 46 | "`Illegal_value (@["; 47 | ((fun (a0, a1) -> 48 | Format.fprintf fmt "(@["; 49 | ((Format.fprintf fmt "%S") a0; 50 | Format.fprintf fmt ",@ "; 51 | (Field.pp fmt) a1); 52 | Format.fprintf fmt "@])")) x; 53 | Format.fprintf fmt "@])") 54 | | `Unknown_enum_value x -> 55 | (Format.fprintf fmt 56 | "`Unknown_enum_value (@["; 57 | (Format.fprintf fmt "%d") x; 58 | Format.fprintf fmt "@])") 59 | | `Unknown_enum_name x -> 60 | (Format.fprintf fmt 61 | "`Unknown_enum_name (@["; 62 | (Format.fprintf fmt "%s") x; 63 | Format.fprintf fmt "@])") 64 | | `Oneof_missing -> 65 | Format.pp_print_string fmt "`Oneof_missing" 66 | | `Required_field_missing x -> 67 | (Format.fprintf fmt 68 | "`Required_field_missing (@["; 69 | ((fun (a0, a1) -> 70 | Format.fprintf fmt "(@["; 71 | ((Format.fprintf fmt "%d") a0; 72 | Format.fprintf fmt ",@ "; 73 | (Format.fprintf fmt "%s") a1); 74 | Format.fprintf fmt "@])")) x; 75 | Format.fprintf fmt "@])") 76 | 77 | let show_error : error -> string = Format.asprintf "%a" pp_error 78 | 79 | let _ = 80 | Printexc.register_printer (function Error e -> Printf.sprintf "Ocaml_protoc_plugin.Result.Error (%s)" (show_error e) |> Option.some | _ -> None) 81 | 82 | let pp pp fmt = function 83 | | Ok v -> Format.fprintf fmt "Ok %a" pp v 84 | | Error (#error as e) -> Format.fprintf fmt "Error %a" pp_error e 85 | 86 | (* let show : 'a t -> string = Format.asprintf "%a" pp *) 87 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/result.mli: -------------------------------------------------------------------------------- 1 | type error = 2 | [ `Premature_end_of_input 3 | | `Unknown_field_type of int 4 | | `Wrong_field_type of string * string 5 | | `Illegal_value of string * Field.t 6 | | `Unknown_enum_value of int 7 | | `Unknown_enum_name of string 8 | | `Required_field_missing of int * string ] 9 | 10 | exception Error of error 11 | 12 | type 'a t = ('a, error) result 13 | 14 | (** Raise [error] as an exception of type Result.Error *) 15 | val raise : error -> 'a 16 | 17 | (** catch [f] catches any exception of type Result.Error raised and returns a result type *) 18 | val catch : (unit -> 'a) -> ('a, [> error ]) result 19 | 20 | (** Monadic map *) 21 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 22 | 23 | (** Monadoc bind *) 24 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 25 | 26 | (** Monadic return *) 27 | val return : 'a -> 'a t 28 | 29 | (** Create the error state *) 30 | val fail : error -> 'a t 31 | 32 | (** Get the value or fail with the given message *) 33 | val get : msg:string -> 'a t -> 'a 34 | 35 | (** Pretty printer of the error type *) 36 | val pp_error : Format.formatter -> error -> unit 37 | 38 | (** Create a string representation of [error] *) 39 | val show_error : error -> string 40 | 41 | (** Prettyprinter *) 42 | val pp : 43 | (Format.formatter -> 'a -> unit) -> 44 | Format.formatter -> ('a, [< error ]) result -> unit 45 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/serialize.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | 3 | open Spec 4 | 5 | let field_type: type a b. (a, b) spec -> int = function 6 | | Int64 | UInt64 | SInt64 | Int32 | UInt32 | SInt32 7 | | Int64_int | UInt64_int | Int32_int | UInt32_int | SInt64_int | SInt32_int 8 | | Bool | Enum _ -> 0 (* Varint *) 9 | | String | Bytes | Message _ -> 2 (* Length delimited *) 10 | | Double | Fixed64 | SFixed64 | Fixed64_int | SFixed64_int -> 1 (* Fixed 64 bit *) 11 | | Float | Fixed32 | SFixed32 | Fixed32_int | SFixed32_int -> 5 (* Fixed 32 bit *) 12 | 13 | let write_fixed64 ~f v = 14 | Writer.write_fixed64_value (f v) 15 | 16 | let write_fixed32 ~f v = 17 | Writer.write_fixed32_value (f v) 18 | 19 | let zigzag_encoding v = 20 | let open Infix.Int64 in 21 | let v = match v < 0L with 22 | | true -> v lsl 1 lxor (-1L) 23 | | false -> v lsl 1 24 | in 25 | v 26 | 27 | let zigzag_encoding_unboxed v = 28 | let v = match v < 0 with 29 | | true -> v lsl 1 lxor (-1) 30 | | false -> v lsl 1 31 | in 32 | v 33 | 34 | let write_varint ~f v = Writer.write_varint_value (f v) 35 | 36 | let write_varint_unboxed ~f v = 37 | Writer.write_varint_unboxed_value (f v) 38 | 39 | let write_length_delimited_string ~f v = 40 | let v = f v in 41 | Writer.write_length_delimited_value ~data:v ~offset:0 ~len:(String.length v) 42 | 43 | let (@@) a b = fun v -> b (a v) 44 | 45 | let write_value : type a b. (a, b) spec -> a -> Writer.t -> unit = function 46 | | Double -> write_fixed64 ~f:Int64.bits_of_float 47 | | Float -> write_fixed32 ~f:Int32.bits_of_float 48 | | Fixed64 -> Writer.write_fixed64_value 49 | | SFixed64 -> Writer.write_fixed64_value 50 | | Fixed64_int -> write_fixed64 ~f:Int64.of_int 51 | | SFixed64_int -> write_fixed64 ~f:Int64.of_int 52 | | Fixed32 -> Writer.write_fixed32_value 53 | | SFixed32 -> Writer.write_fixed32_value 54 | | Fixed32_int -> write_fixed32 ~f:Int32.of_int 55 | | SFixed32_int -> write_fixed32 ~f:Int32.of_int 56 | | Int64 -> Writer.write_varint_value 57 | | UInt64 -> Writer.write_varint_value 58 | | SInt64 -> write_varint ~f:zigzag_encoding 59 | | Int32 -> write_varint_unboxed ~f:Int32.to_int 60 | | UInt32 -> write_varint_unboxed ~f:Int32.to_int 61 | | SInt32 -> write_varint_unboxed ~f:(Int32.to_int @@ zigzag_encoding_unboxed) 62 | | Int64_int -> Writer.write_varint_unboxed_value 63 | | UInt64_int -> Writer.write_varint_unboxed_value 64 | | Int32_int -> Writer.write_varint_unboxed_value 65 | | UInt32_int -> Writer.write_varint_unboxed_value 66 | | SInt64_int -> write_varint_unboxed ~f:zigzag_encoding_unboxed 67 | | SInt32_int -> write_varint_unboxed ~f:zigzag_encoding_unboxed 68 | 69 | | Bool -> write_varint_unboxed ~f:(function true -> 1 | false -> 0) 70 | | String -> fun v -> Writer.write_length_delimited_value ~data:v ~offset:0 ~len:(String.length v) 71 | | Bytes -> write_length_delimited_string ~f:Bytes.unsafe_to_string 72 | | Enum (module Enum) -> write_varint_unboxed ~f:Enum.to_int 73 | | Message (module Message) -> 74 | Writer.write_length_delimited_f ~write_f:Message.to_proto' 75 | 76 | (** Optimized when the value is given in advance, and the continuation is expected to be called multiple times *) 77 | let write_value_const : type a b. (a, b) spec -> a -> Writer.t -> unit = fun spec v -> 78 | let write_value = write_value spec in 79 | let writer = Writer.init () in 80 | write_value v writer; 81 | let data = Writer.contents writer in 82 | Writer.write_const_value data 83 | 84 | let write_field_header: _ spec -> int -> Writer.t -> unit = fun spec index -> 85 | let field_type = field_type spec in 86 | let header = (index lsl 3) + field_type in 87 | write_value_const Int64_int header 88 | 89 | let write_field: type a b. (a, b) spec -> int -> Writer.t -> a -> unit = fun spec index -> 90 | let write_field_header = write_field_header spec index in 91 | let write_value = write_value spec in 92 | fun writer v-> 93 | write_field_header writer; 94 | write_value v writer 95 | 96 | let rec write: type a b. (a, b) compound -> Writer.t -> a -> unit = function 97 | | Repeated ((index, _, _), spec, Packed) -> begin 98 | let write_value = write_value spec in 99 | let write_f writer vs = List.iter ~f:(fun v -> write_value v writer) vs in 100 | let write_header = write_field_header String index in 101 | fun writer vs -> 102 | match vs with 103 | | [] -> () 104 | | vs -> 105 | write_header writer; 106 | Writer.write_length_delimited_f ~write_f vs writer 107 | end 108 | | Repeated ((index, _, _), spec, Not_packed) -> 109 | let write = write_field spec index in 110 | fun writer vs -> 111 | List.iter ~f:(fun v -> write writer v) vs 112 | | Map ((index, _, _), (key_spec, value_compound)) -> 113 | let write_header = write_field_header String index in 114 | let write_key = write (Basic_req ((1, "key", "key"), key_spec)) in 115 | let write_value = write value_compound in 116 | let write_entry writer (key, value) = 117 | write_key writer key; 118 | write_value writer value; 119 | () 120 | in 121 | let write = Writer.write_length_delimited_f ~write_f:write_entry in 122 | fun writer vs -> 123 | List.iter ~f:(fun v -> 124 | write_header writer; 125 | write v writer 126 | ) vs 127 | | Basic ((index, _, _), spec, default) -> begin 128 | let write = write_field spec index in 129 | let writer writer = function 130 | | v when v = default -> () 131 | | v -> write writer v 132 | in 133 | writer 134 | end 135 | | Basic_req ((index, _, _), spec) -> 136 | write_field spec index 137 | | Basic_opt ((index, _, _), spec) -> begin 138 | let write = write_field spec index in 139 | fun writer v -> 140 | match v with 141 | | Some v -> write writer v 142 | | None -> () 143 | end 144 | | Oneof (oneofs, index_f) -> begin 145 | let create_writer: type a. a oneof -> (Writer.t -> a -> unit) = function 146 | | Oneof_elem (field, spec, (_constr, destructor)) -> 147 | let write = write (Basic_req (field, spec)) in 148 | fun writer v -> 149 | write writer (destructor v) 150 | in 151 | let field_writers = List.map ~f:create_writer oneofs |> Array.of_list in 152 | fun writer -> function 153 | | `not_set -> () 154 | | v -> 155 | let index = index_f v in 156 | let write = Array.unsafe_get field_writers index in 157 | write writer v 158 | end 159 | 160 | let in_extension_ranges extension_ranges index = 161 | List.exists ~f:(fun (start, end') -> index >= start && index <= end') extension_ranges 162 | 163 | let rec serialize: type a. (a, unit) compound_list -> Writer.t -> a = function 164 | | Nil -> fun _writer -> () 165 | | Nil_ext extension_ranges -> 166 | fun writer extensions -> 167 | List.iter ~f:(function 168 | | (index, field) when in_extension_ranges extension_ranges index -> Writer.write_field writer index field 169 | | _ -> () 170 | ) extensions; 171 | () 172 | | Cons (compound, rest) -> 173 | let cont = serialize rest in 174 | let write = write compound in 175 | fun writer v -> 176 | write writer v; 177 | cont writer 178 | 179 | let%expect_test "zigzag encoding" = 180 | let test vl = 181 | let v = Int64.to_int vl in 182 | Printf.printf "zigzag_encoding(%LdL) = %LdL\n" vl (zigzag_encoding vl); 183 | Printf.printf "zigzag_encoding_unboxed(%d) = %d\n" v (zigzag_encoding_unboxed v); 184 | in 185 | List.iter ~f:test [0L; -1L; 1L; -2L; 2L; 2147483647L; -2147483648L; Int64.max_int; Int64.min_int; ]; 186 | [%expect {| 187 | zigzag_encoding(0L) = 0L 188 | zigzag_encoding_unboxed(0) = 0 189 | zigzag_encoding(-1L) = 1L 190 | zigzag_encoding_unboxed(-1) = 1 191 | zigzag_encoding(1L) = 2L 192 | zigzag_encoding_unboxed(1) = 2 193 | zigzag_encoding(-2L) = 3L 194 | zigzag_encoding_unboxed(-2) = 3 195 | zigzag_encoding(2L) = 4L 196 | zigzag_encoding_unboxed(2) = 4 197 | zigzag_encoding(2147483647L) = 4294967294L 198 | zigzag_encoding_unboxed(2147483647) = 4294967294 199 | zigzag_encoding(-2147483648L) = 4294967295L 200 | zigzag_encoding_unboxed(-2147483648) = 4294967295 201 | zigzag_encoding(9223372036854775807L) = -2L 202 | zigzag_encoding_unboxed(-1) = 1 203 | zigzag_encoding(-9223372036854775808L) = -1L 204 | zigzag_encoding_unboxed(0) = 0 |}] 205 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/serialize.mli: -------------------------------------------------------------------------------- 1 | val serialize : ('a, unit) Spec.compound_list -> Writer.t -> 'a 2 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/serialize_json.mli: -------------------------------------------------------------------------------- 1 | 2 | val serialize: message_name:string -> ('a, Json.t) Spec.compound_list -> Json_options.t -> 'a 3 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/service.ml: -------------------------------------------------------------------------------- 1 | module type Message = Spec.Message [@@deprecated "Use Spec.Message"] 2 | 3 | module type Rpc = sig 4 | module Request : Spec.Message 5 | module Response : Spec.Message 6 | 7 | (** gRPC service name as defined by the gRPC http2 spec. 8 | see https://github.com/grpc/grpc/blob/master/doc/PROTOCOL-HTTP2.md#appendix-a---grpc-for-protobuf 9 | *) 10 | val name : string 11 | 12 | (** Name of the enclosed package name if any *) 13 | val package_name : string option 14 | 15 | (** Name of the service in which this method is defined *) 16 | val service_name : string 17 | 18 | (** Name of the method *) 19 | val method_name : string 20 | end 21 | 22 | let make_client_functions (type req) (type rep) 23 | ((module Request : Spec.Message with type t = req), 24 | (module Response : Spec.Message with type t = rep)) = 25 | Request.to_proto, Response.from_proto 26 | 27 | let make_service_functions (type req) (type rep) 28 | ((module Request : Spec.Message with type t = req), 29 | (module Response : Spec.Message with type t = rep)) = 30 | Request.from_proto, Response.to_proto 31 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/spec.ml: -------------------------------------------------------------------------------- 1 | module type T = sig 2 | type 'a message 3 | type 'a enum 4 | type 'a oneof 5 | type 'a oneof_elem 6 | type 'a map 7 | end 8 | 9 | module type Enum = sig 10 | type t 11 | val name: unit -> string 12 | val to_int: t -> int 13 | val from_int: int -> t Result.t 14 | val from_int_exn: int -> t 15 | val to_string: t -> string 16 | val from_string_exn: string -> t 17 | end 18 | 19 | module type Message = sig 20 | type t 21 | type make_t 22 | val name: unit -> string 23 | val make: make_t 24 | val from_proto: Reader.t -> t Result.t 25 | val from_proto_exn: Reader.t -> t 26 | val to_proto: t -> Writer.t 27 | val to_proto': Writer.t -> t -> unit 28 | val merge: t -> t -> t 29 | val to_json: Json_options.t -> t -> Json.t 30 | val from_json_exn: Json.t -> t 31 | val from_json: Json.t -> t Result.t 32 | end 33 | 34 | module Make(T : T) = struct 35 | type packed = Packed | Not_packed 36 | type extension_ranges = (int * int) list 37 | type extensions = (int * Field.t) list 38 | type 'a merge = 'a -> 'a -> 'a 39 | type field = (int * string * string) 40 | 41 | type scalar = [ `Scalar ] 42 | type message = [ `Message ] 43 | 44 | type (_, _) spec = 45 | | Double : (float, scalar) spec 46 | | Float : (float, scalar) spec 47 | 48 | | Int32 : (Int32.t, scalar) spec 49 | | UInt32 : (Int32.t, scalar) spec 50 | | SInt32 : (Int32.t, scalar) spec 51 | | Fixed32 : (Int32.t, scalar) spec 52 | | SFixed32 : (Int32.t, scalar) spec 53 | 54 | | Int32_int : (int, scalar) spec 55 | | UInt32_int : (int, scalar) spec 56 | | SInt32_int : (int, scalar) spec 57 | | Fixed32_int : (int, scalar) spec 58 | | SFixed32_int : (int, scalar) spec 59 | 60 | | UInt64 : (Int64.t, scalar) spec 61 | | Int64 : (Int64.t, scalar) spec 62 | | SInt64 : (Int64.t, scalar) spec 63 | | Fixed64 : (Int64.t, scalar) spec 64 | | SFixed64 : (Int64.t, scalar) spec 65 | 66 | | UInt64_int : (int, scalar) spec 67 | | Int64_int : (int, scalar) spec 68 | | SInt64_int : (int, scalar) spec 69 | | Fixed64_int : (int, scalar) spec 70 | | SFixed64_int : (int, scalar) spec 71 | 72 | | Bool : (bool, scalar) spec 73 | | String : (string, scalar) spec 74 | | Bytes : (bytes, scalar) spec 75 | | Enum : (module Enum with type t = 'a) T.enum -> ('a, scalar) spec 76 | | Message : (module Message with type t = 'a) T.message -> ('a, message) spec 77 | 78 | type _ oneof = 79 | | Oneof_elem : field * ('b, _) spec * (('b -> 'a) * ('a -> 'b)) T.oneof_elem -> 'a oneof 80 | 81 | type 'a basic = 'a * [`Basic] 82 | type 'a any = 'a * [`Any] 83 | 84 | 85 | type (_, _) compound = 86 | (* A field, where the default value is know. *) 87 | | Basic : field * ('a, scalar) spec * 'a -> ('a, scalar basic) compound 88 | 89 | (* Proto2/proto3 optional fields. *) 90 | | Basic_opt : field * ('a, 'b) spec -> ('a option, 'b basic) compound 91 | 92 | (* Proto2 required fields (and oneof fields) *) 93 | | Basic_req : field * ('a, 'b) spec -> ('a, 'b any) compound 94 | 95 | (* Repeated fields *) 96 | | Repeated : field * ('a, 'b) spec * packed -> ('a list, 'b any) compound 97 | 98 | (* Map types. Should we create a message_opt type? *) 99 | | Map : field * (('a, scalar) spec * ('b, 'c basic) compound) T.map -> (('a * 'b) list, _ any) compound 100 | 101 | (* Oneofs. A list of fields + function to index the field *) 102 | | Oneof : (('a oneof list) * ('a -> int)) T.oneof -> ([> `not_set ] as 'a, _ any) compound 103 | 104 | type (_, _) compound_list = 105 | (* End of list *) 106 | | Nil : ('a, 'a) compound_list 107 | 108 | (* Nil_ext denotes that the message contains extensions *) 109 | | Nil_ext: extension_ranges -> (extensions -> 'a, 'a) compound_list 110 | 111 | (* List element *) 112 | | Cons : (('a, _) compound) * ('b, 'c) compound_list -> ('a -> 'b, 'c) compound_list 113 | 114 | let double = Double 115 | let float = Float 116 | let int32 = Int32 117 | let int64 = Int64 118 | let uint32 = UInt32 119 | let uint64 = UInt64 120 | let sint32 = SInt32 121 | let sint64 = SInt64 122 | let fixed32 = Fixed32 123 | let fixed64 = Fixed64 124 | let sfixed32 = SFixed32 125 | let sfixed64 = SFixed64 126 | 127 | let int32_int = Int32_int 128 | let int64_int = Int64_int 129 | let uint32_int = UInt32_int 130 | let uint64_int = UInt64_int 131 | let sint32_int = SInt32_int 132 | let sint64_int = SInt64_int 133 | let fixed32_int = Fixed32_int 134 | let fixed64_int = Fixed64_int 135 | let sfixed32_int = SFixed32_int 136 | let sfixed64_int = SFixed64_int 137 | 138 | let bool = Bool 139 | let string = String 140 | let bytes = Bytes 141 | let enum e = Enum e 142 | let message m = Message m 143 | 144 | let some v = Some v 145 | let none = None 146 | let default_bytes v = (Some (Bytes.of_string v)) 147 | 148 | let repeated (i, s, p) = Repeated (i, s, p) 149 | let map (i, s) = Map (i, s) 150 | let basic (i, s, d) = Basic (i, s, d) 151 | let basic_req (i, s) = Basic_req (i, s) 152 | let basic_opt (i, s) = Basic_opt (i, s) 153 | let oneof s = Oneof s 154 | let oneof_elem (a, b, c) = Oneof_elem (a, b, c) 155 | 156 | let packed = Packed 157 | let not_packed = Not_packed 158 | 159 | let ( ^:: ) a b = Cons (a, b) 160 | let nil = Nil 161 | let nil_ext extension_ranges = Nil_ext extension_ranges 162 | 163 | let show: type a b. (a, b) spec -> string = function 164 | | Double -> "Double" 165 | | Float -> "Float" 166 | 167 | | Int32 -> "Int32" 168 | | UInt32 -> "UInt32" 169 | | SInt32 -> "SInt32" 170 | | Fixed32 -> "Fixed32" 171 | | SFixed32 -> "SFixed32" 172 | 173 | | Int32_int -> "Int32_int" 174 | | UInt32_int -> "UInt32_int" 175 | | SInt32_int -> "SInt32_int" 176 | | Fixed32_int -> "Fixed32_int" 177 | | SFixed32_int -> "SFixed32_int" 178 | 179 | | UInt64 -> "UInt64" 180 | | Int64 -> "Int64" 181 | | SInt64 -> "SInt64" 182 | | Fixed64 -> "Fixed64" 183 | | SFixed64 -> "SFixed64" 184 | 185 | | UInt64_int -> "UInt64_int" 186 | | Int64_int -> "Int64_int" 187 | | SInt64_int -> "SInt64_int" 188 | | Fixed64_int -> "Fixed64_int" 189 | | SFixed64_int -> "SFixed64_int" 190 | 191 | | Bool -> "Bool" 192 | | String -> "String" 193 | | Bytes -> "Bytes" 194 | | Enum _ -> "Enum" 195 | | Message _ -> "Message" 196 | end 197 | 198 | 199 | include Make(struct 200 | type 'a message = 'a 201 | type 'a enum = 'a 202 | type 'a oneof = 'a 203 | type 'a oneof_elem = 'a 204 | type 'a map = 'a 205 | end) 206 | 207 | let default_of_spec: type a. (a, scalar) spec -> a = function 208 | | Double -> 0.0 209 | | Float -> 0.0 210 | 211 | | Int32 -> Int32.zero 212 | | UInt32 -> Int32.zero 213 | | SInt32 -> Int32.zero 214 | | Fixed32 -> Int32.zero 215 | | SFixed32 -> Int32.zero 216 | 217 | | Int32_int -> 0 218 | | UInt32_int -> 0 219 | | SInt32_int -> 0 220 | | Fixed32_int -> 0 221 | | SFixed32_int -> 0 222 | 223 | | Int64 -> Int64.zero 224 | | UInt64 -> Int64.zero 225 | | SInt64 -> Int64.zero 226 | | Fixed64 -> Int64.zero 227 | | SFixed64 -> Int64.zero 228 | 229 | | UInt64_int -> 0 230 | | Int64_int -> 0 231 | | SInt64_int -> 0 232 | | Fixed64_int -> 0 233 | | SFixed64_int -> 0 234 | 235 | | Bool -> false 236 | | String -> "" 237 | | Bytes -> Bytes.create 0 238 | | Enum (module Enum) -> Enum.from_int_exn 0 239 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/writer.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | type mode = Balanced | Speed | Space 4 | 5 | (** Create a new writer to hold serialized data. 6 | The writer also controls how data is serialized and allows for different modes of operation though the [mode] parameter: 7 | [Balanced]:: Serializes data in a strictly compliant mode. Balance space and speed. 8 | [Speed]:: Applies optimization which is exploiting the protobuf wire format (but not violating it). Its believed to be safe, but may confuse other protobuf deserializers. The optimization mainly speeds up serialization of large recursive message types. Resulting protobuf serialization is slightly larger than needed, but is comparable to [Space] mode in terms of extra memory used while serialization. 9 | [Space]:: Limits space overhead (space waste) caused when allocated datablocks cannot be fully filled. The mode causes multiple data copies while serializing to avoid space overhead. This is the default. 10 | 11 | [block_size] controls the minimum size of block allocation. Setting this to zero will significantly slow down serialization but reduce space overhead. Setting a high value may cause more space overhead, esp. for recursive message structures. The default is to allocate block of size 120. This size is choosen to avoid heap allocation ([malloc]) for Ocaml 5.0. 12 | *) 13 | val init: ?mode:mode -> ?block_size:int -> unit -> t 14 | 15 | (** Get the protobuf encoded contents of the writer *) 16 | val contents : t -> string 17 | 18 | (**/**) 19 | 20 | (* Direct functions *) 21 | val write_fixed32_value: int32 -> t -> unit 22 | val write_fixed64_value: int64 -> t -> unit 23 | val write_varint_unboxed_value: int -> t -> unit 24 | val write_varint_value: int64 -> t -> unit 25 | val write_length_delimited_value: data:string -> offset:int -> len:int -> t -> unit 26 | val write_const_value: string -> t -> unit 27 | 28 | val write_length_delimited_f: write_f:(t -> 'a -> unit) -> 'a -> t -> unit 29 | val write_field : t -> int -> Field.t -> unit 30 | 31 | (** Construct a writer from a field list *) 32 | val of_list: (int * Field.t) list -> t 33 | 34 | (** Dump contents of the writer to stdout *) 35 | val dump : t -> unit 36 | 37 | val unused_space : t -> int 38 | val write_varint: Bytes.t -> offset:int -> Int64.t -> int 39 | val write_varint_unboxed: Bytes.t -> offset:int -> int -> int 40 | (**/**) 41 | -------------------------------------------------------------------------------- /src/plugin/code.ml: -------------------------------------------------------------------------------- 1 | open !StdLabels 2 | open !MoreLabels 3 | open !Utils 4 | 5 | type indent = [ `Begin | `End | `EndBegin | `None | `Raw ] 6 | 7 | type t = { 8 | mutable indent : int; 9 | mutable code : (indent * string) list; 10 | } 11 | 12 | let init () = {indent = 0; code = []} 13 | let incr t = t.indent <- t.indent + 1 14 | let decr t = 15 | match t.indent = 0 with 16 | | true -> failwith "Cannot decr indentation level at this point" 17 | | false -> t.indent <- t.indent - 1 18 | 19 | let emit t indent fmt = 20 | (* Verify indentation level *) 21 | (match indent with 22 | | `Begin -> incr t 23 | | `End -> decr t 24 | | `EndBegin -> decr t; incr t 25 | | `None -> () 26 | | `Raw -> () 27 | ); 28 | 29 | let emit s = 30 | String.split_on_char ~sep:'\n' s 31 | |> List.iter ~f:(fun s -> t.code <- (indent, String.trim_end ~chars:" \t" s) :: t.code) 32 | in 33 | Printf.ksprintf emit fmt 34 | 35 | let contents t = 36 | let append buffer indent s = 37 | (match String.length s > 0 with 38 | | true -> 39 | List.iter ~f:(Buffer.add_string buffer) indent; 40 | Buffer.add_string buffer s 41 | | false -> () 42 | ); 43 | Buffer.add_string buffer "\n"; 44 | buffer 45 | in 46 | 47 | let rec print buffer indent = function 48 | | (`None, s) :: lines -> print (append buffer indent s) indent lines 49 | | (`Begin, s) :: lines -> print (append buffer indent s) (" " :: indent) lines 50 | | (`EndBegin, s) :: lines -> 51 | let indent' = List.tl indent in 52 | print (append buffer indent' s) indent lines 53 | | (`End, s) :: lines -> 54 | let indent = List.tl indent in 55 | print (append buffer indent s) indent lines 56 | | (`Raw, s) :: lines -> 57 | print (append buffer [] s) indent lines 58 | | [] -> 59 | Buffer.contents buffer 60 | in 61 | print (Buffer.create 256) [] (List.rev t.code) 62 | 63 | let append t code = 64 | (* Same as rev_append no??? *) 65 | List.iter ~f:(fun l -> t.code <- l :: t.code) (code.code |> List.rev) 66 | 67 | let append_deprecaton_if ~deprecated level str = 68 | match deprecated with 69 | | false -> str 70 | | true -> 71 | let level = match level with 72 | | `Attribute -> "@" 73 | | `Item -> "@@" 74 | | `Floating -> "@@@" 75 | in 76 | Printf.sprintf "%s[%socaml.alert protobuf \"Marked as deprecated in the .proto file\"]" str level 77 | 78 | let emit_deprecation ?(deprecated=true) t level = 79 | if deprecated then 80 | emit t `None "%s" (append_deprecaton_if ~deprecated:true level "") 81 | 82 | let emit_comment ~(position:[`Leading | `Trailing]) t = function 83 | | None -> () 84 | | Some comments -> 85 | if position = `Leading then emit t `None ""; 86 | let comment_string = Comment_db.to_ocaml_doc comments in 87 | emit t `Begin "(**"; 88 | emit t `Raw "%s" comment_string; 89 | emit t `End "*)"; 90 | if position = `Trailing then emit t `None ""; 91 | () 92 | 93 | (** Emit comment for muliple fields / constructors *) 94 | let emit_field_doc t 95 | ~(position:[`Leading | `Trailing]) 96 | ?(format:('a -> 'b, unit, string, unit) format4="[%s]") 97 | ?(header="") 98 | ?(comments) 99 | param_comments = 100 | 101 | (* Remove parameters with no comments *) 102 | let has_header = String.length header > 0 in 103 | 104 | match comments, List.is_empty param_comments with 105 | | None, true -> () 106 | | _ -> 107 | if position = `Leading then emit t `None ""; 108 | emit t `Begin "(**"; 109 | Option.iter ~f:(fun comments -> emit t `Raw "%s" (Comment_db.to_ocaml_doc comments)) comments; 110 | if has_header then emit t `None "%s" header; 111 | List.iter ~f:(fun (param, comments) -> 112 | emit t `None ""; 113 | emit t `Begin format param; 114 | emit t `Raw "%s" (Comment_db.to_ocaml_doc comments); 115 | emit t `End ""; 116 | ) param_comments; 117 | 118 | emit t `End "*)"; 119 | if position = `Trailing then emit t `None "" 120 | -------------------------------------------------------------------------------- /src/plugin/comment_db.mli: -------------------------------------------------------------------------------- 1 | type comment 2 | type t 3 | val init: Spec.Descriptor.Google.Protobuf.FileDescriptorProto.t -> t 4 | val get_message_comments : proto_path:string -> ?name:string -> t -> comment option 5 | val get_field_comments : proto_path:string -> ?name:string -> t -> comment option 6 | val get_enum_comments : proto_path:string -> ?name:string -> t -> comment option 7 | val get_enum_value_comments : proto_path:string -> ?name:string -> t -> comment option 8 | val get_oneof_comments : proto_path:string -> ?name:string -> t -> comment option 9 | val get_service_comments : proto_path:string -> ?name:string -> t -> comment option 10 | val get_method_comments : proto_path:string -> ?name:string -> t -> comment option 11 | val get_extension_comments : proto_path:string -> ?name:string -> t -> comment option 12 | val get_file_comments : t -> comment option 13 | val get_option_comments : proto_path:string -> ?name:string -> t -> comment option 14 | 15 | val to_ocaml_doc : comment -> string 16 | -------------------------------------------------------------------------------- /src/plugin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name protoc_gen_ocaml) 3 | (public_name protoc-gen-ocaml) 4 | (libraries spec str omd) 5 | (package ocaml-protoc-plugin) 6 | (instrumentation (backend bisect_ppx)) 7 | ) 8 | -------------------------------------------------------------------------------- /src/plugin/emit.mli: -------------------------------------------------------------------------------- 1 | open Spec.Descriptor.Google.Protobuf 2 | val parse_proto_file: 3 | params:Parameters.t -> 4 | scope:Scope.t -> type_db:Type_db.t -> FileDescriptorProto.t -> string * Code.t 5 | -------------------------------------------------------------------------------- /src/plugin/names.ml: -------------------------------------------------------------------------------- 1 | open !StdLabels 2 | open !MoreLabels 3 | open !Utils 4 | 5 | type char_type = Lower | Upper | Neither 6 | 7 | (** Taken from: https://caml.inria.fr/pub/docs/manual-ocaml/lex.html *) 8 | let is_reserved = function 9 | | "and" | "as" | "assert" | "asr" | "begin" | "class" | "constraint" | "do" | "done" 10 | | "downto" | "else" | "end" | "exception" | "external" | "false" | "for" | "fun" 11 | | "function" | "functor" | "if" | "in" | "include" | "inherit" | "initializer" 12 | | "land" | "lazy" | "let" | "lor" | "lsl" | "lsr" | "lxor" | "match" | "method" 13 | | "mod" | "module" | "mutable" | "new" | "nonrec" | "object" | "of" | "open" | "or" 14 | | "private" | "rec" | "sig" | "struct" | "then" | "to" | "true" | "try" | "type" 15 | | "val" | "virtual" | "when" | "while" | "with" -> true 16 | | _ -> false 17 | 18 | let to_snake_case ident = 19 | let to_list s = 20 | let r = ref [] in 21 | String.iter ~f:(fun c -> r := c :: !r) s; 22 | List.rev !r 23 | in 24 | let to_string l = 25 | let bytes = Bytes.create (List.length l) in 26 | List.iteri ~f:(fun i c -> Bytes.set bytes i c) l; 27 | Bytes.to_string bytes 28 | in 29 | let char_case = function 30 | | 'a' .. 'z' -> Lower 31 | | 'A' .. 'Z' -> Upper 32 | | _ -> Neither 33 | in 34 | let is_lower c = char_case c = Lower in 35 | let is_upper c = char_case c = Upper in 36 | 37 | let rec to_snake_case = function 38 | | c1 :: c2 :: cs when is_lower c1 && is_upper c2 -> 39 | c1 :: '_' :: c2 :: to_snake_case cs 40 | | c1 :: cs -> 41 | c1 :: (to_snake_case cs) 42 | | [] -> [] 43 | in 44 | to_list ident 45 | |> to_snake_case 46 | |> to_string 47 | |> String.lowercase_ascii 48 | |> String.capitalize_ascii 49 | 50 | let field_name field_name = 51 | String.uncapitalize_ascii field_name 52 | 53 | let method_name = field_name 54 | 55 | let module_name name = 56 | match name.[0] with 57 | | '_' -> "P" ^ name 58 | | _ -> String.capitalize_ascii name 59 | 60 | let module_name_of_proto ?package proto_file = 61 | Filename.chop_extension proto_file 62 | |> Filename.basename 63 | |> ( 64 | match package with 65 | | Some package -> Printf.sprintf "%s_%s" package 66 | | None -> fun s -> s 67 | ) 68 | |> String.capitalize_ascii 69 | |> String.map ~f:(function '-' | '.' -> '_' | c -> c) 70 | 71 | let constructor_name = module_name 72 | 73 | let poly_constructor_name name = 74 | "`" ^ String.capitalize_ascii name 75 | 76 | let has_mangle_option options = 77 | match options with 78 | | None -> false 79 | | Some options -> 80 | Spec.Options.Ocaml_options.get options 81 | |> Ocaml_protoc_plugin.Result.get ~msg:"Could not parse ocaml-protoc-plugin option id 1074" 82 | |> function 83 | | Some v -> v 84 | | None -> false 85 | 86 | (** Map a set of proto_names to ocaml names. The mapping will be uniq and prioritize minimum differences 87 | [mangle_f] is a generic mangle function 88 | [name_f] is a function to convert a name into the ocaml required type (E.g. capitalize or adding a '`') 89 | *) 90 | let create_ocaml_mapping: ?name_map:string StringMap.t -> ?mangle_f:(string -> string) -> name_f:(string -> string) -> string list -> string StringMap.t = 91 | fun ?(name_map=StringMap.empty) ?(mangle_f=(fun x -> x)) ~name_f proto_names -> 92 | 93 | (* Expand names into proto_name, mapped_name, mangled_name *) 94 | let expanded_names = 95 | let name_f proto_name = 96 | name_f proto_name |> function 97 | | name when is_reserved name -> name ^ "'" 98 | | name -> name 99 | in 100 | let mangle_f proto_name = name_f (mangle_f proto_name) in 101 | 102 | List.map ~f:(fun proto_name -> 103 | let standard_name = name_f proto_name in 104 | let mangled_name = mangle_f proto_name in 105 | (proto_name, mangled_name, standard_name) 106 | ) proto_names 107 | in 108 | 109 | (* Sort the names to create a stable-like mapping *) 110 | let expanded_names = 111 | let l = String.lowercase_ascii in 112 | let cmp n1 n2 = 113 | match n1, n2 with 114 | (* Ocaml name = proto name *) 115 | | ( proto_name, mangled_name, _standard_name), ( proto_name', mangled_name', _standard_name') when 116 | proto_name = mangled_name && proto_name' = mangled_name' -> 0 117 | | ( proto_name, mangled_name, _standard_name), (_proto_name', _mangled_name', _standard_name') when 118 | proto_name = mangled_name -> -1 119 | | (_proto_name, _mangled_name, _standard_name), ( proto_name', mangled_name', _standard_name') when 120 | proto_name' = mangled_name' -> 1 121 | (* Ocaml name = standard name *) 122 | | (_proto_name, mangled_name, standard_name), (_proto_name', mangled_name', standard_name') when 123 | mangled_name = standard_name && mangled_name' = standard_name'-> 0 124 | | (_proto_name, mangled_name, standard_name), (_proto_name', _mangled_name', _standard_name') when 125 | mangled_name = standard_name -> -1 126 | | (_proto_name, _mangled_name, _standard_name), (_proto_name', mangled_name', standard_name') when 127 | mangled_name' = standard_name'-> 1 128 | (* Lower case ocaml name = lower case proto name *) 129 | | ( proto_name, mangled_name, _standard_name), ( proto_name', mangled_name', _standard_name') when 130 | l proto_name = l mangled_name && l proto_name' = l mangled_name' -> 0 131 | | ( proto_name, mangled_name, _standard_name), (_proto_name', _mangled_name', _standard_name') when 132 | l proto_name = l mangled_name -> -1 133 | | (_proto_name, _mangled_name, _standard_name), ( proto_name', mangled_name', _standard_name') when 134 | l proto_name' = l mangled_name' -> 1 135 | (* Lower case Ocaml name = lower case standard name *) 136 | | (_proto_name, mangled_name, standard_name), (_proto_name', mangled_name', standard_name') when 137 | l mangled_name = l standard_name && l mangled_name' = l standard_name'-> 0 138 | | (_proto_name, mangled_name, standard_name), (_proto_name', _mangled_name', _standard_name') when 139 | l mangled_name = l standard_name -> -1 140 | | (_proto_name, _mangled_name, _standard_name), (_proto_name', mangled_name', standard_name') when 141 | l mangled_name' = l standard_name'-> 1 142 | (* No mapping available. *) 143 | | ( _proto_name, _mangled_name, _standard_name), ( _proto_name', _mangled_name', _standard_name') -> 0 144 | in 145 | (* Stable sort is important here *) 146 | List.stable_sort ~cmp expanded_names 147 | in 148 | 149 | let seen = 150 | StringMap.fold ~init:StringSet.empty ~f:(fun ~key:_ ~data:ocaml_name seen -> 151 | StringSet.add ocaml_name seen 152 | ) name_map 153 | in 154 | let name_map, _seen = 155 | let rec make_uniq seen name = 156 | match StringSet.mem name seen with 157 | | false -> name 158 | | true -> make_uniq seen (name ^ "'") 159 | in 160 | List.fold_left ~init:(name_map, seen) ~f:( 161 | fun (map, seen) (proto_name, ocaml_name, _) -> 162 | let ocaml_name = make_uniq seen ocaml_name in 163 | StringMap.add ~key:proto_name ~data:ocaml_name map, 164 | StringSet.add ocaml_name seen 165 | ) expanded_names 166 | in 167 | name_map 168 | -------------------------------------------------------------------------------- /src/plugin/option.ml: -------------------------------------------------------------------------------- 1 | (* Mimic base Option type *) 2 | type 'a t = 'a option 3 | 4 | let value ~default = function 5 | | None -> default 6 | | Some v -> v 7 | 8 | let value_exn ?(message="Option is None") = function 9 | | None -> failwith message 10 | | Some v -> v 11 | 12 | let value_map ~default ~f = function 13 | | None -> default 14 | | Some v -> f v 15 | 16 | let map ~f = function 17 | | Some v -> Some (f v) 18 | | None -> None 19 | 20 | let iter ~f = function 21 | | Some v -> f v 22 | | None -> () 23 | 24 | let bind ~f = function 25 | | None -> None 26 | | Some v -> f v 27 | 28 | let some v = Some v 29 | 30 | let is_some = function 31 | | Some _ -> true 32 | | None -> false 33 | 34 | let is_none v = not (is_some v) 35 | 36 | let none = None 37 | -------------------------------------------------------------------------------- /src/plugin/parameters.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | 3 | type t = { 4 | annot: string; 5 | opens: string list; 6 | int64_as_int: bool; 7 | int32_as_int: bool; 8 | fixed_as_int: bool; 9 | debug: bool; 10 | singleton_record: bool; 11 | prefix_output_with_package: bool; 12 | singleton_oneof_as_option: bool; 13 | } 14 | 15 | let default = { 16 | annot = ""; 17 | opens = []; 18 | int64_as_int = true; 19 | int32_as_int = true; 20 | fixed_as_int = false; 21 | debug = false; 22 | singleton_record = false; 23 | prefix_output_with_package = false; 24 | singleton_oneof_as_option = true; 25 | } 26 | 27 | let parse_option str = 28 | match String.index str '=' with 29 | | n -> `Expr (String.sub str ~pos:0 ~len:n, String.sub str ~pos:(n + 1) ~len:(String.length str - n - 1)) 30 | | exception Not_found -> `Stmt str 31 | 32 | let parse parameters = 33 | String.split_on_char ~sep:';' parameters 34 | |> List.fold_left ~init:default ~f:(fun param option -> 35 | match parse_option option with 36 | | `Expr ("annot", annot) -> { param with annot } 37 | | `Expr ("open", open') -> { param with opens = param.opens @ [open'] } 38 | | `Stmt "use_int32" -> { param with int32_as_int = false } 39 | | `Stmt "use_int64" -> { param with int64_as_int = false } 40 | | `Expr ("fixed_as_int", (("true"|"false") as v)) -> { param with fixed_as_int = (bool_of_string v) }; 41 | | `Expr ("int64_as_int", (("true"|"false") as v)) -> { param with int64_as_int = (bool_of_string v) }; 42 | | `Expr ("int32_as_int", (("true"|"false") as v)) -> { param with int32_as_int = (bool_of_string v) }; 43 | | `Expr ("singleton_record", (("true"|"false") as v)) -> { param with singleton_record = (bool_of_string v) }; 44 | | `Stmt "debug" -> { param with debug = true} 45 | | `Expr ("prefix_output_with_package", (("true"|"false") as v)) -> { param with prefix_output_with_package = (bool_of_string v)} 46 | | `Expr ("singleton_oneof_as_option", (("true"|"false") as v)) -> { param with singleton_oneof_as_option = (bool_of_string v)} 47 | | `Stmt "" -> param 48 | | _ -> failwith ("Unknown parameter: " ^ option) 49 | ) 50 | 51 | let use_snakecase options = 52 | Option.bind ~f:(fun option -> 53 | Spec.Options.Ocaml_options.get option 54 | |> Ocaml_protoc_plugin.Result.get ~msg:"Could not parse ocaml options" 55 | ) options 56 | |> Option.value ~default:false 57 | -------------------------------------------------------------------------------- /src/plugin/protoc_gen_ocaml.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | module Descriptor = Spec.Descriptor.Google.Protobuf 3 | module Plugin = Spec.Plugin.Google.Protobuf.Compiler 4 | 5 | let read_all in_channel = 6 | let rec inner buffer = 7 | let b = Bytes.create 1024 in 8 | match input in_channel b 0 1024 with 9 | | 1024 -> 10 | Buffer.add_bytes buffer b; 11 | inner buffer 12 | | read -> 13 | Buffer.add_subbytes buffer b 0 read; 14 | Buffer.contents buffer 15 | in 16 | inner (Buffer.create 1024) 17 | 18 | (* Read from stdin *) 19 | let read () = 20 | read_all stdin 21 | |> Ocaml_protoc_plugin.Reader.create 22 | |> Plugin.CodeGeneratorRequest.from_proto_exn 23 | 24 | (* Write to stdout *) 25 | let write response = 26 | Plugin.CodeGeneratorResponse.to_proto response 27 | |> Ocaml_protoc_plugin.Writer.contents 28 | |> output_string stdout 29 | 30 | 31 | let parse_request Plugin.CodeGeneratorRequest.{file_to_generate = files_to_generate; parameter = parameters; proto_file = proto_files; compiler_version = _} = 32 | let params = Parameters.parse (Option.value ~default:"" parameters) in 33 | let target_proto_files = List.filter ~f:(fun Descriptor.FileDescriptorProto.{name; _} -> 34 | List.mem ~set:files_to_generate (Option.value_exn name) 35 | ) proto_files 36 | in 37 | let type_db = Type_db.init ~params proto_files in 38 | 39 | let result = 40 | List.map ~f:(fun (proto_file : Descriptor.FileDescriptorProto.t) -> 41 | let proto_file_name = Option.value_exn ~message:"All files must have a name" proto_file.name in 42 | let scope = Scope.init ~module_name:(Type_db.get_module_name type_db proto_file_name) in 43 | Emit.parse_proto_file ~params ~scope ~type_db proto_file 44 | ) target_proto_files 45 | |> List.map ~f:(fun (name, code) -> 46 | (name, code) 47 | ) 48 | in 49 | (match params.debug with 50 | | true -> List.iter ~f:(fun (_, code) -> Printf.eprintf "%s\n%!" (Code.contents code)) result 51 | | false -> ()); 52 | result 53 | 54 | let () = 55 | let request = read () in 56 | try 57 | let outputs = parse_request request in 58 | let response_of_output (name, code) = 59 | Plugin.CodeGeneratorResponse.File.make ~name ~content:(Code.contents code) () 60 | in 61 | let response : Plugin.CodeGeneratorResponse.t = 62 | Plugin.CodeGeneratorResponse.make ~supported_features:1 ~file:(List.map ~f:response_of_output outputs) () 63 | in 64 | write response 65 | with 66 | | Failure message -> (Printf.eprintf "%s\n" message; exit 1) 67 | -------------------------------------------------------------------------------- /src/plugin/scope.ml: -------------------------------------------------------------------------------- 1 | open !StdLabels 2 | open !MoreLabels 3 | open !Utils 4 | 5 | let import_module_name = "Imported'modules" 6 | let this_module_alias = "This'_" 7 | 8 | type t = { module_name: string; 9 | proto_path: string list; 10 | } 11 | 12 | let init ~module_name = 13 | { module_name; proto_path = []; } 14 | 15 | let get_proto_path ?name t = 16 | let proto_path = match name with 17 | | Some name -> name :: t.proto_path 18 | | None -> t.proto_path 19 | in 20 | "" :: (List.rev proto_path) |> String.concat ~sep:"." 21 | 22 | let push: t -> string -> t = fun t name -> { t with proto_path = name :: t.proto_path } 23 | 24 | (** Change to work over proto_names. We can then map back once we know how to reference 25 | (As we know the target name) 26 | *) 27 | let get_scoped_name_type_db ?postfix t type_db proto_path = 28 | (* Take the first n elements from the list *) 29 | let take n l = 30 | let rec inner = function 31 | | (0, _) -> [] 32 | | (_, []) -> [] 33 | | (n, x :: xs) -> x :: inner (n - 1, xs) 34 | in 35 | inner (n, l) 36 | in 37 | 38 | let proto_path = Option.value_exn ~message:"No name given" proto_path in 39 | let ocaml_path = Type_db.get_ocaml_path type_db proto_path in 40 | let module_name = Type_db.get_location type_db proto_path in 41 | 42 | (* given a relative path, return the proto_path that it resolves to in the given scope *) 43 | let rec resolve path_rev scope = 44 | let path = "" :: List.rev_append path_rev scope |> String.concat ~sep:"." in 45 | match Type_db.exists type_db path, path_rev with 46 | | true, _ -> Some path 47 | | false, [] -> None 48 | | false, _ :: ps -> resolve ps scope 49 | in 50 | (* Find the relative name for the given proto_path is possible *) 51 | let search proto_type = 52 | let paths = String.split_on_char ~sep:'.' proto_type |> List.rev in 53 | let rec inner path paths = 54 | let p = resolve t.proto_path path in 55 | match p, paths with 56 | | Some path', _ when path' = proto_path -> 57 | (* Found. Return the Ocaml name for the relative path *) 58 | String.split_on_char ~sep:'.' ocaml_path 59 | |> List.rev 60 | |> take (List.length path) 61 | |> List.rev 62 | |> String.concat ~sep:"." 63 | |> Option.some 64 | | _, p :: paths -> inner (p :: path) paths 65 | | _, [] -> None 66 | in 67 | inner [] paths 68 | in 69 | let type_name = 70 | match t.module_name = module_name with 71 | | true -> search proto_path 72 | | false -> Printf.sprintf "%s.%s.%s" import_module_name module_name ocaml_path |> Option.some 73 | in 74 | match postfix, type_name with 75 | | Some postfix, Some "" -> postfix 76 | | None, Some "" -> this_module_alias 77 | | None, Some type_name -> type_name 78 | | Some postfix, Some type_name -> Printf.sprintf "%s.%s" type_name postfix 79 | | _, None -> failwith_f "Unable to reference '%s'. This is due to a limitation in the Ocaml mappings. To work around this limitation make sure to use a unique package name" proto_path 80 | -------------------------------------------------------------------------------- /src/plugin/scope.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | (** Create a new scope. I think this is never used, and should take a module name *) 4 | val init : module_name:string -> t 5 | 6 | (** Push an identifier to the current scope *) 7 | val push : t -> string -> t 8 | 9 | (** The import module name - Must be globally unique *) 10 | val import_module_name: string 11 | 12 | (** Name of current scope module alias *) 13 | val this_module_alias: string 14 | 15 | (** Get the ocaml name of the given proto type name, based on the current scope *) 16 | val get_scoped_name_type_db: ?postfix:string -> t -> Type_db.t -> string option -> string 17 | 18 | (** Get stringified version of the current proto path *) 19 | val get_proto_path: ?name:string -> t -> string 20 | -------------------------------------------------------------------------------- /src/plugin/utils.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | open MoreLabels 3 | 4 | let failwith_f fmt = 5 | Printf.ksprintf (fun s -> failwith s) fmt 6 | 7 | module String = struct 8 | include String 9 | 10 | let starts_with ~prefix s = 11 | let regex = Str.regexp ("^" ^ Str.quote prefix) in 12 | Str.string_match regex s 0 13 | 14 | let trim_end ~chars s = 15 | let chars = to_seq chars |> List.of_seq in 16 | let len = length s in 17 | let rcount s = 18 | let rec inner = function 19 | | 0 -> len 20 | | n when List.mem s.[n - 1] ~set:chars -> inner (n - 1) 21 | | n -> len - n 22 | in 23 | inner len 24 | in 25 | match rcount s with 26 | | 0 -> s 27 | | n -> sub ~pos:0 ~len:(length s - n) s 28 | 29 | let starts_with_regex ~regex str = 30 | let regex = Str.regexp ("^" ^ regex) in 31 | Str.string_match regex str 0 32 | 33 | let replace ~substring ~f = 34 | let regexp = Str.regexp (Str.quote substring) in 35 | Str.global_substitute regexp f 36 | 37 | end 38 | 39 | module List = struct 40 | include List 41 | let rec drop_while ~f = function 42 | | x :: xs when f x -> drop_while ~f xs 43 | | xs -> xs 44 | 45 | let is_empty = function 46 | | [] -> true 47 | | _ -> false 48 | 49 | let group ~f lines = 50 | let prepend acc group last = 51 | let acc = match is_empty group with 52 | | true -> acc 53 | | false -> (last, rev group) :: acc 54 | in 55 | acc 56 | in 57 | let rec inner acc group last = function 58 | | x :: xs when f x = last || x = "" -> 59 | inner acc (x :: group) last xs 60 | | x :: xs -> 61 | inner (prepend acc group last) [x] (not last) xs 62 | | [] -> rev (prepend acc group last) 63 | in 64 | inner [] [] false lines 65 | 66 | let filteri ~f lst = 67 | let rec inner i = function 68 | | [] -> [] 69 | | x :: xs when f i x -> x :: inner (i+1) xs 70 | | _ :: xs -> inner (i+1) xs 71 | in 72 | inner 0 lst 73 | 74 | let rec find_map ~f = function 75 | | [] -> None 76 | | x :: xs -> match f x with Some _ as v -> v | None -> find_map ~f xs 77 | end 78 | 79 | module StringMap = struct 80 | include Map.Make(String) 81 | 82 | (** Fail with an error if the key already exists *) 83 | let add_uniq ~key ~data map = 84 | update ~key ~f:(function 85 | | None -> Some data 86 | | Some _ -> failwith_f "Key %s already exists" key 87 | ) map 88 | end 89 | module StringSet = Set.Make(String) 90 | 91 | module IntSet = Set.Make(Int) 92 | -------------------------------------------------------------------------------- /src/spec/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name spec) 3 | (libraries ocaml_protoc_plugin) 4 | ) 5 | -------------------------------------------------------------------------------- /src/spec/options.ml: -------------------------------------------------------------------------------- 1 | (********************************************************) 2 | (* AUTOGENERATED FILE - DO NOT EDIT! *) 3 | (********************************************************) 4 | (* Generated by: ocaml-protoc-plugin *) 5 | (* https://github.com/andersfugmann/ocaml-protoc-plugin *) 6 | (********************************************************) 7 | (* 8 | Source: options.proto 9 | Syntax: proto3 10 | Parameters: 11 | debug=false 12 | annot='' 13 | opens=[] 14 | int64_as_int=true 15 | int32_as_int=true 16 | fixed_as_int=false 17 | singleton_record=false 18 | prefix_output_with_package=false 19 | *) 20 | [@@@ocaml.alert "-protobuf"] (* Disable deprecation warnings for protobuf*) 21 | (**/**) 22 | module Runtime' = Ocaml_protoc_plugin [@@warning "-33"] 23 | module Imported'modules = struct 24 | module Descriptor = Descriptor 25 | end 26 | (**/**) 27 | module rec Options : sig 28 | type t = (bool) 29 | val make: ?mangle_names:bool -> unit -> t 30 | (** Helper function to generate a message using default values *) 31 | 32 | val to_proto: t -> Runtime'.Writer.t 33 | (** Serialize the message to binary format *) 34 | 35 | val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result 36 | (** Deserialize from binary format *) 37 | 38 | val to_json: Runtime'.Json_options.t -> t -> Runtime'.Json.t 39 | (** Serialize to Json (compatible with Yojson.Basic.t) *) 40 | 41 | val from_json: Runtime'.Json.t -> (t, [> Runtime'.Result.error]) result 42 | (** Deserialize from Json (compatible with Yojson.Basic.t) *) 43 | 44 | val name: unit -> string 45 | (** Fully qualified protobuf name of this message *) 46 | 47 | (**/**) 48 | type make_t = ?mangle_names:bool -> unit -> t 49 | val merge: t -> t -> t 50 | val to_proto': Runtime'.Writer.t -> t -> unit 51 | val from_proto_exn: Runtime'.Reader.t -> t 52 | val from_json_exn: Runtime'.Json.t -> t 53 | (**/**) 54 | end = struct 55 | module This'_ = Options 56 | let name () = ".Options" 57 | type t = (bool) 58 | type make_t = ?mangle_names:bool -> unit -> t 59 | let make ?(mangle_names = false) () = (mangle_names) 60 | let merge = 61 | let merge_mangle_names = Runtime'.Merge.merge Runtime'.Spec.( basic ((1, "mangle_names", "mangleNames"), bool, (false)) ) in 62 | fun (t1_mangle_names) (t2_mangle_names) -> merge_mangle_names t1_mangle_names t2_mangle_names 63 | let spec () = Runtime'.Spec.( basic ((1, "mangle_names", "mangleNames"), bool, (false)) ^:: nil ) 64 | let to_proto' = 65 | let serialize = Runtime'.apply_lazy (fun () -> Runtime'.Serialize.serialize (spec ())) in 66 | fun writer (mangle_names) -> serialize writer mangle_names 67 | 68 | let to_proto t = let writer = Runtime'.Writer.init () in to_proto' writer t; writer 69 | let from_proto_exn = 70 | let constructor mangle_names = (mangle_names) in 71 | Runtime'.apply_lazy (fun () -> Runtime'.Deserialize.deserialize (spec ()) constructor) 72 | let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) 73 | let to_json options = 74 | let serialize = Runtime'.Serialize_json.serialize ~message_name:(name ()) (spec ()) options in 75 | fun (mangle_names) -> serialize mangle_names 76 | let from_json_exn = 77 | let constructor mangle_names = (mangle_names) in 78 | Runtime'.apply_lazy (fun () -> Runtime'.Deserialize_json.deserialize ~message_name:(name ()) (spec ()) constructor) 79 | let from_json json = Runtime'.Result.catch (fun () -> from_json_exn json) 80 | end 81 | 82 | and Ocaml_options : sig 83 | type t = Options.t option 84 | val get_exn: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option 85 | val get: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> (Options.t option, [> Runtime'.Result.error]) result 86 | val set: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option -> Imported'modules.Descriptor.Google.Protobuf.FileOptions.t 87 | end = struct 88 | module This'_ = Ocaml_options 89 | module This = Ocaml_options 90 | type t = Options.t option 91 | let get_exn extendee = Runtime'.Extensions.get Runtime'.Spec.(basic_opt ((1074, "ocaml_options", "ocamlOptions"), (message (module Options)))) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') 92 | let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee) 93 | let set extendee t = 94 | let extensions' = Runtime'.Extensions.set Runtime'.Spec.(basic_opt ((1074, "ocaml_options", "ocamlOptions"), (message (module Options)))) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in 95 | { extendee with Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions' = extensions' } [@@warning "-23"] 96 | 97 | end 98 | 99 | 100 | -------------------------------------------------------------------------------- /src/spec/options.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "google/protobuf/descriptor.proto"; 4 | message Options { 5 | bool mangle_names = 1; 6 | } 7 | 8 | extend google.protobuf.FileOptions { 9 | Options ocaml_options = 1074; 10 | } 11 | -------------------------------------------------------------------------------- /test/basic.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package protoc.plugin.test; 4 | 5 | message Message { 6 | int32 payload = 1; 7 | } 8 | -------------------------------------------------------------------------------- /test/basic_test_module_name.ml: -------------------------------------------------------------------------------- 1 | module M = Protoc_plugin_test_basic 2 | -------------------------------------------------------------------------------- /test/comments.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | 4 | // This is my package 5 | package Comments; 6 | 7 | // This is a message with a single regular field 8 | message SingleRegularField { 9 | 10 | // This is field SingleRegularField.a 11 | uint32 a = 1; 12 | 13 | } 14 | // This is a message with regular multiplefields 15 | message MultipleRegularFields { 16 | 17 | // This is field MultipleRegularFields.a 18 | uint32 a = 1; 19 | 20 | // This is field MultipleRegularFields.b 21 | uint32 b = 2; 22 | 23 | // This is field MultipleRegularFields.c 24 | uint32 c = 3; 25 | } 26 | 27 | // This is a message with a single oneof field 28 | message SingleOneofField { 29 | 30 | // This is SingleOneofField.oneof_field 31 | oneof oneof_field { 32 | 33 | // This is field SingleOneofField.oa 34 | uint32 oa = 10; 35 | 36 | // This is field SingleOneofField.ob 37 | uint32 ob = 20; 38 | 39 | // This is field SingleOneofField.oc 40 | uint32 oc = 30; 41 | } 42 | } 43 | 44 | // This is a message with multiple fields and a oneof field 45 | message MultipleWithOneofField { 46 | 47 | // This is field MultipleWithOneofField.a 48 | uint32 a = 1; 49 | 50 | // This is field MultipleWithOneofField.b 51 | uint32 b = 2; 52 | 53 | // This is field MultipleWithOneofField.c 54 | uint32 c = 3; 55 | 56 | // This is MultipleWithOneofField.oneof_field 57 | oneof oneof_field { 58 | 59 | // This is field MultipleWithOneofField.oa 60 | uint32 oa = 10; 61 | 62 | // This is field MultipleWithOneofField.ob 63 | uint32 ob = 20; 64 | 65 | // This is field MultipleWithOneofField.oc 66 | uint32 oc = 30; 67 | } 68 | } 69 | 70 | // This is a message with a single map field 71 | message SingleMapField { 72 | 73 | // This is map field SingleMapField.m 74 | map m = 1; 75 | } 76 | 77 | // This is message MultipleWithSingletonOneofField 78 | message MultipleWithSingletonOneofField { 79 | // This is field MultipleWithSingletonOneofField.a 80 | uint32 a = 1; 81 | 82 | // This is singleton MultipleWithSingletonOneofField.oneof_field 83 | oneof oneof_field { 84 | 85 | // This is field MultipleWithSingletonOneofField.oa 86 | uint32 oa = 10; 87 | } 88 | } 89 | -------------------------------------------------------------------------------- /test/config/discover.ml: -------------------------------------------------------------------------------- 1 | module C = Configurator.V1 2 | 3 | let () = 4 | C.main ~name:"foo" (fun c -> 5 | let default : C.Pkg_config.package_conf = 6 | { libs = ["-lprotobuf"] 7 | ; cflags = [] 8 | } 9 | in 10 | let conf = 11 | match C.Pkg_config.get c with 12 | | None -> default 13 | | Some pc -> 14 | match (C.Pkg_config.query pc ~package:"protobuf") with 15 | | None -> default 16 | | Some deps -> deps 17 | in 18 | 19 | 20 | C.Flags.write_sexp "c_flags.sexp" conf.cflags; 21 | C.Flags.write_sexp "c_library_flags.sexp" conf.libs) 22 | -------------------------------------------------------------------------------- /test/config/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name discover) 3 | (libraries dune-configurator)) 4 | -------------------------------------------------------------------------------- /test/deprecated.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | option deprecated = true; // Deprecated file. 3 | message Message1 { 4 | option deprecated = true; // Deprecated message 5 | int32 a = 1; // Deprecated field 6 | } 7 | 8 | message Message2 { 9 | int32 a = 1 [deprecated = true]; // Deprecated field 10 | } 11 | 12 | message Message3 { 13 | int32 a = 1 [deprecated = true]; // Deprecated field 14 | int32 b = 2; 15 | 16 | oneof c { 17 | int64 x = 10[deprecated = true]; 18 | string y = 20; 19 | } 20 | } 21 | 22 | 23 | enum E1 { 24 | option deprecated = true; // Deprecated enum 25 | e1 = 0; // Deprecated enum value 26 | } 27 | 28 | enum E2 { 29 | e2 = 0 [deprecated = true]; // Deprecated enum value 30 | e3 = 1; 31 | } 32 | 33 | 34 | service Service1 { 35 | option deprecated = true; // Deprecated service 36 | rpc Method1(Message2) returns (Message2); 37 | } 38 | 39 | service Service2 { 40 | rpc Method1(Message2) returns (Message2) { option deprecated = true; }; // Deprecated method 41 | rpc Method2(Message2) returns (Message2); 42 | } 43 | -------------------------------------------------------------------------------- /test/deprecated_test.ml: -------------------------------------------------------------------------------- 1 | open Deprecated 2 | [@@@ocaml.alert "-protobuf"] (* Disable deprecation warnings for protobuf*) 3 | [@@@warning "-32"] 4 | 5 | module T1 = Message1 (* Message deprecated *) 6 | module T2 = Message2 7 | type _t1 = Message1.t (* Message deprecated *) 8 | type _t2 = Message2.t (* Field deprecated *) 9 | 10 | 11 | module E1' = E1 (* Enum deprecated *) 12 | let _ = E1.E1 (* Enum deprecated *) 13 | let _ = E2.E2 (* Enum value deprecated *) 14 | let _ = E2.E3 15 | 16 | let _ : Message2.t = 4 (* Field deprecated *) 17 | 18 | let _ = Message3.{ a = 4; (* Field Deprecated *) 19 | b = 5; 20 | c = `X 5} 21 | 22 | let _ = Service1.Method1.name (* Service deprecated *) 23 | let _ = Service2.Method1.name (* Method deprecated *) 24 | let _ = Service2.Method2.name 25 | let _ = Service1.method1 (* Service deprecated *) 26 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets google_include) 3 | (action (with-stdout-to %{targets} 4 | (run pkg-config protobuf --variable=includedir)))) 5 | 6 | ;; Determine if the compiler supports the --experimental_allow_proto3_optional flag. 7 | ;; The output file will be non-empty if the flag is supported 8 | (subdir config 9 | (rule 10 | (target support_proto3_optional.conf) 11 | (action (with-accepted-exit-codes (or 0 1) (ignore-stderr (with-stdout-to %{target} (run protoc --experimental_allow_proto3_optional --version))))))) 12 | 13 | (rule 14 | (enabled_if (<> %{read:config/support_proto3_optional.conf} "")) 15 | (action (copy proto3_optional_test_opt.ml proto3_optional_test.ml))) 16 | 17 | ;; Create an empty test file if proto3 optional fields is not supported by the system's protoc compiler 18 | (rule 19 | (target proto3_optional_test.ml) 20 | (enabled_if (= %{read:config/support_proto3_optional.conf} "")) 21 | (action (with-stdout-to %{target} (echo "")))) 22 | 23 | ;; exclude proto3_optional_test.ml based on the support 24 | (library 25 | (name test) 26 | (enabled_if (and (<> %{architecture} x86_32) (<> %{architecture} arm32))) 27 | (libraries ocaml_protoc_plugin google_types_pp yojson) 28 | (inline_tests 29 | (deps 30 | google_include 31 | (glob_files *.proto) 32 | )) 33 | (modules :standard \ proto3_optional_test_opt) 34 | (preprocess (pps ppx_expect ppx_deriving.show ppx_deriving.eq)) 35 | (foreign_stubs 36 | (language cxx) 37 | (names protobuf2json) 38 | (flags (:standard (:include c_flags.sexp)))) 39 | (c_library_flags (:standard (:include c_library_flags.sexp))) 40 | ) 41 | 42 | (rule 43 | (targets c_flags.sexp c_library_flags.sexp) 44 | (action (run ./config/discover.exe))) 45 | 46 | (rule 47 | (targets 48 | basic.ml primitive_types.ml int_types.ml repeated.ml enum.ml empty_message.ml 49 | message.ml oneof.ml merge.ml map.ml package.ml include.ml included.ml large.ml 50 | included2.ml included3_dash.ml service.ml recursive.ml recursive2.ml protocol.ml name_clash.ml 51 | name_clash_mangle.ml proto2.ml packed.ml mangle_names.ml extensions.ml 52 | options.ml name_clash2.ml empty.ml service_rpc_clash.ml service_empty_package.ml 53 | deprecated.ml json_encoding.ml comments.ml) 54 | (deps 55 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 56 | (:proto 57 | basic.proto primitive_types.proto int_types.proto repeated.proto enum.proto empty_message.proto 58 | message.proto oneof.proto merge.proto map.proto package.proto large.proto 59 | include.proto included.proto included2.proto included3-dash.proto service.proto 60 | recursive.proto recursive2.proto protocol.proto name_clash.proto name_clash_mangle.proto 61 | proto2.proto packed.proto mangle_names.proto extensions.proto options.proto 62 | name_clash2.proto empty.proto service_rpc_clash.proto service_empty_package.proto 63 | deprecated.proto json_encoding.proto comments.proto) 64 | ) 65 | (action 66 | (run protoc -I %{read-lines:google_include} -I . 67 | "--plugin=protoc-gen-ocaml=%{plugin}" 68 | "--ocaml_out=open=Google_types_pp;open=Test_runtime;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 69 | 70 | (rule 71 | (targets 72 | protoc_plugin_test_basic.ml 73 | include_include.ml 74 | enum_test_enum.ml 75 | package_a_b_package.ml 76 | include_included.ml 77 | include_included3_dash.ml 78 | ) 79 | (deps 80 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 81 | (:proto 82 | basic.proto 83 | include.proto 84 | enum.proto 85 | package.proto 86 | included.proto 87 | included3-dash.proto 88 | ) 89 | ) 90 | (action 91 | (run protoc -I %{read-lines:google_include} -I . 92 | "--plugin=protoc-gen-ocaml=%{plugin}" 93 | "--ocaml_out=open=Google_types_pp;open=Test_runtime;prefix_output_with_package=true;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 94 | 95 | (rule 96 | (targets 97 | test_include_a_message.ml 98 | test_include_b_message.ml 99 | ) 100 | (deps 101 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 102 | (:proto 103 | test_include_a/message.proto 104 | test_include_b/message.proto 105 | ) 106 | ) 107 | (action 108 | (run protoc -I %{read-lines:google_include} -I . 109 | "--plugin=protoc-gen-ocaml=%{plugin}" 110 | "--ocaml_out=open=Google_types_pp;open=Test_runtime;prefix_output_with_package=true;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 111 | 112 | (rule 113 | (targets int_types_native.ml int_types_native_proto2.ml) 114 | (deps 115 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 116 | (:proto int_types_native.proto int_types_native_proto2.proto)) 117 | (action 118 | (run protoc -I %{read-lines:google_include} -I . 119 | "--plugin=protoc-gen-ocaml=%{plugin}" 120 | "--ocaml_out=open=Google_types_pp;open=Test_runtime;int32_as_int=false;int64_as_int=false;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 121 | 122 | (rule 123 | (targets singleton_record.ml oneof2.ml) 124 | (deps 125 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 126 | (:proto singleton_record.proto oneof2.proto)) 127 | (action 128 | (run protoc -I %{read-lines:google_include} -I . 129 | "--plugin=protoc-gen-ocaml=%{plugin}" 130 | "--ocaml_out=open=Google_types_pp;open=Test_runtime;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 131 | 132 | (rule 133 | (enabled_if (<> %{read:config/support_proto3_optional.conf} "")) 134 | (target proto3_optional.ml) 135 | (deps 136 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 137 | (:proto proto3_optional.proto) 138 | ) 139 | (action 140 | (run protoc -I %{read-lines:google_include} -I . 141 | "--experimental_allow_proto3_optional" 142 | "--plugin=protoc-gen-ocaml=%{plugin}" 143 | "--ocaml_out=open=Google_types_pp;open=Test_runtime;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 144 | -------------------------------------------------------------------------------- /test/empty.proto: -------------------------------------------------------------------------------- 1 | // Test that code for an empty protofile will compile 2 | syntax = "proto3"; 3 | -------------------------------------------------------------------------------- /test/empty_message.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message Empty { } 4 | 5 | service MyService { 6 | rpc CreateEntity (CreateEntityRequest) returns (CreateEntityResponse) {}; 7 | } 8 | 9 | message CreateEntityRequest { 10 | CreateEntity entity = 1; 11 | 12 | message CreateEntity { 13 | string name = 1; 14 | } 15 | } 16 | 17 | message CreateEntityResponse { } 18 | -------------------------------------------------------------------------------- /test/empty_message_test.ml: -------------------------------------------------------------------------------- 1 | let proto_file = "empty_message.proto" 2 | let%expect_test _ = 3 | let module T = Empty_message.Empty in 4 | let validate = T.make () in 5 | let t = () in 6 | Test_lib.test_encode (module T) ~proto_file ~validate t; 7 | [%expect {| |}] 8 | -------------------------------------------------------------------------------- /test/enum.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package enum_test; 4 | 5 | 6 | message Message { 7 | enum E { 8 | A = 0; 9 | B = 1; 10 | C = 2; 11 | } 12 | E enum = 1; 13 | } 14 | 15 | 16 | enum E1 { 17 | A = 0; 18 | B = 1; 19 | C = 2; 20 | } 21 | 22 | message Outside { 23 | E1 enum = 1; 24 | } 25 | 26 | message Aliasing { 27 | enum Enum { 28 | option allow_alias = true; 29 | X = 0; 30 | Y = 1; 31 | Z = 1; 32 | } 33 | Enum e = 1; 34 | } 35 | 36 | message Negative { 37 | enum Enum { 38 | A1 = 0; 39 | A2 = -1; 40 | A3 = -2; 41 | A4 = -3; 42 | A5 = -4; 43 | A100 = -100; 44 | } 45 | Enum e = 1; 46 | } 47 | -------------------------------------------------------------------------------- /test/enum_test.ml: -------------------------------------------------------------------------------- 1 | module Enum = Enum.Enum_test 2 | 3 | let proto_file = "enum.proto" 4 | 5 | let%expect_test _ = 6 | let module T = Enum.Message in 7 | let t = Enum.Message.E.B in 8 | Test_lib.test_encode ~proto_file (module T) t; 9 | [%expect {| 10 | enum: B |}] 11 | 12 | let%expect_test _ = 13 | let module T = Enum.Outside in 14 | let t = Enum.E1.C in 15 | Test_lib.test_encode ~proto_file (module T) t; 16 | [%expect {| 17 | enum: C |}] 18 | 19 | let%expect_test _ = 20 | let module T = Enum.Aliasing in 21 | let t = T.Enum.Z in 22 | (* Due to aliasing, we expect this to be deserialized as 'Y'. *) 23 | Test_lib.test_encode ~proto_file (module T) ~expect:T.Enum.Y t; 24 | [%expect {| 25 | e: Y |}] 26 | 27 | let%expect_test _ = 28 | let module T = Enum.Negative in 29 | let t = T.Enum.A3 in 30 | Test_lib.test_encode ~skip_json:true ~proto_file (module T) t; 31 | [%expect {| 32 | e: A3 |}] 33 | -------------------------------------------------------------------------------- /test/extensions.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto2"; 2 | 3 | package extensions; 4 | 5 | message Foo { 6 | optional uint32 bar = 1; 7 | extensions 100 to 199; 8 | extensions 500 to max; 9 | } 10 | 11 | message Baz { 12 | optional uint32 a = 1; 13 | } 14 | 15 | extend Foo { 16 | optional uint32 baz = 128; 17 | repeated uint32 b2 = 129 [packed = true]; 18 | } 19 | 20 | 21 | extend Foo { 22 | repeated uint32 r_baz = 130; 23 | } 24 | 25 | extend Foo { 26 | optional uint32 a = 131; 27 | optional uint32 b = 132 [default = 13]; 28 | } 29 | 30 | message Bar { 31 | extensions 100 to 199; 32 | } 33 | 34 | extend Bar { 35 | optional uint32 z = 131; 36 | } 37 | 38 | // Test name clashes for extensions name. 39 | message extensions { 40 | required uint32 extensions = 1; 41 | required uint32 extensions_ = 2; 42 | required uint32 Extensions = 3; 43 | required uint32 Extensions_ = 4; 44 | extensions 100 to 199; // This should have reserved the name. 45 | } 46 | -------------------------------------------------------------------------------- /test/extensions_test.ml: -------------------------------------------------------------------------------- 1 | open Extensions 2 | 3 | let proto_file = "extensions.proto" 4 | 5 | let%expect_test _ = 6 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 7 | let foo = Extensions.Baz'.set foo (Some 7) in 8 | let baz = Extensions.Baz'.get foo in 9 | print_endline ([%show: Extensions.Baz.t Ocaml_protoc_plugin.Result.t] baz); 10 | let () = match baz = Ok (Some 7) with 11 | | false -> print_endline "Failed. Not equal" 12 | | true -> () 13 | in 14 | (); 15 | [%expect {| Ok (Some 7) |}] 16 | 17 | let%expect_test _ = 18 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 19 | let foo = Extensions.Baz'.set foo (Some 8) in 20 | let foo = Extensions.Baz'.set foo (Some 7) in 21 | Test_lib.test_encode ~proto_file ~skip_json:true (module Extensions.Foo) foo; 22 | let baz = Extensions.Baz'.get foo in 23 | print_endline ([%show: Extensions.Foo.t] foo); 24 | print_endline ([%show: Extensions.Baz.t Ocaml_protoc_plugin.Result.t] baz); 25 | let () = match baz = Ok (Some 7) with 26 | | false -> print_endline "Failed. Not equal" 27 | | true -> () 28 | in 29 | (); 30 | [%expect {| 31 | bar: 5 32 | [extensions.baz]: 7 33 | { bar = (Some 5); extensions' = (128, (Field.Varint 7L)) } 34 | Ok (Some 7) |}] 35 | 36 | let%expect_test _ = 37 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 38 | let foo = Extensions.Baz'.set foo (Some 8) in 39 | let foo = Extensions.Baz'.set foo (Some 0) in 40 | let foo = Extensions.B2.set foo ([6;7;8]) in 41 | let foo = Extensions.B2.set foo ([]) in 42 | Test_lib.test_encode ~proto_file ~skip_json:true (module Extensions.Foo) foo; 43 | 44 | print_endline ([%show: Extensions.Foo.t] foo); 45 | (); 46 | [%expect {| 47 | bar: 5 48 | [extensions.baz]: 0 49 | { bar = (Some 5); extensions' = (128, (Field.Varint 0L)) } |}] 50 | 51 | let%expect_test _ = 52 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 53 | let foo = Extensions.Baz'.set foo (Some 7) in 54 | Test_lib.test_encode ~proto_file ~skip_json:true (module Extensions.Foo) foo; 55 | 56 | let foo' = 57 | Extensions.Foo.to_proto foo 58 | |> Ocaml_protoc_plugin.Writer.contents 59 | |> Ocaml_protoc_plugin.Reader.create 60 | |> Extensions.Foo.from_proto 61 | |> Ocaml_protoc_plugin.Result.get ~msg:"Failed decoding" 62 | in 63 | let baz = Extensions.Baz'.get foo' in 64 | print_endline ([%show: Extensions.Baz.t Ocaml_protoc_plugin.Result.t] baz); 65 | let () = match baz = Ok (Some 7) with 66 | | false -> print_endline "Failed. Not equal" 67 | | true -> () 68 | in 69 | (); 70 | [%expect {| 71 | bar: 5 72 | [extensions.baz]: 7 73 | Ok (Some 7) |}] 74 | 75 | let%expect_test _ = 76 | let v = [6;7;8;9] in 77 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 78 | Test_lib.test_encode ~proto_file ~skip_json:true (module Extensions.Foo) foo; 79 | let foo = Extensions.R_baz.set foo v in 80 | let foo' = 81 | Extensions.Foo.to_proto foo 82 | |> Ocaml_protoc_plugin.Writer.contents 83 | |> Ocaml_protoc_plugin.Reader.create 84 | |> Extensions.Foo.from_proto 85 | |> Ocaml_protoc_plugin.Result.get ~msg:"Failed decoding" 86 | in 87 | let r_baz = Extensions.R_baz.get foo' in 88 | print_endline ([%show: Extensions.R_baz.t Ocaml_protoc_plugin.Result.t] r_baz); 89 | let () = match r_baz = Ok v with 90 | | false -> print_endline "Failed. Not equal" 91 | | true -> () 92 | in 93 | (); 94 | [%expect {| 95 | bar: 5 96 | Ok [6; 7; 8; 9] |}] 97 | 98 | let%expect_test _ = 99 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 100 | print_endline ([%show: Extensions.Foo.t] foo); 101 | 102 | let foo = Extensions.A.set foo (Some 7) in 103 | Printf.printf "Set A = Some 7\n"; 104 | print_endline ([%show: Extensions.Foo.t] foo); 105 | 106 | let foo = Extensions.A.set foo None in 107 | Printf.printf "Set A = None\n"; 108 | print_endline ([%show: Extensions.Foo.t] foo); 109 | 110 | let foo = Extensions.B.set foo 15 in 111 | Printf.printf "Set B = 15: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); 112 | print_endline ([%show: Extensions.Foo.t] foo); 113 | 114 | let foo = Extensions.B.set foo 13 in 115 | Printf.printf "Set B = 13: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); 116 | print_endline ([%show: Extensions.Foo.t] foo); 117 | 118 | let foo = Extensions.B.set foo 0 in 119 | Printf.printf "Set B = 0: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); 120 | Test_lib.test_encode ~proto_file ~skip_json:true (module Extensions.Foo) foo; 121 | print_endline ([%show: Extensions.Foo.t] foo); 122 | (); 123 | [%expect {| 124 | { bar = (Some 5); extensions' = } 125 | Set A = Some 7 126 | { bar = (Some 5); extensions' = (131, (Field.Varint 7L)) } 127 | Set A = None 128 | { bar = (Some 5); extensions' = } 129 | Set B = 15: 15 130 | { bar = (Some 5); extensions' = (132, (Field.Varint 15L)) } 131 | Set B = 13: 13 132 | { bar = (Some 5); extensions' = } 133 | Set B = 0: 0 134 | bar: 5 135 | [extensions.b]: 0 136 | { bar = (Some 5); extensions' = (132, (Field.Varint 0L)) } |}] 137 | -------------------------------------------------------------------------------- /test/google_types_pp/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name google_types_pp) 3 | (libraries ocaml_protoc_plugin) 4 | (preprocess 5 | (pps ppx_expect ppx_deriving.show ppx_deriving.eq)) 6 | 7 | (synopsis "Google well known types with pretty printing") 8 | ) 9 | 10 | (rule 11 | (targets any.ml api.ml descriptor.ml duration.ml empty.ml field_mask.ml 12 | source_context.ml struct.ml timestamp.ml type.ml wrappers.ml) 13 | (deps 14 | (:plugin ../../src/plugin/protoc_gen_ocaml.exe)) 15 | (action 16 | (run protoc -I %{read-lines:../google_include} -I . 17 | "--plugin=protoc-gen-ocaml=%{plugin}" 18 | "--ocaml_out=annot=[@@deriving show { with_path = false }, eq]:." 19 | 20 | %{read-lines:../google_include}/google/protobuf/any.proto 21 | %{read-lines:../google_include}/google/protobuf/api.proto 22 | %{read-lines:../google_include}/google/protobuf/descriptor.proto 23 | %{read-lines:../google_include}/google/protobuf/duration.proto 24 | %{read-lines:../google_include}/google/protobuf/empty.proto 25 | %{read-lines:../google_include}/google/protobuf/field_mask.proto 26 | %{read-lines:../google_include}/google/protobuf/source_context.proto 27 | %{read-lines:../google_include}/google/protobuf/struct.proto 28 | %{read-lines:../google_include}/google/protobuf/timestamp.proto 29 | %{read-lines:../google_include}/google/protobuf/type.proto 30 | %{read-lines:../google_include}/google/protobuf/wrappers.proto 31 | ))) 32 | -------------------------------------------------------------------------------- /test/include.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package include; 4 | 5 | import public "enum.proto"; 6 | import public "package.proto"; 7 | import public "included.proto"; 8 | import public "included3-dash.proto"; 9 | 10 | message I { 11 | enum_test.Message.E enum = 1; 12 | package.a.b.M m = 2; 13 | enum_test.Outside o = 3; 14 | X.Inner c = 4; 15 | } 16 | 17 | message X { 18 | message Inner { 19 | uint64 i = 1; 20 | } 21 | } 22 | 23 | message Z { 24 | N n = 1; 25 | } 26 | 27 | message Y { 28 | D d = 1; 29 | } 30 | -------------------------------------------------------------------------------- /test/include_test.ml: -------------------------------------------------------------------------------- 1 | open Include 2 | module Enum = Enum.Enum_test 3 | 4 | let proto_file = "include.proto" 5 | let test_encode = Test_lib.test_encode ~proto_file ~skip_json:true 6 | 7 | let%expect_test _ = 8 | let module T = Include.I in 9 | let t = T.{ enum = Enum.Message.E.B; 10 | m = Some 3; 11 | o = Some Enum.E1.C; 12 | c = Some 7; 13 | } in 14 | test_encode (module T) t; 15 | [%expect {| 16 | enum: B 17 | m { 18 | i: 3 19 | } 20 | o { 21 | enum: C 22 | } 23 | c { 24 | i: 7 25 | } |}] 26 | 27 | 28 | let%expect_test _ = 29 | let module T = Include.Z in 30 | let t = Some Included.Include.N.E.B in 31 | test_encode (module T) t; 32 | [%expect {| 33 | n { 34 | e: B 35 | } |}] 36 | 37 | let%expect_test _ = 38 | let module T = Include.Y in 39 | let t = Some 42 in 40 | test_encode (module T) t; 41 | [%expect {| 42 | d { 43 | i: 42 44 | } |}] 45 | -------------------------------------------------------------------------------- /test/included.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package include; 4 | 5 | message N { 6 | enum E { 7 | A = 0; 8 | B = 1; 9 | C = 2; 10 | } 11 | E e = 1; 12 | } 13 | -------------------------------------------------------------------------------- /test/included2.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package included2; 4 | 5 | message O { 6 | uint64 i = 1; 7 | } 8 | -------------------------------------------------------------------------------- /test/included3-dash.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package include; 4 | 5 | message D { 6 | uint64 i = 1; 7 | } 8 | -------------------------------------------------------------------------------- /test/int_types.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package int_types; 4 | 5 | message SInt64 { 6 | sint64 i = 1; 7 | } 8 | 9 | message SInt32 { 10 | sint32 i = 1; 11 | } 12 | 13 | message UInt64 { 14 | uint64 i = 1; 15 | } 16 | 17 | message UInt32 { 18 | uint32 i = 1; 19 | } 20 | 21 | message Int64 { 22 | int64 i = 1; 23 | } 24 | 25 | message Int32 { 26 | int32 i = 1; 27 | } 28 | -------------------------------------------------------------------------------- /test/int_types_native.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package int_types_native; 4 | 5 | message SInt64 { 6 | sint64 i = 1; 7 | } 8 | 9 | message SInt32 { 10 | sint32 i = 1; 11 | } 12 | 13 | message UInt64 { 14 | uint64 i = 1; 15 | } 16 | 17 | message UInt32 { 18 | uint32 i = 1; 19 | } 20 | 21 | message Int64 { 22 | int64 i = 1; 23 | } 24 | 25 | message Int32 { 26 | int32 i = 1; 27 | } 28 | -------------------------------------------------------------------------------- /test/int_types_native_proto2.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto2"; 2 | 3 | package int_types_native_proto2; 4 | 5 | message SInt64 { 6 | required sint64 i = 1; 7 | optional sint64 j = 2 [default = 4]; 8 | } 9 | 10 | message SInt32 { 11 | required sint32 i = 1; 12 | optional sint32 j = 2 [default = 4]; 13 | } 14 | 15 | message UInt64 { 16 | required uint64 i = 1; 17 | optional uint64 j = 2 [default = 4]; 18 | } 19 | 20 | message UInt32 { 21 | required uint32 i = 1; 22 | optional uint32 j = 2 [default = 4]; 23 | } 24 | 25 | message Int64 { 26 | required int64 i = 1; 27 | optional int64 j = 2 [default = 4]; 28 | } 29 | 30 | message Int32 { 31 | required int32 i = 1; 32 | optional int32 j = 2 [default = 4]; 33 | } 34 | -------------------------------------------------------------------------------- /test/int_types_native_test.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | open Int_types_native 3 | 4 | let proto_file = "int_types_native.proto" 5 | 6 | let test_signed64 (type t) ~(create : Int64.t -> t) (module T : Test_lib.T with type t = t) = 7 | Printf.printf "Test %s\n%!" (T.name ()); 8 | let values = [-1073741823L; -2L; -1L; 0L; 1L; 2L; 1073741823L] in 9 | List.iter 10 | ~f:(fun v -> Test_lib.test_encode ~proto_file (module T) (create v)) 11 | values 12 | 13 | let test_unsigned64 (type t) ~(create : Int64.t -> t) (module T : Test_lib.T with type t = t) = 14 | Printf.printf "Test %s\n%!" (T.name ()); 15 | let values = [0L; 1L; 2L; 2147483647L] in 16 | List.iter 17 | ~f:(fun v -> Test_lib.test_encode ~proto_file (module T) (create v)) 18 | values 19 | 20 | let test_signed32 (type t) ~(create : Int32.t -> t) (module T : Test_lib.T with type t = t) = 21 | Printf.printf "Test %s\n%!" (T.name ()); 22 | let values = [-1073741823l; -2l; -1l; 0l; 1l; 2l; 1073741823l] in 23 | List.iter 24 | ~f:(fun v -> Test_lib.test_encode ~proto_file (module T) (create v)) 25 | values 26 | 27 | let test_unsigned32 (type t) ~(create : Int32.t -> t) (module T : Test_lib.T with type t = t) = 28 | Printf.printf "Test %s\n%!" (T.name ()); 29 | let values = [0l; 1l; 2l; 2147483647l] in 30 | List.iter 31 | ~f:(fun v -> Test_lib.test_encode ~proto_file (module T) (create v)) 32 | values 33 | 34 | let%expect_test _ = 35 | let module T = Int_types_native.SInt64 in 36 | let create i = i in 37 | test_signed64 ~create (module T); 38 | [%expect {| 39 | Test .int_types_native.SInt64 40 | i: -1073741823 41 | i: -2 42 | i: -1 43 | i: 1 44 | i: 2 45 | i: 1073741823 |}] 46 | 47 | let%expect_test _ = 48 | let module T = Int_types_native.SInt32 in 49 | let create i = i in 50 | test_signed32 ~create (module T); 51 | [%expect {| 52 | Test .int_types_native.SInt32 53 | i: -1073741823 54 | i: -2 55 | i: -1 56 | i: 1 57 | i: 2 58 | i: 1073741823 |}] 59 | 60 | let%expect_test _ = 61 | let module T = Int_types_native.Int64 in 62 | let create i = i in 63 | test_signed64 ~create (module T); 64 | [%expect {| 65 | Test .int_types_native.Int64 66 | i: -1073741823 67 | i: -2 68 | i: -1 69 | i: 1 70 | i: 2 71 | i: 1073741823 |}] 72 | 73 | let%expect_test _ = 74 | let module T = Int_types_native.Int32 in 75 | let create i = i in 76 | test_signed32 ~create (module T); 77 | [%expect 78 | {| 79 | Test .int_types_native.Int32 80 | i: -1073741823 81 | i: -2 82 | i: -1 83 | i: 1 84 | i: 2 85 | i: 1073741823 |}] 86 | 87 | let%expect_test _ = 88 | let module T = Int_types_native.UInt64 in 89 | let create i = i in 90 | test_unsigned64 ~create (module T); 91 | [%expect {| 92 | Test .int_types_native.UInt64 93 | i: 1 94 | i: 2 95 | i: 2147483647 |}] 96 | 97 | let%expect_test _ = 98 | let module T = Int_types_native.UInt32 in 99 | let create i = i in 100 | test_unsigned32 ~create (module T); 101 | [%expect {| 102 | Test .int_types_native.UInt32 103 | i: 1 104 | i: 2 105 | i: 2147483647 |}] 106 | -------------------------------------------------------------------------------- /test/int_types_test.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | open Int_types 3 | 4 | let proto_file = "int_types.proto" 5 | 6 | let test_signed (type t) ~(create : int -> t) (module T : Test_lib.T with type t = t) = 7 | Printf.printf "Test %s\n%!" (T.name ()); 8 | let values = [-1073741823; -2; -1; 0; 1; 2; 1073741823] in 9 | List.iter 10 | ~f:(fun v -> Test_lib.test_encode ~skip_json:true ~proto_file (module T) (create v)) 11 | values 12 | 13 | let test_unsigned (type t) ~(create : int -> t) (module T : Test_lib.T with type t = t) = 14 | Printf.printf "Test %s\n%!" (T.name ()); 15 | let values = [0; 1; 2; 2147483647; 4294967295] in 16 | List.iter 17 | ~f:(fun v -> Test_lib.test_encode ~proto_file (module T) (create v)) 18 | values 19 | 20 | let%expect_test _ = 21 | let module T = Int_types.SInt64 in 22 | let create i = i in 23 | test_signed ~create (module T); 24 | [%expect {| 25 | Test .int_types.SInt64 26 | i: -1073741823 27 | i: -2 28 | i: -1 29 | i: 1 30 | i: 2 31 | i: 1073741823 |}] 32 | 33 | let%expect_test _ = 34 | let module T = Int_types.SInt32 in 35 | let create i = i in 36 | test_signed ~create (module T); 37 | [%expect {| 38 | Test .int_types.SInt32 39 | i: -1073741823 40 | i: -2 41 | i: -1 42 | i: 1 43 | i: 2 44 | i: 1073741823 |}] 45 | 46 | let%expect_test _ = 47 | let module T = Int_types.Int64 in 48 | let create i = i in 49 | test_signed ~create (module T); 50 | [%expect {| 51 | Test .int_types.Int64 52 | i: -1073741823 53 | i: -2 54 | i: -1 55 | i: 1 56 | i: 2 57 | i: 1073741823 |}] 58 | 59 | let%expect_test _ = 60 | let module T = Int_types.Int32 in 61 | let create i = i in 62 | test_signed ~create (module T); 63 | [%expect 64 | {| 65 | Test .int_types.Int32 66 | i: -1073741823 67 | i: -2 68 | i: -1 69 | i: 1 70 | i: 2 71 | i: 1073741823 |}] 72 | 73 | let%expect_test _ = 74 | let module T = Int_types.UInt64 in 75 | let create i = i in 76 | test_unsigned ~create (module T); 77 | [%expect {| 78 | Test .int_types.UInt64 79 | i: 1 80 | i: 2 81 | i: 2147483647 82 | i: 4294967295 |}] 83 | 84 | let%expect_test _ = 85 | let module T = Int_types.UInt32 in 86 | let create i = i in 87 | test_unsigned ~create (module T); 88 | [%expect {| 89 | Test .int_types.UInt32 90 | i: 1 91 | i: 2 92 | i: 2147483647 93 | i: 4294967295 |}] 94 | -------------------------------------------------------------------------------- /test/json_encoding.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "google/protobuf/duration.proto"; 4 | import "google/protobuf/timestamp.proto"; 5 | import "google/protobuf/empty.proto"; 6 | import "google/protobuf/struct.proto"; 7 | import "google/protobuf/any.proto"; 8 | import "google/protobuf/wrappers.proto"; 9 | import "google/protobuf/field_mask.proto"; 10 | 11 | package Json_test; 12 | 13 | message Duration { 14 | google.protobuf.Duration duration = 1; 15 | } 16 | 17 | message Timestamp { 18 | google.protobuf.Timestamp timestamp = 1; 19 | } 20 | 21 | message Empty { 22 | google.protobuf.Empty empty = 1; 23 | } 24 | 25 | message Value { 26 | google.protobuf.Struct struct = 1; 27 | } 28 | 29 | message Any { 30 | google.protobuf.Any any = 1; 31 | } 32 | 33 | // Wrappers 34 | message Wrappers { 35 | google.protobuf.DoubleValue double = 1; 36 | google.protobuf.FloatValue float = 2; 37 | google.protobuf.Int64Value s64 = 3; 38 | google.protobuf.UInt64Value u64 = 4; 39 | google.protobuf.Int32Value s32 = 5; 40 | google.protobuf.UInt32Value u32 = 6; 41 | google.protobuf.BoolValue bool = 7; 42 | google.protobuf.StringValue string = 8; 43 | google.protobuf.BytesValue bytes = 9; 44 | } 45 | 46 | message FieldMask { 47 | google.protobuf.FieldMask mask = 1; 48 | } 49 | 50 | message Struct { 51 | google.protobuf.Struct struct = 1; 52 | } 53 | -------------------------------------------------------------------------------- /test/large.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message large { 4 | uint32 x1 = 1; 5 | uint32 x2 = 2; 6 | uint32 x3 = 3; 7 | uint32 x4 = 4; 8 | uint32 x5 = 5; 9 | uint32 x6 = 6; 10 | uint32 x7 = 7; 11 | uint32 x8 = 8; 12 | uint32 x9 = 9; 13 | uint32 x10 = 10; 14 | uint32 x11 = 11; 15 | uint32 x12 = 12; 16 | uint32 x13 = 13; 17 | uint32 x14 = 14; 18 | uint32 x15 = 15; 19 | uint32 x16 = 16; 20 | uint32 x17 = 17; 21 | uint32 x18 = 18; 22 | uint32 x19 = 19; 23 | uint32 x20 = 20; 24 | uint32 x21 = 21; 25 | uint32 x22 = 22; 26 | uint32 x23 = 23; 27 | uint32 x24 = 24; 28 | uint32 x25 = 25; 29 | uint32 x26 = 26; 30 | uint32 x27 = 27; 31 | uint32 x28 = 28; 32 | uint32 x29 = 29; 33 | uint32 x30 = 30; 34 | uint32 x31 = 31; 35 | uint32 x32 = 32; 36 | uint32 x33 = 33; 37 | uint32 x34 = 34; 38 | uint32 x35 = 35; 39 | uint32 x36 = 36; 40 | uint32 x37 = 37; 41 | uint32 x38 = 38; 42 | uint32 x39 = 39; 43 | uint32 x40 = 40; 44 | uint32 x41 = 41; 45 | uint32 x42 = 42; 46 | uint32 x43 = 43; 47 | uint32 x44 = 44; 48 | uint32 x45 = 45; 49 | uint32 x46 = 46; 50 | uint32 x47 = 47; 51 | uint32 x48 = 48; 52 | uint32 x49 = 49; 53 | uint32 x50 = 50; 54 | uint32 x51 = 51; 55 | uint32 x52 = 52; 56 | uint32 x53 = 53; 57 | uint32 x54 = 54; 58 | uint32 x55 = 55; 59 | uint32 x56 = 56; 60 | uint32 x57 = 57; 61 | uint32 x58 = 58; 62 | uint32 x59 = 59; 63 | uint32 x60 = 60; 64 | uint32 x61 = 61; 65 | uint32 x62 = 62; 66 | uint32 x63 = 63; 67 | uint32 x64 = 64; 68 | uint32 x65 = 65; 69 | uint32 x66 = 66; 70 | uint32 x67 = 67; 71 | uint32 x68 = 68; 72 | uint32 x69 = 69; 73 | uint32 x70 = 70; 74 | uint32 x71 = 71; 75 | uint32 x72 = 72; 76 | uint32 x73 = 73; 77 | uint32 x74 = 74; 78 | uint32 x75 = 75; 79 | uint32 x76 = 76; 80 | uint32 x77 = 77; 81 | uint32 x78 = 78; 82 | uint32 x79 = 79; 83 | uint32 x80 = 80; 84 | uint32 x81 = 81; 85 | uint32 x82 = 82; 86 | uint32 x83 = 83; 87 | uint32 x84 = 84; 88 | uint32 x85 = 85; 89 | uint32 x86 = 86; 90 | uint32 x87 = 87; 91 | uint32 x88 = 88; 92 | uint32 x89 = 89; 93 | uint32 x90 = 90; 94 | uint32 x91 = 91; 95 | uint32 x92 = 92; 96 | uint32 x93 = 93; 97 | uint32 x94 = 94; 98 | uint32 x95 = 95; 99 | uint32 x96 = 96; 100 | uint32 x97 = 97; 101 | uint32 x98 = 98; 102 | uint32 x99 = 99; 103 | uint32 x100 = 100; 104 | uint32 x101 = 101; 105 | uint32 x102 = 102; 106 | uint32 x103 = 103; 107 | uint32 x104 = 104; 108 | uint32 x105 = 105; 109 | uint32 x106 = 106; 110 | uint32 x107 = 107; 111 | uint32 x108 = 108; 112 | uint32 x109 = 109; 113 | uint32 x110 = 110; 114 | uint32 x111 = 111; 115 | uint32 x112 = 112; 116 | uint32 x113 = 113; 117 | uint32 x114 = 114; 118 | uint32 x115 = 115; 119 | uint32 x116 = 116; 120 | uint32 x117 = 117; 121 | uint32 x118 = 118; 122 | uint32 x119 = 119; 123 | uint32 x120 = 120; 124 | uint32 x121 = 121; 125 | uint32 x122 = 122; 126 | uint32 x123 = 123; 127 | uint32 x124 = 124; 128 | uint32 x125 = 125; 129 | uint32 x126 = 126; 130 | uint32 x127 = 127; 131 | uint32 x128 = 128; 132 | uint32 x129 = 129; 133 | uint32 x130 = 130; 134 | uint32 x131 = 131; 135 | uint32 x132 = 132; 136 | uint32 x133 = 133; 137 | uint32 x134 = 134; 138 | uint32 x135 = 135; 139 | uint32 x136 = 136; 140 | uint32 x137 = 137; 141 | uint32 x138 = 138; 142 | uint32 x139 = 139; 143 | uint32 x140 = 140; 144 | uint32 x141 = 141; 145 | uint32 x142 = 142; 146 | uint32 x143 = 143; 147 | uint32 x144 = 144; 148 | uint32 x145 = 145; 149 | uint32 x146 = 146; 150 | uint32 x147 = 147; 151 | uint32 x148 = 148; 152 | uint32 x149 = 149; 153 | uint32 x150 = 150; 154 | uint32 x151 = 151; 155 | uint32 x152 = 152; 156 | uint32 x153 = 153; 157 | uint32 x154 = 154; 158 | uint32 x155 = 155; 159 | uint32 x156 = 156; 160 | uint32 x157 = 157; 161 | uint32 x158 = 158; 162 | uint32 x159 = 159; 163 | uint32 x160 = 160; 164 | uint32 x161 = 161; 165 | uint32 x162 = 162; 166 | uint32 x163 = 163; 167 | uint32 x164 = 164; 168 | uint32 x165 = 165; 169 | uint32 x166 = 166; 170 | uint32 x167 = 167; 171 | uint32 x168 = 168; 172 | uint32 x169 = 169; 173 | uint32 x170 = 170; 174 | uint32 x171 = 171; 175 | uint32 x172 = 172; 176 | uint32 x173 = 173; 177 | uint32 x174 = 174; 178 | uint32 x175 = 175; 179 | uint32 x176 = 176; 180 | uint32 x177 = 177; 181 | uint32 x178 = 178; 182 | uint32 x179 = 179; 183 | uint32 x180 = 180; 184 | uint32 x181 = 181; 185 | uint32 x182 = 182; 186 | uint32 x183 = 183; 187 | uint32 x184 = 184; 188 | uint32 x185 = 185; 189 | uint32 x186 = 186; 190 | uint32 x187 = 187; 191 | uint32 x188 = 188; 192 | uint32 x189 = 189; 193 | uint32 x190 = 190; 194 | uint32 x191 = 191; 195 | uint32 x192 = 192; 196 | uint32 x193 = 193; 197 | uint32 x194 = 194; 198 | uint32 x195 = 195; 199 | uint32 x196 = 196; 200 | uint32 x197 = 197; 201 | uint32 x198 = 198; 202 | uint32 x199 = 199; 203 | uint32 x200 = 200; 204 | uint32 x201 = 201; 205 | uint32 x202 = 202; 206 | uint32 x203 = 203; 207 | uint32 x204 = 204; 208 | uint32 x205 = 205; 209 | uint32 x206 = 206; 210 | uint32 x207 = 207; 211 | uint32 x208 = 208; 212 | uint32 x209 = 209; 213 | uint32 x210 = 210; 214 | uint32 x211 = 211; 215 | uint32 x212 = 212; 216 | uint32 x213 = 213; 217 | uint32 x214 = 214; 218 | uint32 x215 = 215; 219 | uint32 x216 = 216; 220 | uint32 x217 = 217; 221 | uint32 x218 = 218; 222 | uint32 x219 = 219; 223 | uint32 x220 = 220; 224 | uint32 x221 = 221; 225 | uint32 x222 = 222; 226 | uint32 x223 = 223; 227 | uint32 x224 = 224; 228 | uint32 x225 = 225; 229 | uint32 x226 = 226; 230 | uint32 x227 = 227; 231 | uint32 x228 = 228; 232 | uint32 x229 = 229; 233 | uint32 x230 = 230; 234 | uint32 x231 = 231; 235 | uint32 x232 = 232; 236 | uint32 x233 = 233; 237 | uint32 x234 = 234; 238 | uint32 x235 = 235; 239 | uint32 x236 = 236; 240 | uint32 x237 = 237; 241 | uint32 x238 = 238; 242 | uint32 x239 = 239; 243 | uint32 x240 = 240; 244 | uint32 x241 = 241; 245 | uint32 x242 = 242; 246 | uint32 x243 = 243; 247 | uint32 x244 = 244; 248 | uint32 x245 = 245; 249 | uint32 x246 = 246; 250 | uint32 x247 = 247; 251 | uint32 x248 = 248; 252 | uint32 x249 = 249; 253 | uint32 x250 = 250; 254 | } 255 | -------------------------------------------------------------------------------- /test/large_test.ml: -------------------------------------------------------------------------------- 1 | open Large 2 | 3 | let proto_file = "large.proto" 4 | 5 | let%expect_test "Test very large message type" = 6 | let large = Large.make ~x7:7 () in 7 | Test_lib.test_encode ~proto_file (module Large) large; 8 | (); 9 | [%expect {| 10 | x7: 7 |}] 11 | -------------------------------------------------------------------------------- /test/mangle_names.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "options.proto"; 4 | option (ocaml_options) = { mangle_names:true }; 5 | 6 | message CamelCaseName { 7 | uint32 CamelCaseField = 1; 8 | enum CamelCaseEnum { 9 | IdZero = 0; 10 | id_zero = 1; 11 | idOne = 2; 12 | ID_ONE = 3; 13 | }; 14 | uint32 xid_zero = 11; 15 | } 16 | 17 | message camel_case_name { 18 | uint32 CamelCaseField = 1; 19 | enum CamelCaseEnum { 20 | IdZero = 0; 21 | id_zero = 1; 22 | idOne = 2; 23 | ID_ONE = 3; 24 | }; 25 | uint32 xid_zero = 11; 26 | } 27 | 28 | message RequestOne { } 29 | message ResponseOne { } 30 | 31 | service StringOfInt { 32 | rpc CallOne (RequestOne) returns (ResponseOne); 33 | rpc Call_one (RequestOne) returns (ResponseOne); 34 | rpc callOne (RequestOne) returns (ResponseOne); 35 | } 36 | -------------------------------------------------------------------------------- /test/mangle_names_test.ml: -------------------------------------------------------------------------------- 1 | module A = Mangle_names.Camel_case_name 2 | module B = Mangle_names.Camel_case_name' 3 | module C = Mangle_names.Request_one 4 | module D = Mangle_names.Response_one 5 | module E = Mangle_names.String_of_int.Call_one 6 | module F = Mangle_names.String_of_int.Call_one' 7 | module G = Mangle_names.String_of_int.Call_one'' 8 | -------------------------------------------------------------------------------- /test/map.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package map; 4 | 5 | message Test { 6 | map m = 1; 7 | } 8 | 9 | message Bool_map { 10 | map m = 1; 11 | } 12 | 13 | message Two { 14 | map m = 1; 15 | map n = 20; 16 | } 17 | 18 | message Map_message { 19 | message Inner { 20 | int64 i = 1; 21 | } 22 | map m = 1; 23 | } 24 | 25 | message Map_message2 { 26 | map m = 1; 27 | } 28 | 29 | message Map_message3 { 30 | enum Enum { 31 | A = 0; 32 | B = 1; 33 | }; 34 | map m = 1; 35 | } 36 | -------------------------------------------------------------------------------- /test/map_test.ml: -------------------------------------------------------------------------------- 1 | open Map 2 | 3 | let proto_file = "map.proto" 4 | 5 | let%expect_test _ = 6 | let module T = Map.Test in 7 | let t = [ 2, "2"; 3, "3"; 1, "1"; 4, "4" ] in 8 | Test_lib.test_encode ~skip_json:true ~proto_file (module T) t; 9 | [%expect {| 10 | m { 11 | key: 1 12 | value: "1" 13 | } 14 | m { 15 | key: 2 16 | value: "2" 17 | } 18 | m { 19 | key: 3 20 | value: "3" 21 | } 22 | m { 23 | key: 4 24 | value: "4" 25 | } |}] 26 | 27 | let%expect_test _ = 28 | let module T = Map.Bool_map in 29 | let t = [ true, "true"; false, "false" ] in 30 | Test_lib.test_encode ~skip_json:true ~skip_protoc:true ~proto_file (module T) t; 31 | [%expect {| |}] 32 | 33 | 34 | 35 | let%expect_test _ = 36 | let module T = Map.Two in 37 | let t = T.{ m = [ 1, "10"; 2, "1"; 3, "2"; 4, "3" ]; 38 | n = [ 1, 1.0; 2, 2.0; 3, 3.0; 4, 4.0 ]} in 39 | Test_lib.test_encode ~proto_file (module T) t; 40 | 41 | [%expect {| 42 | m { 43 | key: 1 44 | value: "10" 45 | } 46 | m { 47 | key: 2 48 | value: "1" 49 | } 50 | m { 51 | key: 3 52 | value: "2" 53 | } 54 | m { 55 | key: 4 56 | value: "3" 57 | } 58 | n { 59 | key: 1 60 | value: 1 61 | } 62 | n { 63 | key: 2 64 | value: 2 65 | } 66 | n { 67 | key: 3 68 | value: 3 69 | } 70 | n { 71 | key: 4 72 | value: 4 73 | } |}] 74 | 75 | 76 | let%expect_test _ = 77 | let module T = Map.Map_message in 78 | let t = [ 1, Some 1; 79 | 2, Some 2; 80 | 3, Some 3; 81 | 4, Some 4; ] 82 | in 83 | Test_lib.test_encode ~proto_file (module T) t; 84 | [%expect {| 85 | m { 86 | key: 1 87 | value { 88 | i: 1 89 | } 90 | } 91 | m { 92 | key: 2 93 | value { 94 | i: 2 95 | } 96 | } 97 | m { 98 | key: 3 99 | value { 100 | i: 3 101 | } 102 | } 103 | m { 104 | key: 4 105 | value { 106 | i: 4 107 | } 108 | } |}] 109 | 110 | let%expect_test _ = 111 | let module T = Map.Map_message in 112 | let t = [ 0, Some 0; 113 | 1, Some 1; 114 | 2, Some 2; 115 | 3, None; 116 | 4, Some 4; 117 | 10, Some 0; 118 | ] 119 | in 120 | (* Skip protoc and json tests due to a bug where neither keys or values in a map can be null or the default value *) 121 | Test_lib.test_encode ~skip_protoc:true ~skip_json:true ~proto_file (module T) t; 122 | 123 | [%expect {| |}] 124 | -------------------------------------------------------------------------------- /test/merge.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package merge; 4 | 5 | message T { 6 | int64 a = 1; 7 | repeated int64 b = 2; 8 | repeated string c = 3; 9 | T d = 4; 10 | 11 | oneof o { 12 | int64 i = 12; 13 | T k = 11; 14 | string j = 10; 15 | }; 16 | } 17 | -------------------------------------------------------------------------------- /test/merge_test.ml: -------------------------------------------------------------------------------- 1 | open !StdLabels 2 | open Merge.Merge 3 | 4 | let test_merge (type t) (module T: Test_lib.T with type t = t) (init : t) (ts: t list) = 5 | let open Ocaml_protoc_plugin in 6 | let writer = Writer.init () in 7 | let expect = 8 | List.fold_left ~init ~f:(fun acc t -> 9 | Printf.printf "%s\n" (T.show t); 10 | let _ = T.to_proto' writer t in 11 | T.merge acc t 12 | ) ts 13 | in 14 | let merged = T.from_proto (Reader.create (Writer.contents writer)) |> Result.get ~msg:"Unable to decode merged messages" in 15 | Printf.printf "Merged: %s\n" (T.show merged); 16 | let () = match merged = expect with 17 | | false -> 18 | Printf.printf "Merge results not equal\n"; 19 | Printf.printf "Expected: %s\n" (T.show expect); 20 | | true -> () 21 | in 22 | () 23 | 24 | let%expect_test "merge int" = 25 | (* Create a set of tests, each expanding on the previous *) 26 | (* And we should extend test_encode to verify merge for all message types *) 27 | (* But in this test we want to explicitly test it *) 28 | (* Also for merging multiple messages *) 29 | 30 | let t1 = T.make ~a:5 () in 31 | let t2 = T.make ~a:7 () in 32 | test_merge (module T) (T.make ()) [t1; t2]; 33 | [%expect {| 34 | { a = 5; b = []; c = []; d = None; o = `not_set } 35 | { a = 7; b = []; c = []; d = None; o = `not_set } 36 | Merged: { a = 7; b = []; c = []; d = None; o = `not_set } |}] 37 | 38 | let%expect_test "merge int" = 39 | (* Create a set of tests, each expanding on the previous *) 40 | (* And we should extend test_encode to verify merge for all message types *) 41 | (* But in this test we want to explicitly test it *) 42 | (* Also for merging multiple messages *) 43 | 44 | let t1 = T.make ~b:[1;2;3] () in 45 | let t2 = T.make ~b:[4;5;6] () in 46 | let t3 = T.make ~b:[7;8;9] () in 47 | test_merge (module T) (T.make ()) [t1; t2; t3]; 48 | [%expect {| 49 | { a = 0; b = [1; 2; 3]; c = []; d = None; o = `not_set } 50 | { a = 0; b = [4; 5; 6]; c = []; d = None; o = `not_set } 51 | { a = 0; b = [7; 8; 9]; c = []; d = None; o = `not_set } 52 | Merged: { a = 0; b = [1; 2; 3; 4; 5; 6; 7; 8; 9]; c = []; d = None; o = `not_set } |}] 53 | 54 | let%expect_test "merge string" = 55 | (* Create a set of tests, each expanding on the previous *) 56 | (* And we should extend test_encode to verify merge for all message types *) 57 | (* But in this test we want to explicitly test it *) 58 | (* Also for merging multiple messages *) 59 | 60 | let t1 = T.make ~c:["1";"2";"3"] () in 61 | let t2 = T.make ~c:["4";"5";"6"] () in 62 | let t3 = T.make ~c:["7";"8";"9"] () in 63 | test_merge (module T) (T.make ()) [t1; t2; t3]; 64 | [%expect {| 65 | { a = 0; b = []; c = ["1"; "2"; "3"]; d = None; o = `not_set } 66 | { a = 0; b = []; c = ["4"; "5"; "6"]; d = None; o = `not_set } 67 | { a = 0; b = []; c = ["7"; "8"; "9"]; d = None; o = `not_set } 68 | Merged: { a = 0; b = []; c = ["1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"]; d = None; 69 | o = `not_set } |}] 70 | 71 | let%expect_test "merge message" = 72 | (* Create a set of tests, each expanding on the previous *) 73 | (* And we should extend test_encode to verify merge for all message types *) 74 | (* But in this test we want to explicitly test it *) 75 | (* Also for merging multiple messages *) 76 | 77 | let t11 = T.make ~a:1 ~b:[1;2;3] () in 78 | let t12 = T.make ~a:2 ~b:[4;5;6] () in 79 | let t13 = T.make ~a:3 ~b:[7;8;9] () in 80 | let t1 = T.make ~a:6 ~d:t11 () in 81 | let t2 = T.make ~a:7 ~d:t12 () in 82 | let t3 = T.make ~a:8 ~d:t13 () in 83 | 84 | test_merge (module T) (T.make ()) [t1; t2; t3]; 85 | [%expect {| 86 | { a = 6; b = []; c = []; 87 | d = (Some { a = 1; b = [1; 2; 3]; c = []; d = None; o = `not_set }); 88 | o = `not_set } 89 | { a = 7; b = []; c = []; 90 | d = (Some { a = 2; b = [4; 5; 6]; c = []; d = None; o = `not_set }); 91 | o = `not_set } 92 | { a = 8; b = []; c = []; 93 | d = (Some { a = 3; b = [7; 8; 9]; c = []; d = None; o = `not_set }); 94 | o = `not_set } 95 | Merged: { a = 8; b = []; c = []; 96 | d = 97 | (Some { a = 3; b = [1; 2; 3; 4; 5; 6; 7; 8; 9]; c = []; d = None; 98 | o = `not_set }); 99 | o = `not_set } |}] 100 | 101 | let%expect_test "merge last oneof" = 102 | (* Create a set of tests, each expanding on the previous *) 103 | (* And we should extend test_encode to verify merge for all message types *) 104 | (* But in this test we want to explicitly test it *) 105 | (* Also for merging multiple messages *) 106 | 107 | let t1 = T.make ~o:(`I 5) () in 108 | let t2 = T.make ~o:(`J "7") () in 109 | test_merge (module T) (T.make ()) [t1; t2]; 110 | [%expect {| 111 | { a = 0; b = []; c = []; d = None; o = `I (5) } 112 | { a = 0; b = []; c = []; d = None; o = `J ("7") } 113 | Merged: { a = 0; b = []; c = []; d = None; o = `J ("7") } |}] 114 | 115 | let%expect_test "merge message oneof" = 116 | (* Create a set of tests, each expanding on the previous *) 117 | (* And we should extend test_encode to verify merge for all message types *) 118 | (* But in this test we want to explicitly test it *) 119 | (* Also for merging multiple messages *) 120 | 121 | let t11 = T.make ~a:1 ~b:[1;2;3] () in 122 | let t12 = T.make ~a:2 ~b:[4;5;6] () in 123 | let t13 = T.make ~a:3 ~b:[7;8;9] () in 124 | 125 | let t1 = T.make ~o:(`K t11) () in 126 | let t2 = T.make ~o:(`K t12) () in 127 | let t3 = T.make ~o:(`K t13) () in 128 | test_merge (module T) (T.make ()) [t1; t2; t3]; 129 | [%expect {| 130 | { a = 0; b = []; c = []; d = None; 131 | o = `K ({ a = 1; b = [1; 2; 3]; c = []; d = None; o = `not_set }) } 132 | { a = 0; b = []; c = []; d = None; 133 | o = `K ({ a = 2; b = [4; 5; 6]; c = []; d = None; o = `not_set }) } 134 | { a = 0; b = []; c = []; d = None; 135 | o = `K ({ a = 3; b = [7; 8; 9]; c = []; d = None; o = `not_set }) } 136 | Merged: { a = 0; b = []; c = []; d = None; 137 | o = `K ({ a = 3; b = [7; 8; 9]; c = []; d = None; o = `not_set }) } 138 | Merge results not equal 139 | Expected: { a = 0; b = []; c = []; d = None; 140 | o = 141 | `K ({ a = 3; b = [1; 2; 3; 4; 5; 6; 7; 8; 9]; c = []; d = None; 142 | o = `not_set }) 143 | } |}] 144 | -------------------------------------------------------------------------------- /test/message.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package message; 4 | 5 | message Submessage { 6 | int64 i = 1; 7 | } 8 | 9 | message Message { 10 | Submessage m = 1; 11 | } 12 | 13 | message Message2 { 14 | int64 i = 1; 15 | Submessage m = 2; 16 | } 17 | -------------------------------------------------------------------------------- /test/message_test.ml: -------------------------------------------------------------------------------- 1 | open Message 2 | 3 | let proto_file = "message.proto" 4 | 5 | let%expect_test _ = 6 | let module T = Message.Message in 7 | let submessage = 3 in 8 | let validate = T.make ~m:submessage () in 9 | let t = Some submessage in 10 | Test_lib.test_encode ~proto_file (module T) ~validate t; 11 | [%expect {| 12 | m { 13 | i: 3 14 | } |}] 15 | 16 | (** The message containing a submessage with all default values. 17 | The length of the submessage is 0, so 18 | the message will be index 1, with length delimited type (2): 19 | 1 * 8 + 2 = 0xa 20 | The length of the delimited type is 0, so the complete message shoud be: 21 | 0xa 0x0. 22 | *) 23 | 24 | let%expect_test _ = 25 | let module T = Message.Message in 26 | let validate = T.make ~m:0 () in 27 | let t = Some 0 in 28 | Test_lib.test_encode ~proto_file (module T) ~validate t; 29 | [%expect {| 30 | m { 31 | } |}] 32 | 33 | let%expect_test _ = 34 | let module T = Message.Message in 35 | let validate = T.make ~m:1 () in 36 | let t = Some 1 in 37 | Test_lib.test_encode ~proto_file (module T) ~validate t; 38 | [%expect {| 39 | m { 40 | i: 1 41 | } |}] 42 | 43 | let%expect_test _ = 44 | let module T = Message.Message in 45 | let validate = T.make () in 46 | let t = None in 47 | Test_lib.test_encode ~proto_file (module T) ~validate t; 48 | [%expect {| |}] 49 | 50 | let%expect_test _ = 51 | let module T = Message.Message2 in 52 | let validate = T.make ~i:2 () in 53 | let t = T.{i = 2; m = None} in 54 | Test_lib.test_encode ~proto_file (module T) ~validate t; 55 | [%expect {| 56 | i: 2 |}] 57 | 58 | let%expect_test _ = 59 | let module T = Message.Message2 in 60 | let submessage = 0 in 61 | let validate = T.make ~i:2 ~m:submessage () in 62 | let t = T.{i = 2; m = Some submessage} in 63 | Test_lib.test_encode ~proto_file (module T) ~validate t; 64 | [%expect {| 65 | i: 2 66 | m { 67 | } |}] 68 | -------------------------------------------------------------------------------- /test/name_clash.proto: -------------------------------------------------------------------------------- 1 | 2 | syntax = "proto3"; 3 | 4 | package name_clash; 5 | 6 | message Protobuf { 7 | int64 Protobuf = 1; 8 | int64 Ocaml_protoc_plugin = 2; 9 | int64 make = 3; 10 | int64 t = 4; 11 | int64 to_proto = 5; 12 | int64 from_proto = 6; 13 | int64 Runtime = 7; 14 | int64 name = 8; 15 | } 16 | message Ocaml_protoc_plugin { 17 | int64 Protobuf = 1; 18 | int64 Ocaml_protoc_plugin = 2; 19 | } 20 | message OcamlProtocPlugin { 21 | int64 Protobuf = 1; 22 | int64 Ocaml_protoc_plugin = 2; 23 | } 24 | message Base { 25 | int64 Protobuf = 1; 26 | int64 Ocaml_protoc_plugin = 2; 27 | } 28 | message Pervasives { 29 | int64 Protobuf = 1; 30 | int64 Ocaml_protoc_plugin = 2; 31 | } 32 | message Stdlib { 33 | int64 Protobuf = 1; 34 | int64 Ocaml_protoc_plugin = 2; 35 | } 36 | message StdLabels { 37 | int64 Protobuf = 1; 38 | int64 Ocaml_protoc_plugin = 2; 39 | } 40 | message Enum { 41 | int64 enum = 1; 42 | } 43 | message Enum1 { 44 | int64 Enum1 = 1; 45 | } 46 | message struct { 47 | int64 struct = 1; 48 | } 49 | message end { 50 | int64 End = 1; 51 | } 52 | message basic { 53 | int64 Basic = 1; 54 | int64 Int64 = 2; 55 | } 56 | message _Enum { 57 | int64 i = 1; 58 | } 59 | message _enum { 60 | int64 i = 1; 61 | } 62 | 63 | message equal { 64 | int64 equal = 1; 65 | } 66 | 67 | message enum_clash { 68 | int64 name_one = 1; 69 | oneof NameOne { int64 name_two = 2; } 70 | oneof Name_one { int64 name_three = 3; } 71 | } 72 | 73 | message not_set { 74 | int64 not_set = 1; 75 | } 76 | 77 | message not_set2 { 78 | oneof not_set { int64 not_set2 = 1; }; 79 | } 80 | 81 | message not_set3 { 82 | oneof not_set3 { int64 not_set = 1; }; 83 | } 84 | -------------------------------------------------------------------------------- /test/name_clash2.proto: -------------------------------------------------------------------------------- 1 | // Test including a file those module name would conflict 2 | // with an existing name. 3 | 4 | syntax = "proto3"; 5 | 6 | import "options.proto"; 7 | option (ocaml_options) = { mangle_names:true }; 8 | package ImportModuleName.subPackageName; 9 | 10 | import "name_clash.proto"; 11 | import "mangle_names.proto"; 12 | 13 | message Name_clash { 14 | name_clash.Ocaml_protoc_plugin a = 1; 15 | } 16 | 17 | message imports { } 18 | message Imports { } 19 | 20 | message Mangle_names { 21 | int64 a = 1; 22 | CamelCaseName b = 2; 23 | camel_case_name c = 3; 24 | } 25 | -------------------------------------------------------------------------------- /test/name_clash_mangle.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package NameClashMangle; 4 | import "options.proto"; 5 | option (ocaml_options) = { mangle_names:true }; 6 | 7 | import "name_clash.proto"; 8 | 9 | message Protobuf { 10 | int64 Protobuf = 1; 11 | int64 OcamlProtocPlugin = 2; 12 | } 13 | message Ocaml_protoc_plugin { } 14 | 15 | message Base { } 16 | 17 | message Pervasives { } 18 | 19 | message Stdlib { } 20 | 21 | message StdLabels { } 22 | 23 | message _StdLabels { 24 | message StdLabels { int64 _blah = 5; } 25 | } 26 | 27 | message Enum { 28 | int64 enum = 1; 29 | } 30 | 31 | message Enum1 { 32 | int64 Enum1 = 1; 33 | } 34 | 35 | message struct { 36 | int64 struct = 1; 37 | } 38 | 39 | message end { 40 | int64 End = 1; 41 | } 42 | 43 | message basic { 44 | int64 Basic = 1; 45 | int64 Int64 = 2; 46 | } 47 | 48 | message _Enum { 49 | int64 i = 1; 50 | } 51 | 52 | message _enum { 53 | int64 i = 1; 54 | } 55 | 56 | message equal { 57 | int64 equal = 1; 58 | } 59 | 60 | message enum_clash { 61 | int64 name_one = 1; 62 | oneof NameOne { int64 name_two = 2; } 63 | oneof Name_one { int64 name_three = 3; } 64 | } 65 | 66 | message not_set { 67 | int64 not_set = 1; 68 | } 69 | 70 | message not_set2 { 71 | oneof not_set { int64 not_set2 = 1; }; 72 | } 73 | 74 | message not_set3 { 75 | oneof not_set3 { int64 not_set = 1; }; 76 | } 77 | 78 | enum ENUM_TEST { 79 | ENUM1 = 0; 80 | ENUM2 = 1; 81 | ENUM_Three = 2; 82 | ENUM_four = 3; 83 | ENUM_Name = 4; 84 | EnumName = 5; 85 | } 86 | 87 | message A { 88 | enum a { 89 | B1 = 0; 90 | }; 91 | message A { 92 | int64 A = 1; 93 | } 94 | } 95 | 96 | message RequestMessage {} 97 | message ResponseMessage {} 98 | 99 | service EnumClash { 100 | rpc RequestEndPoint (RequestMessage) returns (ResponseMessage); 101 | rpc Request_end_point (RequestMessage) returns (ResponseMessage); 102 | rpc TestService (RequestMessage) returns (ResponseMessage); 103 | rpc Ocaml_proto_plugin (RequestMessage) returns (ResponseMessage); 104 | rpc method (RequestMessage) returns (ResponseMessage); 105 | rpc included (name_clash.StdLabels) returns (ResponseMessage); 106 | } 107 | -------------------------------------------------------------------------------- /test/oneof.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package oneof; 4 | 5 | 6 | message Test { 7 | int64 y = 1; 8 | oneof x { 9 | int64 i = 10; 10 | string j = 20; 11 | } 12 | } 13 | 14 | message Test2 { 15 | message F1 { 16 | string j = 2; 17 | } 18 | message F2 { 19 | int64 x = 2; 20 | } 21 | oneof x { 22 | F1 f1 = 10; 23 | F2 f2 = 20; 24 | string f3 = 2; 25 | } 26 | } 27 | 28 | message Test3 { 29 | oneof x { 30 | sint64 x1 = 10; 31 | sint64 x2 = 20; 32 | } 33 | 34 | oneof y { 35 | sint64 y1 = 100; 36 | sint64 y2 = 200; 37 | } 38 | 39 | oneof z { 40 | sint64 z1 = 1000; 41 | sint64 z2 = 2000; 42 | } 43 | } 44 | 45 | message Test4 { 46 | oneof a { uint64 i = 1; }; 47 | } 48 | 49 | message Test5 { 50 | message Empty { }; 51 | oneof a { Empty e = 1; }; 52 | } 53 | 54 | message Test6 { 55 | int64 i = 1; 56 | oneof a { 57 | int64 a1 = 10; 58 | int64 a2 = 21; 59 | }; 60 | int64 j = 20; 61 | oneof b { 62 | int64 f = 30; 63 | int64 ff = 31; 64 | }; 65 | oneof c { 66 | Test6 g = 40; 67 | }; 68 | } 69 | -------------------------------------------------------------------------------- /test/oneof2.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package oneof; 4 | 5 | message Test { 6 | int64 y = 1; 7 | oneof x { 8 | int64 i = 10; 9 | string j = 20; 10 | } 11 | } 12 | 13 | message Test2 { 14 | message F1 { 15 | string j = 2; 16 | } 17 | message F2 { 18 | int64 x = 2; 19 | } 20 | oneof x { 21 | F1 f1 = 10; 22 | F2 f2 = 20; 23 | string f3 = 2; 24 | } 25 | } 26 | 27 | message Test3 { 28 | oneof x { 29 | sint64 x1 = 10; 30 | sint64 x2 = 20; 31 | } 32 | 33 | oneof y { 34 | sint64 y1 = 100; 35 | sint64 y2 = 200; 36 | } 37 | 38 | oneof z { 39 | sint64 z1 = 1000; 40 | sint64 z2 = 2000; 41 | } 42 | } 43 | 44 | message Test4 { 45 | oneof a { uint64 i = 1; }; 46 | } 47 | 48 | message Test5 { 49 | message Empty { }; 50 | oneof a { Empty e = 1; }; 51 | } 52 | -------------------------------------------------------------------------------- /test/oneof2_test.ml: -------------------------------------------------------------------------------- 1 | open Oneof2 2 | 3 | let proto_file = "oneof2.proto" 4 | let%expect_test _ = 5 | let module T = Oneof.Test in 6 | let t = T.{ y = 5; x = `I 7} in 7 | Test_lib.test_encode ~proto_file ~dump:true (module T) t; 8 | [%expect {| 9 | Buffer: '08-05-50-07' 10 | y: 5 11 | i: 7 |}] 12 | 13 | let%expect_test _ = 14 | let module T = Oneof.Test2 in 15 | let t = `F3 "test" in 16 | Test_lib.test_encode ~proto_file (module T) t; 17 | [%expect {| 18 | f3: "test" |}] 19 | 20 | let%expect_test "Multiple oneofs" = 21 | let module T = Oneof.Test3 in 22 | let t = T.{ x = `X1 3; y = `Y2 5; z = `Z1 7 } in 23 | Test_lib.test_encode ~proto_file (module T) t; 24 | [%expect {| 25 | x1: 3 26 | y2: 5 27 | z1: 7 |}] 28 | 29 | let%expect_test "Default values in oneof" = 30 | let module T = Oneof.Test3 in 31 | let t = T.{ x = `X1 0; y = `Y2 0; z = `Z2 0 } in 32 | Test_lib.test_encode ~proto_file (module T) t; 33 | [%expect {| 34 | x1: 0 35 | y2: 0 36 | z2: 0 |}] 37 | 38 | let%expect_test "Single field oneof" = 39 | let module T = Oneof.Test4 in 40 | let t = Some 5 in 41 | Test_lib.test_encode ~proto_file (module T) t; 42 | [%expect {| 43 | i: 5 |}] 44 | 45 | let%expect_test "Single field oneof" = 46 | let module T = Oneof.Test5 in 47 | let t = Some () in 48 | Test_lib.test_encode ~proto_file (module T) t; 49 | [%expect {| 50 | e { 51 | } |}] 52 | -------------------------------------------------------------------------------- /test/oneof_test.ml: -------------------------------------------------------------------------------- 1 | open Oneof 2 | 3 | let proto_file = "oneof.proto" 4 | 5 | let%expect_test _ = 6 | let module T = Oneof.Test in 7 | let t = T.{ y = 5; x = `I 7} in 8 | Test_lib.test_encode ~proto_file ~dump:true (module T) t; 9 | [%expect {| 10 | Buffer: '08-05-50-07' 11 | y: 5 12 | i: 7 |}] 13 | 14 | let%expect_test _ = 15 | let module T = Oneof.Test2 in 16 | let t = `F3 "test" in 17 | Test_lib.test_encode ~proto_file (module T) t; 18 | [%expect {| 19 | f3: "test" |}] 20 | 21 | let%expect_test "Multiple oneofs" = 22 | let module T = Oneof.Test3 in 23 | let t = T.{ x = `X1 3; y = `Y2 5; z = `Z1 7 } in 24 | Test_lib.test_encode ~proto_file (module T) t; 25 | [%expect {| 26 | x1: 3 27 | y2: 5 28 | z1: 7 |}] 29 | 30 | let%expect_test "Default values in oneof" = 31 | let module T = Oneof.Test3 in 32 | let t = T.{ x = `X1 0; y = `Y2 0; z = `Z2 0 } in 33 | Test_lib.test_encode ~proto_file (module T) t; 34 | [%expect {| 35 | x1: 0 36 | y2: 0 37 | z2: 0 |}] 38 | 39 | let%expect_test "Single field oneof" = 40 | let module T = Oneof.Test4 in 41 | let t = Some 5 in 42 | Test_lib.test_encode ~proto_file (module T) t; 43 | [%expect {| 44 | i: 5 |}] 45 | 46 | let%expect_test "Single field oneof" = 47 | let module T = Oneof.Test5 in 48 | let t = Some () in 49 | Test_lib.test_encode ~proto_file (module T) t; 50 | [%expect {| 51 | e { 52 | } |}] 53 | -------------------------------------------------------------------------------- /test/options.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "google/protobuf/descriptor.proto"; 4 | message options { bool mangle_names = 1; } 5 | extend google.protobuf.FileOptions { 6 | options ocaml_options = 1074; 7 | } 8 | -------------------------------------------------------------------------------- /test/package.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package package.a.b; 4 | message M { 5 | uint64 i = 1; 6 | } 7 | -------------------------------------------------------------------------------- /test/package_test.ml: -------------------------------------------------------------------------------- 1 | open Package 2 | let proto_file = "package.proto" 3 | 4 | let%expect_test _ = 5 | let module T = Package.A.B.M in 6 | let t = 7 in 7 | Test_lib.test_encode ~proto_file (module T) t; 8 | [%expect {| 9 | i: 7 |}] 10 | -------------------------------------------------------------------------------- /test/packed.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package packed; 4 | 5 | message Packed { 6 | repeated uint64 i = 1; 7 | } 8 | 9 | message Not_packed { 10 | repeated uint64 i = 1 [packed = false]; 11 | } 12 | 13 | message UInt { 14 | uint64 i = 1; 15 | } 16 | 17 | message String { 18 | string s = 1; 19 | } 20 | -------------------------------------------------------------------------------- /test/packed_test.ml: -------------------------------------------------------------------------------- 1 | open Packed 2 | 3 | let proto_file = "packed.proto" 4 | 5 | let%expect_test "Packed" = 6 | let module T = Packed.Packed in 7 | let module T' = Packed.String in 8 | let t = [5; 6; 0; 7; 8; 9] in 9 | Test_lib.test_encode ~proto_file (module T) t; 10 | let contents = 11 | T.to_proto t 12 | |> Ocaml_protoc_plugin.Writer.contents 13 | in 14 | contents 15 | |> Ocaml_protoc_plugin.Reader.create 16 | |> T'.from_proto 17 | |> (function 18 | | Ok t -> Printf.printf "Data: %s. Size: %d\n" (T'.show t) (String.length contents) 19 | | Error e -> Printf.printf "Failed to decode: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 20 | ); 21 | [%expect {| 22 | i: 5 23 | i: 6 24 | i: 0 25 | i: 7 26 | i: 8 27 | i: 9 28 | Data: "\005\006\000\007\b\t". Size: 8 |}] 29 | 30 | let%expect_test "Not packed" = 31 | let module T = Packed.Not_packed in 32 | let module T' = Packed.UInt in 33 | let t = [5; 6; 0; 7; 8; 9] in 34 | Test_lib.test_encode ~proto_file (module T) t; 35 | let contents = 36 | T.to_proto t 37 | |> Ocaml_protoc_plugin.Writer.contents 38 | in 39 | contents 40 | |> Ocaml_protoc_plugin.Reader.create 41 | |> T'.from_proto 42 | |> (function 43 | | Ok t -> Printf.printf "Last element: %s. Size: %d\n" (T'.show t) (String.length contents) 44 | 45 | | Error e -> Printf.printf "Failed to decode: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 46 | ); 47 | [%expect {| 48 | i: 5 49 | i: 6 50 | i: 0 51 | i: 7 52 | i: 8 53 | i: 9 54 | Last element: 9. Size: 12 |}] 55 | 56 | (* Verify that empty lists are not serialized at all *) 57 | let%expect_test "Empty lists are not transmitted" = 58 | Test_lib.test_encode ~proto_file (module Packed.Packed) []; 59 | Packed.Packed.to_proto [] 60 | |> Ocaml_protoc_plugin.Writer.contents 61 | |> String.length 62 | |> Printf.eprintf "Size packed %d\n"; 63 | 64 | Test_lib.test_encode ~proto_file (module Packed.Not_packed) []; 65 | Packed.Not_packed.to_proto [] 66 | |> Ocaml_protoc_plugin.Writer.contents 67 | |> String.length 68 | |> Printf.eprintf "Size packed %d\n"; 69 | (); 70 | [%expect {| 71 | Generated json not equal 72 | Json: { "i": [] } 73 | Ref: {} 74 | Generated json not equal 75 | Json: { "i": [] } 76 | Ref: {} 77 | Size packed 0 78 | Size packed 0 |}] 79 | -------------------------------------------------------------------------------- /test/primitive_types.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package primitive_types; 4 | 5 | message Types { 6 | int64 int64 = 1; 7 | sint64 sint64 = 2; 8 | uint64 uint64 = 3; 9 | int32 int32 = 4; 10 | sint32 sint32 = 5; 11 | uint32 uint32 = 6; 12 | double double = 7; 13 | float float = 8; 14 | fixed64 fixed64 = 9; 15 | fixed32 fixed32 = 10; 16 | sfixed64 sfixed64 = 11; 17 | sfixed32 sfixed32 = 12; 18 | bool bool = 13; 19 | string string = 14; 20 | bytes bytes = 15; 21 | } 22 | 23 | message Empty { } 24 | -------------------------------------------------------------------------------- /test/primitive_types_test.ml: -------------------------------------------------------------------------------- 1 | open Primitive_types 2 | let proto_file = "primitive_types.proto" 3 | 4 | let%expect_test _ = 5 | let module T = Primitive_types.Types in 6 | let t = 7 | T. 8 | { 9 | int64 = 1; 10 | sint64 = 2; 11 | uint64 = 3; 12 | int32 = 4; 13 | sint32 = 5; 14 | uint32 = 6; 15 | double = 7.1; 16 | float = 8.0; 17 | fixed64 = 9L; 18 | fixed32 = 10l; 19 | sfixed64 = 11L; 20 | sfixed32 = 12l; 21 | bool = true; 22 | string = "string"; 23 | bytes = Bytes.of_string "bytes"; 24 | } 25 | in 26 | Test_lib.test_encode ~proto_file (module T) t; 27 | [%expect 28 | {| 29 | int64: 1 30 | sint64: 2 31 | uint64: 3 32 | int32: 4 33 | sint32: 5 34 | uint32: 6 35 | double: 7.1 36 | float: 8 37 | fixed64: 9 38 | fixed32: 10 39 | sfixed64: 11 40 | sfixed32: 12 41 | bool: true 42 | string: "string" 43 | bytes: "bytes" |}] 44 | 45 | let%expect_test _ = 46 | let module T = Primitive_types.Types in 47 | let t = T.make () in 48 | Test_lib.test_encode ~proto_file (module T) t; 49 | let bin = T.to_proto t in 50 | Printf.printf "Size: %d%!" (Ocaml_protoc_plugin.Writer.contents bin |> String.length); 51 | [%expect {| 52 | Size: 0 |}] 53 | 54 | 55 | let%expect_test _ = 56 | let module T = Primitive_types.Empty in 57 | let t = () in 58 | Test_lib.test_encode ~proto_file (module T) t; 59 | [%expect {| |}] 60 | -------------------------------------------------------------------------------- /test/proto2.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto2"; 2 | 3 | package proto2; 4 | 5 | message A { 6 | optional uint64 i = 2 [default = 4]; 7 | } 8 | 9 | message Message { 10 | message Required { 11 | optional uint64 a = 1; 12 | optional uint64 b = 2; 13 | } 14 | enum E { 15 | A = 0; 16 | B = 1; 17 | C = 2; 18 | } 19 | optional E enum = 1; 20 | optional uint64 i = 2 [default = 4]; 21 | required uint64 j = 3 [default = 4]; // Setting default on a required field really does not make sense 22 | optional uint64 k = 5; 23 | required Required required = 4; 24 | } 25 | 26 | message Message1 { 27 | enum E { A = 0; B = 1; C = 2; }; 28 | optional int32 opt = 1; 29 | required int32 req = 2; 30 | optional string s = 3 [default = "default string"]; 31 | optional uint32 u = 4 [default = 27]; 32 | optional bytes b = 5 [default = "default bytes"]; 33 | optional uint64 c = 6 [default = 27]; 34 | optional float f = 7 [default = 27]; 35 | optional E e = 8 [default = B]; 36 | } 37 | 38 | message Message1_ { 39 | required int32 req = 2; 40 | } 41 | 42 | message MessageEnumDefault { 43 | optional Message.E e = 8 [default = B]; 44 | } 45 | 46 | message Map_message2 { 47 | map m = 1; 48 | } 49 | 50 | message Map_message3 { 51 | enum Enum { 52 | A = 0; 53 | B = 1; 54 | }; 55 | map m = 1; 56 | } 57 | 58 | message MessageDefaults { 59 | optional string o0 = 10 [default = "default string"]; 60 | optional bytes o1 = 11 [default = "default bytes"]; 61 | optional uint32 o2 = 12 [default = 27]; 62 | optional uint64 o3 = 13 [default = 27]; 63 | optional int32 o4 = 14 [default = -27]; 64 | optional int64 o5 = 15 [default = -27]; 65 | optional sint32 o6 = 16 [default = -27]; 66 | optional sint64 o7 = 17 [default = -27]; 67 | optional fixed32 o8 = 18 [default = 27]; 68 | optional fixed64 o9 = 19 [default = 27]; 69 | optional sfixed32 oa = 20 [default = -27]; 70 | optional sfixed64 ob = 21 [default = -27]; 71 | optional float oc = 22 [default = -27]; 72 | optional double od = 23 [default = -27]; 73 | optional bool oe = 24 [default = true]; 74 | oneof of { 75 | int64 og = 1 [default = 5]; 76 | }; 77 | } 78 | 79 | // Default on oneofs makes really no sense 80 | message Oneof_default { 81 | oneof a { 82 | int64 i = 1 [default = 5]; 83 | int64 j = 2 [default = 7]; 84 | }; 85 | } 86 | 87 | message NameClash { 88 | message M1 { required int64 t = 1; }; 89 | message M2 { required int64 t = 1; }; 90 | message M3 { required int64 t = 1; }; 91 | message M4 { required int64 t = 1; }; 92 | message M5 { required int64 t = 1; }; 93 | required M1 t = 1; 94 | required M2 T = 2; 95 | required M3 _t = 3; 96 | required M3 _T = 4; 97 | required M4 T_ = 5; 98 | 99 | oneof oneof { 100 | int64 not_set = 10; 101 | int64 Not_set = 11; 102 | int64 Not_Set = 12; 103 | } 104 | } 105 | -------------------------------------------------------------------------------- /test/proto2_test.ml: -------------------------------------------------------------------------------- 1 | open Proto2 2 | let proto_file = "proto2.proto" 3 | 4 | let%expect_test _ = 5 | let module T = Proto2.Message in 6 | (* Verify signature that required messages are mapped as mandatory arguments *) 7 | let make: ?enum:T.E.t -> ?i:int -> j:int -> required:T.Required.t -> ?k:int -> unit -> T.t = T.make in 8 | let t' = make ~enum:T.E.B ~i:0 ~j:5 ~required:(T.Required.make ~a:7 ()) ~k:5 () in 9 | let t = T.{enum = Some E.B; i = 0; j = 5; required = T.Required.make ~a:7 (); k = Some 5 } in 10 | if (not (T.equal t t')) then Printf.eprintf "Error: Type does not match"; 11 | Test_lib.test_encode ~proto_file (module T) t; 12 | [%expect {| 13 | enum: B 14 | i: 0 15 | j: 5 16 | required { 17 | a: 7 18 | } 19 | k: 5 |}] 20 | 21 | let%expect_test "Default read default values" = 22 | let module T = Proto2.A in 23 | let () = match T.from_proto (Ocaml_protoc_plugin.Reader.create "") with 24 | | Ok t -> print_endline (T.show t) 25 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 26 | in (); 27 | [%expect {| 4 |}] 28 | 29 | let%expect_test "Required fields must be in the message" = 30 | let module T = Proto2.Message1 in 31 | let () = match T.from_proto (Ocaml_protoc_plugin.Reader.create "") with 32 | | Ok t -> print_endline (T.show t) 33 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 34 | in (); 35 | [%expect {| Decode failure: `Required_field_missing ((2, Int32_int)) |}] 36 | 37 | let%expect_test "Only tramitting the required field" = 38 | let module T = Proto2.Message1_ in 39 | let writer = T.to_proto 0 in 40 | let module T = Proto2.Message1 in 41 | let () = match T.from_proto (Ocaml_protoc_plugin.Writer.contents writer |> Ocaml_protoc_plugin.Reader.create) with 42 | | Ok t -> print_endline (T.show t) 43 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 44 | in (); 45 | [%expect {| 46 | { opt = None; req = 0; s = "default string"; u = 27; b = "default bytes"; 47 | c = 27; f = 27.; e = B } |}] 48 | 49 | let%expect_test "Default created messages should not set any fields" = 50 | let module T = Proto2.MessageDefaults in 51 | let t = T.make () in 52 | let message = T.to_proto t in 53 | Printf.printf "Size of message: %d\n" (String.length (Ocaml_protoc_plugin.Writer.contents message)); 54 | let () = match T.from_proto (Ocaml_protoc_plugin.Reader.create "") with 55 | | Ok t -> print_endline (T.show t) 56 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 57 | in (); 58 | [%expect {| 59 | Size of message: 0 60 | { og = 5; o0 = "default string"; o1 = "default bytes"; o2 = 27; o3 = 27; 61 | o4 = -27; o5 = -27; o6 = -27; o7 = -27; o8 = 27l; o9 = 27L; oa = -27l; 62 | ob = -27L; oc = -27.; od = -27.; oe = true } |}] 63 | 64 | let%expect_test "Default values in oneofs are ignored" = 65 | let module T = Proto2.Oneof_default in 66 | let t = T.make ~a:(`I 5) () in 67 | Test_lib.test_encode ~proto_file (module T) t; 68 | [%expect {| 69 | i: 5 |}] 70 | -------------------------------------------------------------------------------- /test/proto3_optional.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package proto3_optional; 4 | 5 | message Message { 6 | optional int32 payload = 1; 7 | } 8 | message Message2 { 9 | optional int32 payload = 1; 10 | optional int32 payload2 = 2; 11 | optional int32 payload3 = 3; 12 | } 13 | -------------------------------------------------------------------------------- /test/proto3_optional_test_opt.ml: -------------------------------------------------------------------------------- 1 | open Proto3_optional 2 | 3 | let proto_file = "proto3_optional.proto" 4 | 5 | let%expect_test _ = 6 | let module T = Proto3_optional.Message in 7 | let t = T.make ~payload:5 () in 8 | Test_lib.test_encode ~proto_file ~protoc_args:["--experimental_allow_proto3_optional"] (module T) t; 9 | [%expect {| payload: 5 |}] 10 | 11 | let%expect_test _ = 12 | let module T = Proto3_optional.Message2 in 13 | let t = T.make ~payload:5 ~payload3:7 () in 14 | Test_lib.test_encode ~proto_file ~protoc_args:["--experimental_allow_proto3_optional"] (module T) t; 15 | [%expect {| 16 | payload: 5 17 | payload3: 7 |}] 18 | -------------------------------------------------------------------------------- /test/protobuf2json.cc: -------------------------------------------------------------------------------- 1 | /** Stub for reference implementation of 2 | json -> protobuf 3 | protobuf -> json 4 | */ 5 | 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | 16 | // Uncomment to parse all protofile rather than specifying one explicitly 17 | //#define USE_FILESYSTEM 18 | 19 | #ifdef USE_FILESYSTEM 20 | #include 21 | #endif 22 | 23 | #define CAML_NAME_SPACE 24 | #include "caml/mlvalues.h" 25 | #include "caml/alloc.h" 26 | #include "caml/fail.h" 27 | #include "caml/memory.h" 28 | 29 | // Compatibility with ocaml <= 4.10 30 | #ifndef Val_none 31 | #define Val_none Val_int(0) 32 | #endif 33 | #ifndef Is_some 34 | #define Is_some(v) Is_block(v) 35 | #endif 36 | #ifndef Is_none 37 | #define Is_none(v) ((v) == Val_none) 38 | #endif 39 | #ifndef Some_val 40 | #define Some_val(v) Field(v, 0) 41 | #endif 42 | 43 | using namespace google::protobuf; 44 | 45 | util::TypeResolver* make_resolver(const std::string include, const std::string proto_file) { 46 | auto source_tree = new compiler::DiskSourceTree(); 47 | source_tree->MapPath("", "."); 48 | source_tree->MapPath("", include); 49 | source_tree->MapPath("/", include); 50 | auto importer = new compiler::Importer(source_tree, NULL); 51 | 52 | if (proto_file.size() == 0) { 53 | #ifdef USE_FILESYSTEM 54 | for(const auto& p : std::filesystem::directory_iterator(".")) { 55 | if(p.path().extension() == ".proto") { 56 | auto * fd = importer->Import(p.path().filename()); 57 | } 58 | } 59 | #else 60 | caml_invalid_argument("No protofile specified"); 61 | #endif 62 | } else { 63 | auto * fd = importer->Import(proto_file); 64 | } 65 | return util::NewTypeResolverForDescriptorPool("type.googleapis.com", importer->pool()); 66 | } 67 | 68 | std::string make_url(const char * type) { 69 | return std::string("type.googleapis.com/") + std::string(type); 70 | } 71 | 72 | extern "C" CAMLprim value protobuf2json(value google_include_path, value proto_file, value type, value data) { 73 | CAMLparam4(google_include_path, proto_file, type, data); 74 | 75 | std::string protobuf_file = Is_some(proto_file) ? String_val(Some_val(proto_file)) : ""; 76 | std::string url = make_url(String_val(type)); 77 | auto resolver = make_resolver(String_val(google_include_path), protobuf_file); 78 | 79 | io::ArrayInputStream input(String_val(data), caml_string_length(data)); 80 | std::string output_str; 81 | io::StringOutputStream output(&output_str); 82 | 83 | util::JsonPrintOptions options; 84 | options.add_whitespace = true; 85 | //options.always_print_primitive_fields = true; 86 | auto status = BinaryToJsonStream( 87 | resolver, url, &input, &output, options); 88 | 89 | if (!status.ok()) { 90 | std::string msg = status.ToString(); 91 | caml_invalid_argument(msg.c_str()); 92 | } 93 | CAMLreturn(caml_alloc_initialized_string(output_str.size(), output_str.c_str())); 94 | } 95 | 96 | extern "C" CAMLprim value json2protobuf(value google_include_path, value proto_file, value type, value data) { 97 | CAMLparam4(google_include_path, proto_file, type, data); 98 | 99 | std::string protobuf_file = Is_some(proto_file) ? String_val(Some_val(proto_file)) : ""; 100 | std::string url = make_url(String_val(type)); 101 | auto resolver = make_resolver(String_val(google_include_path), protobuf_file); 102 | 103 | io::ArrayInputStream input(String_val(data), caml_string_length(data)); 104 | std::string output_str; 105 | io::StringOutputStream output(&output_str); 106 | 107 | util::JsonParseOptions options; 108 | options.ignore_unknown_fields = true; 109 | 110 | auto status = JsonToBinaryStream( 111 | resolver, url, &input, &output, options); 112 | 113 | if (!status.ok()) { 114 | std::string msg = status.ToString(); 115 | caml_invalid_argument(msg.c_str()); 116 | } 117 | CAMLreturn(caml_alloc_initialized_string(output_str.size(), output_str.c_str())); 118 | } 119 | -------------------------------------------------------------------------------- /test/protocol.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package protocol; 4 | 5 | message Message { 6 | int64 i = 3; 7 | } 8 | 9 | message Old { 10 | repeated Message messages = 1; 11 | repeated Message oneof_messages = 10; 12 | string oneof_i = 20; 13 | int64 oneof_j = 30; 14 | } 15 | 16 | message New { 17 | Message message = 1; 18 | oneof oneof { 19 | Message oneof_messages = 10; 20 | string oneof_i = 20; 21 | int64 oneof_j = 30; 22 | } 23 | } 24 | 25 | message List { 26 | repeated int64 is = 1; 27 | } 28 | -------------------------------------------------------------------------------- /test/protocol_test.ml: -------------------------------------------------------------------------------- 1 | open Protocol 2 | let%expect_test "Last value kept" = 3 | let messages = List.init 8 (fun i -> i) in 4 | let oneof_messages = [] in 5 | let t = Protocol.Old.{ messages; oneof_i = "Oneof_test"; oneof_j = 13; oneof_messages } in 6 | 7 | let writer = Protocol.Old.to_proto t in 8 | let reader = Ocaml_protoc_plugin.Writer.contents writer |> Ocaml_protoc_plugin.Reader.create in 9 | Printf.printf "%s\n" (Protocol.New.from_proto_exn reader |> Protocol.New.show); 10 | [%expect {| { message = (Some 7); oneof = `Oneof_j (13) } |}] 11 | 12 | let%expect_test "Last value kept - 2" = 13 | let messages = List.init 8 (fun i -> i) in 14 | let oneof_messages = [] in 15 | let t = Protocol.Old.{ messages; oneof_i = "Oneof_test"; oneof_j = 13; oneof_messages } in 16 | 17 | let writer = Protocol.Old.to_proto t in 18 | let reader = Ocaml_protoc_plugin.Writer.contents writer ^ Ocaml_protoc_plugin.Writer.contents writer |> Ocaml_protoc_plugin.Reader.create in 19 | Printf.printf "%s" (Protocol.New.from_proto_exn reader |> Protocol.New.show); 20 | [%expect {| { message = (Some 7); oneof = `Oneof_j (13) } |}] 21 | 22 | let%expect_test "Repeated fields kept as it should" = 23 | let is1 = List.init 8 (fun i -> i + 6) in 24 | let is2 = List.init 8 (fun i -> i + 17) in 25 | let t1 = is1 in 26 | let t2 = is2 in 27 | let writer1 = Protocol.List.to_proto t1 in 28 | let writer2 = Protocol.List.to_proto t2 in 29 | let reader = Ocaml_protoc_plugin.Writer.contents writer1 ^ Ocaml_protoc_plugin.Writer.contents writer2 |> Ocaml_protoc_plugin.Reader.create in 30 | Printf.printf "%s" (Protocol.List.from_proto_exn reader |> Protocol.List.show); 31 | [%expect {| [6; 7; 8; 9; 10; 11; 12; 13; 17; 18; 19; 20; 21; 22; 23; 24] |}] 32 | -------------------------------------------------------------------------------- /test/recursive.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package recursive; 4 | 5 | message Tree { 6 | message Node { 7 | Tree left = 1; 8 | Tree right = 2; 9 | } 10 | message Leaf { 11 | uint64 i = 1; 12 | } 13 | oneof X { 14 | Node node = 1; 15 | Leaf leaf = 2; 16 | } 17 | } 18 | 19 | message Message { 20 | message Message1 { 21 | Message m1 = 10; 22 | } 23 | Message1 m = 1; 24 | } 25 | 26 | message Mutual1 { 27 | Mutual2 m2 = 7; 28 | } 29 | 30 | message Mutual2 { 31 | Mutual1 m1 = 17; 32 | } 33 | 34 | message StdTree { 35 | StdTree left = 1; 36 | int64 value = 2; 37 | StdTree right = 3; 38 | } 39 | 40 | 41 | message Recursive1 { 42 | message Recursive { 43 | message A { } 44 | message B { } 45 | 46 | message Recursive { 47 | message B { } 48 | message A { } 49 | .recursive.Recursive1.Recursive.Recursive.A r1 = 1; 50 | .recursive.Recursive1.Recursive.Recursive.B r2 = 2; 51 | .recursive.Recursive1.Recursive.A r3 = 3; 52 | .recursive.Recursive1.Recursive.B r4 = 4; 53 | } 54 | .recursive.Recursive1.Recursive.Recursive.A r1 = 1; 55 | .recursive.Recursive1.Recursive.Recursive.B r2 = 2; 56 | .recursive.Recursive1.Recursive.A r3 = 3; 57 | .recursive.Recursive1.Recursive.B r4 = 4; 58 | } 59 | .recursive.Recursive1.Recursive.Recursive.A r1 = 1; 60 | .recursive.Recursive1.Recursive.Recursive.B r2 = 2; 61 | .recursive.Recursive1.Recursive.A r3 = 3; 62 | .recursive.Recursive1.Recursive.B r4 = 4; 63 | } 64 | 65 | message Recursive_map { 66 | map m = 1; 67 | } 68 | 69 | message Recursive2 { 70 | message X { 71 | Recursive2 x = 1; 72 | } 73 | X x = 1; 74 | } 75 | -------------------------------------------------------------------------------- /test/recursive2.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | message X { 4 | .X a = 1; 5 | uint32 b = 2; 6 | message X { 7 | .X.X x = 1; 8 | string y = 2; 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /test/recursive2_test.ml: -------------------------------------------------------------------------------- 1 | let proto_file = "recursive.proto" 2 | 3 | let _ = 4 | let _x = Recursive2.X.make () in 5 | let _x' = { _x with a = Some _x } in (* Wrong *) 6 | let _x_x = Recursive2.X.X.make () in 7 | let _x_x' = { _x_x with x = Some _x_x } in 8 | () 9 | -------------------------------------------------------------------------------- /test/recursive_test.ml: -------------------------------------------------------------------------------- 1 | open Recursive 2 | let proto_file = "recursive.proto" 3 | 4 | let%expect_test _ = 5 | let module T = Recursive.Message in 6 | let t = T.{ m = Some T.Message1.{ m1 = Some T.{ m = Some T.Message1.{ m1 = None } } } } in 7 | Test_lib.test_encode ~proto_file ~skip_json:true (module T) t; 8 | [%expect {| 9 | m { 10 | m1 { 11 | m { 12 | } 13 | } 14 | } |}] 15 | 16 | let%expect_test _ = 17 | let module T1 = Recursive.Mutual1 in 18 | let module T2 = Recursive.Mutual2 in 19 | let t = T1.{ m2 = Some T2.{ m1 = Some T1.{ m2 = Some T2.{ m1 = None }}}} in 20 | Test_lib.test_encode ~proto_file ~skip_json:true (module T1) t; 21 | [%expect {| 22 | m2 { 23 | m1 { 24 | m2 { 25 | } 26 | } 27 | } |}] 28 | 29 | let%expect_test _ = 30 | let module T = Recursive.StdTree in 31 | 32 | let rec add v = function 33 | | None -> Some T.{ left = None; value = v; right = None} 34 | | Some T.{ left; value; right} when v < value -> 35 | Some T.{ left = add v left; value; right } 36 | | Some T.{ left; value; right} when v > value -> 37 | Some T.{ left = left; value; right = add v right; } 38 | | x -> x 39 | in 40 | let rec elements = function 41 | | None -> 0 42 | | Some T.{left; right; _} -> 1 + elements left + elements right 43 | in 44 | let rec depth = function 45 | | None -> 0 46 | | Some T.{ left; right; _} -> 47 | max (depth left) (depth right) + 1 48 | in 49 | 50 | (* Protoc cannot handle nested structure with a depth > 101. *) 51 | let t = 52 | List.init 10000 (fun i -> i lxor 0x57c) 53 | |> List.fold_left (fun acc i -> add i acc) None 54 | |> fun t -> T.{ left = t; value = 10000; right = None } 55 | in 56 | Printf.printf "Elements: %d\n" (elements (Some t)); 57 | Printf.printf "Depth: %d\n" (depth (Some t)); 58 | 59 | Test_lib.test_encode (module T) t; 60 | [%expect {| 61 | Elements: 10001 62 | Depth: 200 |}] 63 | -------------------------------------------------------------------------------- /test/repeated.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package repeated; 4 | 5 | message UInt64 { 6 | repeated uint64 i = 13; 7 | } 8 | 9 | message Double { 10 | repeated double i = 1; 11 | } 12 | 13 | message Float { 14 | repeated float i = 1; 15 | } 16 | 17 | message String { 18 | repeated string i = 1; 19 | } 20 | 21 | message Enum { 22 | enum E { 23 | A = 0; 24 | B = 1000; 25 | C = 2000; 26 | } 27 | repeated E e = 1; 28 | } 29 | 30 | message Message { 31 | message M { int64 i = 1; } 32 | repeated M ms = 1; 33 | } 34 | -------------------------------------------------------------------------------- /test/repeated_test.ml: -------------------------------------------------------------------------------- 1 | open Repeated 2 | let proto_file = "repeated.proto" 3 | let%expect_test _ = 4 | let module T = Repeated.UInt64 in 5 | let validate = T.make ~i:[5; 6; 7; 8; 9] () in 6 | let t = [5; 6; 7; 8; 9] in 7 | Test_lib.test_encode ~proto_file (module T) ~validate t; 8 | [%expect {| 9 | i: 5 10 | i: 6 11 | i: 7 12 | i: 8 13 | i: 9 |}] 14 | 15 | let%expect_test _ = 16 | let module T = Repeated.Double in 17 | let t = [0.; 1.; 2.; 3.; 4.] in 18 | Test_lib.test_encode ~proto_file (module T) t; 19 | [%expect {| 20 | i: 0 21 | i: 1 22 | i: 2 23 | i: 3 24 | i: 4 |}] 25 | 26 | let%expect_test _ = 27 | let module T = Repeated.Float in 28 | let t = [0.; 1.; 2.; 3.; 4.] in 29 | Test_lib.test_encode ~proto_file (module T) t; 30 | [%expect {| 31 | i: 0 32 | i: 1 33 | i: 2 34 | i: 3 35 | i: 4 |}] 36 | 37 | let%expect_test _ = 38 | let module T = Repeated.String in 39 | let t = ["0"; "1"; "2"; "3"; "4"] in 40 | Test_lib.test_encode ~proto_file (module T) t; 41 | [%expect {| 42 | i: "0" 43 | i: "1" 44 | i: "2" 45 | i: "3" 46 | i: "4" |}] 47 | 48 | let%expect_test _ = 49 | let module T = Repeated.Enum in 50 | let t = T.E.[A; B; C; A; C] in 51 | Test_lib.test_encode ~proto_file (module T) t; 52 | [%expect {| 53 | e: A 54 | e: B 55 | e: C 56 | e: A 57 | e: C |}] 58 | 59 | let%expect_test _ = 60 | let module T = Repeated.Message in 61 | let m i = i in 62 | let t = [m 0; m 1; m 2; m 1; m 0; m 5] in 63 | Test_lib.test_encode ~proto_file (module T) t; 64 | [%expect 65 | {| 66 | ms { 67 | } 68 | ms { 69 | i: 1 70 | } 71 | ms { 72 | i: 2 73 | } 74 | ms { 75 | i: 1 76 | } 77 | ms { 78 | } 79 | ms { 80 | i: 5 81 | } |}] 82 | -------------------------------------------------------------------------------- /test/service.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package service.p1.p2.p3; 4 | 5 | message Request { 6 | uint64 i = 1; 7 | } 8 | 9 | message Response { 10 | string s = 1; 11 | } 12 | 13 | service String_of_int { 14 | rpc Call (Request) returns (Response); 15 | } 16 | 17 | service EntityService { 18 | rpc CreateEntity (CreateEntityRequest) returns (CreateEntityResponse) {} 19 | } 20 | 21 | message CreateEntityRequest { 22 | CreateEntity entity = 1; 23 | int64 i = 2; 24 | 25 | message CreateEntity { 26 | string name = 1; 27 | } 28 | } 29 | 30 | message CreateEntityResponse { 31 | string name = 1; 32 | int64 i = 2; 33 | } 34 | -------------------------------------------------------------------------------- /test/service_empty_package.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | service Test { 4 | rpc Call (Request) returns (Response); 5 | } 6 | 7 | message Request { } 8 | 9 | message Response { } 10 | 11 | -------------------------------------------------------------------------------- /test/service_empty_package_test.ml: -------------------------------------------------------------------------------- 1 | module Call = Service_empty_package.Test.Call 2 | 3 | let%expect_test "service attributes" = 4 | Printf.printf "name: %s\n" Call.name; 5 | Printf.printf "package_name: %s\n" (Option.value ~default:"" Call.package_name); 6 | Printf.printf "service_name: %s\n" Call.service_name; 7 | Printf.printf "method_name: %s\n" Call.method_name; 8 | (); 9 | [%expect {| 10 | name: /Test/Call 11 | package_name: 12 | service_name: Test 13 | method_name: Call |}] 14 | -------------------------------------------------------------------------------- /test/service_rpc_clash.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package ServiceRpcClash; 4 | 5 | message Request { } 6 | 7 | message Response { } 8 | 9 | service Test { 10 | rpc Call (Request) returns (Response); 11 | rpc call (Request) returns (Response); 12 | rpc CALL (Request) returns (Response); 13 | rpc cALL (Request) returns (Response); 14 | rpc Method (Request) returns (Response); 15 | rpc functor (Request) returns (Response); 16 | rpc Functor (Request) returns (Response); 17 | } 18 | -------------------------------------------------------------------------------- /test/service_test.ml: -------------------------------------------------------------------------------- 1 | open Service 2 | module S = Service.P1.P2.P3 3 | let service reader = 4 | let (s_deser, s_ser) = 5 | Ocaml_protoc_plugin.Service.make_service_functions S.String_of_int.call 6 | in 7 | let req = 8 | s_deser reader 9 | |> (function Ok v -> v | Error _ -> failwith "Error") 10 | in 11 | string_of_int req |> s_ser 12 | 13 | let call i = 14 | let (c_ser, c_deser) = 15 | Ocaml_protoc_plugin.Service.make_client_functions S.String_of_int.call 16 | in 17 | let req = i in 18 | req 19 | |> c_ser 20 | |> Ocaml_protoc_plugin.Writer.contents 21 | |> Ocaml_protoc_plugin.Reader.create 22 | |> service 23 | |> Ocaml_protoc_plugin.Writer.contents 24 | |> Ocaml_protoc_plugin.Reader.create 25 | |> c_deser 26 | |> (function Ok r -> r | Error _ -> failwith "Error") 27 | 28 | let%expect_test _ = 29 | Printf.printf "name: \"%s\"\n" S.String_of_int.Call.name; 30 | Printf.printf "package_name: \"%s\"\n" @@ Option.value ~default:"" S.String_of_int.Call.package_name; 31 | Printf.printf "service_name: \"%s\"\n" S.String_of_int.Call.service_name; 32 | Printf.printf "method_name: \"%s\"\n" S.String_of_int.Call.method_name; 33 | [%expect {| 34 | name: "/service.p1.p2.p3.String_of_int/Call" 35 | package_name: "service.p1.p2.p3" 36 | service_name: "String_of_int" 37 | method_name: "Call" |}] 38 | 39 | let%expect_test _ = 40 | Printf.printf "%d -> \"%s\"\n" 0 (call 0); 41 | Printf.printf "%d -> \"%s\"\n" 5 (call 5); 42 | Printf.printf "%d -> \"%s\"\n" 50 (call 50); 43 | Printf.printf "%d -> \"%s\"\n" (-5) (call (-5)); 44 | Printf.printf "%d -> \"%s\"\n" (-100) (call (-100)); 45 | (); 46 | [%expect {| 47 | 0 -> "0" 48 | 5 -> "5" 49 | 50 -> "50" 50 | -5 -> "-5" 51 | -100 -> "-100" |}] 52 | -------------------------------------------------------------------------------- /test/singleton_record.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package singleton_record; 4 | 5 | 6 | message Test { 7 | oneof x { 8 | int64 i = 10; 9 | string j = 20; 10 | } 11 | } 12 | 13 | message Test2 { 14 | message F1 { 15 | string j = 2; 16 | } 17 | message F2 { 18 | int64 x = 2; 19 | } 20 | oneof x { 21 | F1 f1 = 10; 22 | F2 f2 = 20; 23 | string f3 = 2; 24 | } 25 | } 26 | 27 | message Test3 { 28 | sint64 x1 = 10; 29 | } 30 | 31 | message Test4 { 32 | Test t = 45; 33 | } 34 | 35 | message Test5 { 36 | message M { 37 | enum E { 38 | A = 0; 39 | B = 1; 40 | C = 2; 41 | } 42 | E enum = 1; 43 | } 44 | M m = 45; 45 | } 46 | 47 | message Test6 { 48 | map m = 1; 49 | } 50 | -------------------------------------------------------------------------------- /test/singleton_record_test.ml: -------------------------------------------------------------------------------- 1 | open Singleton_record 2 | 3 | let proto_file = "singleton_record.proto" 4 | 5 | let%expect_test _ = 6 | let module T = Singleton_record.Test in 7 | let t = `J "Test" in 8 | Test_lib.test_encode ~proto_file (module T) t; 9 | [%expect {| 10 | j: "Test" |}] 11 | 12 | let%expect_test _ = 13 | let module T = Singleton_record.Test2 in 14 | let t = `F3 "Test" in 15 | Test_lib.test_encode ~proto_file (module T) t; 16 | [%expect {| 17 | f3: "Test" |}] 18 | 19 | let%expect_test _ = 20 | let module T = Singleton_record.Test3 in 21 | let t = 7 in 22 | Test_lib.test_encode ~proto_file (module T) t; 23 | [%expect {| 24 | x1: 7 |}] 25 | 26 | let%expect_test _ = 27 | let module T = Singleton_record.Test4 in 28 | let t = Some (`J "test") in 29 | Test_lib.test_encode ~proto_file (module T) t; 30 | [%expect {| 31 | t { 32 | j: "test" 33 | } |}] 34 | 35 | let%expect_test _ = 36 | let module T = Singleton_record.Test5 in 37 | let t = Some T.M.E.B in 38 | Test_lib.test_encode ~proto_file (module T) t; 39 | [%expect {| 40 | m { 41 | enum: B 42 | } |}] 43 | -------------------------------------------------------------------------------- /test/test_include_a/message.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | package test_include_a; 3 | 4 | message M { } 5 | -------------------------------------------------------------------------------- /test/test_include_b/message.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "test_include_a/message.proto"; 4 | package test_include_b; 5 | message M { 6 | test_include_a.M m = 1; 7 | } 8 | -------------------------------------------------------------------------------- /test/test_lib.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | open Ocaml_protoc_plugin 3 | 4 | 5 | module Reference = struct 6 | let google_include_path = 7 | let ch = open_in "google_include" in 8 | let include_path = input_line ch in 9 | close_in ch; 10 | include_path 11 | 12 | external protobuf2json : google_include_path:string -> ?proto_file:string -> message_type:string -> string -> string = "protobuf2json" 13 | let to_json ?proto_file ~message_type data = 14 | protobuf2json ~google_include_path ?proto_file ~message_type data 15 | |> Yojson.Basic.from_string 16 | 17 | external json2protobuf : google_include_path:string -> ?proto_file:string -> message_type:string -> string -> string = "json2protobuf" 18 | let from_json ?proto_file ~message_type json = 19 | let data = Yojson.Basic.to_string json in 20 | json2protobuf ~google_include_path ?proto_file ~message_type data 21 | 22 | end 23 | 24 | module type T = sig 25 | type t [@@deriving show, eq] 26 | val to_proto' : Writer.t -> t -> unit 27 | val to_proto : t -> Writer.t 28 | val from_proto : Reader.t -> t Result.t 29 | val from_proto_exn : Reader.t -> t 30 | val name : unit -> string 31 | val merge: t -> t -> t 32 | val to_json: Json_options.t -> t -> Yojson.Basic.t 33 | val from_json_exn: Yojson.Basic.t -> t 34 | val from_json: Yojson.Basic.t -> t Result.t 35 | end 36 | 37 | let hexlify data = 38 | let acc = ref [] in 39 | String.iter ~f:(fun ch -> (acc := Char.code ch :: !acc)) data; 40 | List.rev !acc 41 | |> List.map ~f:(Printf.sprintf "%02x") 42 | |> String.concat ~sep:"-" 43 | |> Printf.printf "Buffer: '%s'\n" 44 | 45 | let dump_protoc ?(protoc_args=[]) ~proto_file type_name data = 46 | let filename = Filename.temp_file type_name ".bin" in 47 | let cout = open_out filename in 48 | output_string cout data; 49 | close_out cout; 50 | Printf.printf "%!"; 51 | let command = 52 | Printf.sprintf "protoc %s --decode=%s %s < %s 2>/dev/null" 53 | (String.concat ~sep:" " protoc_args) 54 | type_name 55 | proto_file 56 | filename 57 | in 58 | let res = Sys.command command in 59 | Sys.remove filename; 60 | match res with 61 | | 0 -> () 62 | | n -> Printf.printf "'protoc' exited with status code: %d. \n%s\n" n command 63 | 64 | let test_merge (type t) (module M : T with type t = t) (t: t) = 65 | Test_runtime.set_stragegy Test_runtime.Standard; 66 | let iterations = [1;2;3;4] in 67 | let writer = Writer.init () in 68 | let _ = 69 | List.fold_left ~init:(writer, t) ~f:(fun (writer, expect) i -> 70 | M.to_proto' writer t; 71 | let contents = Writer.contents writer |> Reader.create in 72 | let () = 73 | match M.from_proto contents with 74 | | Error err -> Printf.printf "Error decoding after %d iterations: %s\n" i (Result.show_error err) 75 | | Ok observed when M.equal expect observed -> () 76 | | Ok observed -> 77 | Printf.printf "Wrong value after %d iterations\nExpect: %s\nObserved:%s\n" i ([%show: M.t] expect) ([%show: M.t] observed) 78 | in 79 | (writer, M.merge expect t) 80 | ) iterations 81 | in 82 | () 83 | 84 | let test_json ~debug ~proto_file (type t) (module M : T with type t = t) (t: t) = 85 | let message_type = 86 | match M.name () |> String.split_on_char ~sep:'.' with 87 | | _ :: tl -> 88 | let message_type = String.concat ~sep:"." tl in 89 | message_type 90 | | _ -> failwith "Illegal name" 91 | in 92 | ignore debug; 93 | let json_ref t = 94 | let proto = M.to_proto t |> Writer.contents in 95 | try 96 | Reference.to_json ~proto_file ~message_type proto 97 | with 98 | | _ -> 99 | failwith "Could not parse reference json" 100 | in 101 | let test_json ?enum_names ?json_names ?omit_default_values t = 102 | let compare ~message t expect = 103 | match (M.from_json_exn expect = t) with 104 | | true -> () 105 | | false -> 106 | let observed = M.from_json_exn expect |> json_ref in 107 | Printf.printf "Json encode/decode not identical. %s\n Expect: %s\n Observe: %s\n" message 108 | (Yojson.Basic.to_string expect) (Yojson.Basic.to_string observed) 109 | | exception exn -> 110 | Printf.printf "Json encode/decode failed for %s: %s\n" message (Yojson.Basic.to_string expect); 111 | Printf.printf " Error: %s\n" (Printexc.to_string exn); 112 | in 113 | let () = 114 | try 115 | let options = Json_options.make ?enum_names ?json_names ?omit_default_values () in 116 | let json = M.to_json options t in 117 | compare ~message:(M.name ()) t json 118 | with | exn -> Printf.printf "Error: %s\n" (Printexc.to_string exn) 119 | in 120 | t 121 | in 122 | (* Compare reference json *) 123 | let () = 124 | try 125 | let json' = json_ref t in 126 | let t' = M.from_json_exn json' in 127 | let json = M.to_json Json_options.default t in 128 | let t'' = 129 | Reference.from_json ~proto_file ~message_type json 130 | |> Reader.create 131 | |> M.from_proto_exn 132 | in 133 | if not (M.equal t t') then Printf.printf "Deserialized json does not match.\n"; 134 | if not (M.equal t t'') then Printf.printf "Deserialized generated json does not match\n"; 135 | if (not (Yojson.Basic.equal json' json)) then 136 | Printf.printf "Generated json not equal\n"; 137 | 138 | if (not (Yojson.Basic.equal json' json) || t <> t' || t <> t'' || debug) then 139 | Printf.printf "Json: %s\nRef: %s\n" 140 | (Yojson.Basic.pretty_to_string json) 141 | (Yojson.Basic.pretty_to_string json'); 142 | with 143 | | exn -> Printf.printf "Cannot deserialize reference json\n Error: %s\n" (Printexc.to_string exn); 144 | in 145 | t 146 | |> test_json 147 | |> test_json ~enum_names:false 148 | |> test_json ~json_names:false 149 | |> test_json ~omit_default_values:false 150 | |> test_json ~enum_names:false ~json_names:false ~omit_default_values:false 151 | |> ignore 152 | 153 | let test_decode (type t) (module M : T with type t = t) strategy expect data = 154 | let reader = Reader.create data in 155 | Test_runtime.set_stragegy strategy; 156 | match M.from_proto reader with 157 | | Ok observed -> begin 158 | match M.equal expect observed with 159 | | true -> () 160 | | false -> 161 | Printf.printf "\n%s: Expect: %s\nObserved:%s\n" (Test_runtime.show_strategy strategy) ([%show: M.t] expect) ([%show: M.t] observed) 162 | end 163 | | Error err -> 164 | Printf.printf "\n%s:Decode failed: %s \n" (Test_runtime.show_strategy strategy) (Result.show_error err) 165 | | exception exn -> 166 | Reader.reset reader 0; 167 | let fields = Reader.to_list reader in 168 | Printf.printf "\n%s:Decode failed: %s\n" (Test_runtime.show_strategy strategy) (Printexc.to_string exn); 169 | Printf.printf "\n%s:Data: %s\n" (Test_runtime.show_strategy strategy) (List.map ~f:fst fields |> List.map ~f:string_of_int |> String.concat ~sep:", ") 170 | 171 | (** Create a common function for testing. *) 172 | let test_encode (type t) ?dump ?(debug_json=false) ?proto_file ?protoc_args (module M : T with type t = t) ?(skip_json=false) ?(skip_protoc=false) ?(validate : t option) ?(expect : t option) (t : t) = 173 | let expect = Option.value ~default:t expect in 174 | let () = match validate with 175 | | Some v when v <> expect -> Printf.printf "Validate match failed\n" 176 | | _ -> () 177 | in 178 | let data = M.to_proto expect |> Writer.contents in 179 | let data_speed = let writer = Writer.init ~mode:Speed () in M.to_proto' writer expect; Writer.contents writer in 180 | let data_space = let writer = Writer.init ~mode:Space () in M.to_proto' writer expect; Writer.contents writer in 181 | let data_balanced = let writer = Writer.init ~mode:Balanced () in M.to_proto' writer expect; Writer.contents writer in 182 | 183 | let () = 184 | match dump with 185 | | Some _ -> hexlify data 186 | | None -> () 187 | in 188 | let () = 189 | match proto_file with 190 | | Some proto_file when not skip_protoc -> 191 | let typename = M.name () in 192 | let typename = String.sub typename ~pos:1 ~len:(String.length typename - 1) in 193 | dump_protoc ?protoc_args ~proto_file typename data 194 | | _ -> () 195 | in 196 | 197 | test_decode (module M) Test_runtime.Standard expect data_space; 198 | test_decode (module M) Test_runtime.Standard expect data_speed; 199 | test_decode (module M) Test_runtime.Standard expect data_balanced; 200 | test_decode (module M) Test_runtime.Standard expect data; 201 | test_decode (module M) Test_runtime.Fast expect data; 202 | test_decode (module M) Test_runtime.Full expect data; 203 | test_merge (module M) expect; 204 | match skip_json, proto_file with 205 | | false, Some proto_file -> 206 | test_json ~proto_file ~debug:debug_json (module M) expect; 207 | | _ -> () 208 | -------------------------------------------------------------------------------- /test/test_params/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name prefix_output_with_package) 3 | (inline_tests) 4 | (libraries ocaml_protoc_plugin google_types_prefixed) 5 | (preprocess (pps ppx_expect)) 6 | ) 7 | 8 | (rule 9 | (targets 10 | deprecated.ml 11 | empty_message.ml 12 | empty.ml 13 | enum_test_enum.ml 14 | extensions_extensions.ml 15 | importModuleName_subPackageName_name_clash2.ml 16 | included2_included2.ml 17 | include_included3_dash.ml 18 | include_included.ml 19 | include_include.ml 20 | int_types_int_types.ml 21 | int_types_native_int_types_native.ml 22 | int_types_native_proto2_int_types_native_proto2.ml 23 | json_test_json_encoding.ml 24 | large.ml 25 | mangle_names.ml 26 | map_map.ml 27 | merge_merge.ml 28 | message_message.ml 29 | nameClashMangle_name_clash_mangle.ml 30 | name_clash_name_clash.ml 31 | oneof_oneof.ml 32 | options.ml 33 | package_a_b_package.ml 34 | packed_packed.ml 35 | primitive_types_primitive_types.ml 36 | proto2_proto2.ml 37 | protocol_protocol.ml 38 | protoc_plugin_test_basic.ml 39 | recursive_recursive.ml 40 | repeated_repeated.ml 41 | service_empty_package.ml 42 | service_p1_p2_p3_service.ml 43 | serviceRpcClash_service_rpc_clash.ml 44 | singleton_record_singleton_record.ml 45 | comments_comments.ml) 46 | (deps 47 | (:plugin ../../src/plugin/protoc_gen_ocaml.exe) 48 | (:proto 49 | ../basic.proto 50 | ../deprecated.proto 51 | ../empty_message.proto 52 | ../empty.proto 53 | ../enum.proto 54 | ../extensions.proto 55 | ../included2.proto 56 | ../included.proto 57 | ../included3-dash.proto 58 | ../include.proto 59 | ../int_types_native.proto 60 | ../int_types_native_proto2.proto 61 | ../int_types.proto 62 | ../json_encoding.proto 63 | ../large.proto 64 | ../mangle_names.proto 65 | ../map.proto 66 | ../merge.proto 67 | ../message.proto 68 | ../name_clash2.proto 69 | ../name_clash_mangle.proto 70 | ../name_clash.proto 71 | ../oneof.proto 72 | ../options.proto 73 | ../package.proto 74 | ../packed.proto 75 | ../primitive_types.proto 76 | ../proto2.proto 77 | ../protocol.proto 78 | ../recursive.proto 79 | ../repeated.proto 80 | ../service_empty_package.proto 81 | ../service.proto 82 | ../service_rpc_clash.proto 83 | ../singleton_record.proto 84 | ../comments.proto) 85 | ) 86 | (action 87 | (run protoc -I %{read-lines:../google_include} -I .. 88 | "--plugin=protoc-gen-ocaml=%{plugin}" 89 | "--ocaml_out=open=Google_types_prefixed;singleton_record=true;prefix_output_with_package=true;singleton_oneof_as_option=false:." 90 | %{proto})) 91 | ) 92 | -------------------------------------------------------------------------------- /test/test_params/google_types_prefixed/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name google_types_prefixed) 3 | (libraries ocaml_protoc_plugin) 4 | (preprocess 5 | (pps ppx_expect ppx_deriving.show ppx_deriving.eq)) 6 | (synopsis "Google well known types with prefix_output_with_package=true") 7 | ) 8 | 9 | (rule 10 | (targets 11 | google_protobuf_any.ml 12 | google_protobuf_api.ml 13 | google_protobuf_descriptor.ml 14 | google_protobuf_duration.ml 15 | google_protobuf_empty.ml 16 | google_protobuf_field_mask.ml 17 | google_protobuf_source_context.ml 18 | google_protobuf_struct.ml 19 | google_protobuf_timestamp.ml 20 | google_protobuf_type.ml 21 | google_protobuf_wrappers.ml) 22 | (deps 23 | (:plugin ../../../src/plugin/protoc_gen_ocaml.exe)) 24 | (action 25 | (run protoc -I %{read-lines:../../google_include} -I . 26 | "--plugin=protoc-gen-ocaml=%{plugin}" 27 | "--ocaml_out=singleton_record=true;prefix_output_with_package=true;singleton_oneof_as_option=false:." 28 | 29 | %{read-lines:../../google_include}/google/protobuf/any.proto 30 | %{read-lines:../../google_include}/google/protobuf/api.proto 31 | %{read-lines:../../google_include}/google/protobuf/descriptor.proto 32 | %{read-lines:../../google_include}/google/protobuf/duration.proto 33 | %{read-lines:../../google_include}/google/protobuf/empty.proto 34 | %{read-lines:../../google_include}/google/protobuf/field_mask.proto 35 | %{read-lines:../../google_include}/google/protobuf/source_context.proto 36 | %{read-lines:../../google_include}/google/protobuf/struct.proto 37 | %{read-lines:../../google_include}/google/protobuf/timestamp.proto 38 | %{read-lines:../../google_include}/google/protobuf/type.proto 39 | %{read-lines:../../google_include}/google/protobuf/wrappers.proto 40 | ))) 41 | -------------------------------------------------------------------------------- /test/test_runtime.ml: -------------------------------------------------------------------------------- 1 | (** Module to force specific deserialization strategies during tests 2 | though dependency injection *) 3 | 4 | type strategy = Fast | Full | Standard [@@deriving show] 5 | let strategy = ref Standard 6 | let set_stragegy s = strategy := s 7 | 8 | module Ocaml_protoc_plugin = struct 9 | include Ocaml_protoc_plugin 10 | module Deserialize : module type of Deserialize = struct 11 | include Deserialize 12 | let deserialize spec constr reader = 13 | match !strategy with 14 | | Fast -> 15 | deserialize_fast spec constr reader 16 | | Full -> deserialize_full spec constr reader 17 | | Standard -> deserialize spec constr reader 18 | end 19 | end 20 | --------------------------------------------------------------------------------